Math-PlanePath-122/ 0002755 0001750 0001750 00000000000 12641645163 011711 5 ustar gg gg Math-PlanePath-122/COPYING 0000644 0001750 0001750 00000104374 10641206144 012741 0 ustar gg gg
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc.
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
Copyright (C)
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see .
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
Copyright (C)
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
.
Math-PlanePath-122/tools/ 0002755 0001750 0001750 00000000000 12641645163 013051 5 ustar gg gg Math-PlanePath-122/tools/alternate-paper-dxdy.pl 0000644 0001750 0001750 00000004070 12022542003 017415 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl alternate-paper-dxdy.pl
#
use 5.010;
use strict;
# uncomment this to run the ### lines
#use Smart::Comments;
{
my @pending_state;
foreach my $rot (0,1,2,3) {
foreach my $oddpos (0,1) {
push @pending_state, make_state (bit => 0,
lowerbit => 0,
rot => $rot,
oddpos => $oddpos,
nextturn => 0);
}
}
my $count = 0;
my @seen_state;
my $depth = 1;
foreach my $state (@pending_state) {
$seen_state[$state] = $depth;
}
while (@pending_state) {
my @new_pending_state;
foreach my $state (@pending_state) {
$count++;
### consider state: $state
foreach my $bit (0 .. 1) {
my $next_state = $next_state[$state+$bit];
if (! $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @new_pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
$depth++;
}
@pending_state = @new_pending_state;
}
for (my $state = 0; $state < @next_state; $state += 2) {
$seen_state[$state] ||= '-';
my $state_string = state_string($state);
print "# used state $state depth $seen_state[$state] $state_string\n";
}
print "used state count $count\n";
}
exit 0;
Math-PlanePath-122/tools/dragon-curve-table.pl 0000644 0001750 0001750 00000014633 12021026530 017053 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl dragon-curve-table.pl
#
# Print the state tables used for DragonCurve n_to_xy().
use 5.010;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 16) == 15
|| ($entry_width >= 3 && ($i % 4) == 3)) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @digit_to_dxdy;
sub make_state {
my %param = @_;
my $state = 0;
$state <<= 1; $state |= delete $param{'rev'};
$state <<= 2; $state |= delete $param{'rot'};
$state <<= 2; $state |= delete $param{'digit'};
return $state;
}
sub state_string {
my ($state) = @_;
my $digit = $state & 3; $state >>= 2;
my $rot = $state & 3; $state >>= 2;
my $rev = $state & 1; $state >>= 1;
return "rot=$rot rev=$rev (digit=$digit)";
}
foreach my $rot (0 .. 3) {
foreach my $rev (0, 1) {
foreach my $digit (0, 1, 2, 3) {
my $state = make_state (rot => $rot, rev => $rev, digit => $digit);
my $new_rev;
my $new_rot = $rot;
my $x;
my $y;
if ($rev) {
#
# 2<--3
# ^ |
# | v
# 0<--1 *
#
if ($digit == 0) {
$x = 0;
$y = 0;
$new_rev = 0;
} elsif ($digit == 1) {
$x = 1;
$y = 0;
$new_rev = 1;
$new_rot++;
} elsif ($digit == 2) {
$x = 1;
$y = 1;
$new_rev = 0;
} elsif ($digit == 3) {
$x = 2;
$y = 1;
$new_rev = 1;
$new_rot--;
}
} else {
#
# 0 3<--*
# | ^
# v |
# 1<--2
#
if ($digit == 0) {
$x = 0;
$y = 0;
$new_rev = 0;
$new_rot--;
} elsif ($digit == 1) {
$x = 0;
$y = -1;
$new_rev = 1;
} elsif ($digit == 2) {
$x = 1;
$y = -1;
$new_rev = 0;
$new_rot++;
} elsif ($digit == 3) {
$x = 1;
$y = 0;
$new_rev = 1;
}
}
$new_rot &= 3;
my $dx = 1;
my $dy = 0;
if ($rot & 2) {
$x = -$x;
$y = -$y;
$dx = -$dx;
$dy = -$dy;
}
if ($rot & 1) {
($x,$y) = (-$y,$x); # rotate +90
($dx,$dy) = (-$dy,$dx); # rotate +90
}
### rot to: "$x, $y"
my $next_dx = $x;
my $next_dy = $y;
$digit_to_x[$state] = $x;
$digit_to_y[$state] = $y;
if ($digit == 0) {
$digit_to_dxdy[$state] = $dx;
$digit_to_dxdy[$state+1] = $dy;
}
my $next_state = make_state
(rot => $new_rot,
rev => $new_rev,
digit => 0);
$next_state[$state] = $next_state;
}
}
}
### @next_state
### next_state length: 4*(4*2*2 + 4*2)
print "# next_state length ", scalar(@next_state), "\n";
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("digit_to_dxdy", \@digit_to_dxdy);
print "\n";
# {
# DIGIT: foreach my $digit (0 .. 3) {
# foreach my $rot (0 .. 3) {
# foreach my $rev (0 .. 1) {
# if ($digit_to_x[make_state(rot => $rot,
# rev => $rev,
# digit => $digit)]
# != $digit_to_dxdy[make_state(rot => $rot,
# rev => $rev,
# digit => 0)]) {
# print "digit=$digit dx different at rot=$rot rev=$rev\n";
# next DIGIT;
# }
# }
# }
# print "digit=$digit digit_to_x[] is dx\n";
# }
# }
{
my @pending_state = (0, 4, 8, 12); # in 4 arm directions
my $count = 0;
my @seen_state;
my $depth = 1;
foreach my $state (@pending_state) {
$seen_state[$state] = $depth;
}
while (@pending_state) {
my @new_pending_state;
foreach my $state (@pending_state) {
$count++;
### consider state: $state
foreach my $digit (0 .. 1) {
my $next_state = $next_state[$state+$digit];
if (! $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @new_pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
$depth++;
}
@pending_state = @new_pending_state;
}
for (my $state = 0; $state < @next_state; $state += 2) {
$seen_state[$state] ||= '-';
my $state_string = state_string($state);
print "# used state $state depth $seen_state[$state] $state_string\n";
}
print "used state count $count\n";
}
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh',
'digit_join_lowtohigh';
foreach my $int (0 .. 16) {
### $int
my @digits = digit_split_lowtohigh($int,4);
my $len = 2 ** $#digits;
my $state = (scalar(@digits) & 3) << 2;
### @digits
### $len
### initial state: $state.' '.state_string($state)
my $x = 0;
my $y = 0;
foreach my $i (reverse 0 .. $#digits) {
### at: "i=$i len=$len digit=$digits[$i] state=$state ".state_string($state)
$state += $digits[$i];
### digit x: $digit_to_x[$state]
### digit y: $digit_to_y[$state]
$x += $len * $digit_to_x[$state];
$y += $len * $digit_to_y[$state];
$state = $next_state[$state];
$len /= 2;
}
### $x
### $y
print "$int $x $y\n";
}
exit 0;
__END__
Math-PlanePath-122/tools/hilbert-spiral-table.pl 0000644 0001750 0001750 00000016274 11666767377 017446 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%s", ($aref->[$i]//'undef');
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 16) == 15) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
sub print_table12 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, ($aref->[$i]//'undef');
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 12) == 11) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
sub make_state {
my ($rot, $transpose, $spiral) = @_;
$transpose %= 2;
$rot %= 2;
$spiral %= 2;
return 4*($rot + 2*$transpose + 4*$spiral);
}
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @xy_to_digit;
my @min_digit;
my @max_digit;
foreach my $spiral (0,1) {
foreach my $rot (0, 1) {
foreach my $transpose (0, ($spiral ? () : (1))) {
my $state = make_state ($rot, $transpose, $spiral);
# range 0 [X,_]
# range 1 [X,X]
# range 2 [_,X]
foreach my $xrange (0,1,2) {
foreach my $yrange (0,1,2) {
my $xr = $xrange;
my $yr = $yrange;
my $bits = $xr + 3*$yr; # before rot+transpose
if ($rot) {
$xr = 2-$xr;
$yr = 2-$yr;
}
if ($transpose) {
($xr,$yr) = ($yr,$xr);
}
my ($min_digit, $max_digit);
# 3--2
# |
# 0--1
if ($xr == 0) {
# 0 or 3
if ($yr == 0) {
# x,y both low, 0 only
$min_digit = 0;
$max_digit = 0;
} elsif ($yr == 1) {
# y either, 0 or 3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 3 only
$min_digit = 3;
$max_digit = 3;
}
} elsif ($xr == 1) {
# x either, any 0,1,2,3
if ($yr == 0) {
# y low, 0 or 1
$min_digit = 0;
$max_digit = 1;
} elsif ($yr == 1) {
# y either, 0,1,2,3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 2,3 only
$min_digit = 2;
$max_digit = 3;
}
} else {
# x high, 1 or 2
if ($yr == 0) {
# y low, 1 only
$min_digit = 1;
$max_digit = 1;
} elsif ($yr == 1) {
# y either, 1 or 2
$min_digit = 1;
$max_digit = 2;
} elsif ($yr == 2) {
# y high, 2 only
$min_digit = 2;
$max_digit = 2;
}
}
### range store: $state+$bits
my $key = 3*$state + $bits;
if (defined $min_digit[$key]) {
# die "oops min_digit[] already: state=$state bits=$bits value=$min_digit[$state+$bits], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
foreach my $orig_digit (0, 1, 2, 3) {
my $digit = $orig_digit;
my $xo = 0;
my $yo = 0;
my $new_transpose = $transpose;
my $new_rot = $rot;
my $new_spiral;
# 3--2
# |
# 0--1
if ($digit == 0) {
if ($spiral) {
$new_spiral = 1;
$new_rot ^= 1;
} else {
$new_transpose ^= 1;
$new_spiral = 0;
}
} elsif ($digit == 1) {
$xo = 1;
$new_spiral = 0;
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_spiral = 0;
} elsif ($digit == 3) {
$yo = 1;
$new_transpose ^= 1;
$new_rot ^= 1;
$new_spiral = 0;
}
### base: "$xo, $yo"
if ($transpose) {
($xo,$yo) = ($yo,$xo);
}
### transp to: "$xo, $yo"
if ($rot) {
$xo ^= 1;
$yo ^= 1;
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$xy_to_digit[$state + $xo*2+$yo] = $orig_digit;
my $next_state = make_state
($new_rot, $new_transpose, $new_spiral);
$next_state[$state+$orig_digit] = $next_state;
}
}
}
}
### @next_state
### @digit_to_x
### @digit_to_y
### next_state length: 4*(4*2*2 + 4*2)
### next_state length: scalar(@next_state)
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("xy_to_digit", \@xy_to_digit);
print_table12 ("min_digit", \@min_digit);
print_table12 ("max_digit", \@max_digit);
my $spiral_rot_state = make_state (1, # rot
0, # transpose
1); # spiral
print "# neg state $spiral_rot_state\n";
print "\n";
exit 0;
__END__
my $x_cmp = $x_max + $len;
my $y_cmp = $y_max + $len;
my $digit = $min_digit[4*$min_state + ($x1 >= $x_cmp) + 2*($x2 >= $x_cmp)
+ ($y1 >= $y_cmp) + 2*($y2 >= $y_cmp)];
$min_state += $digit;
$n_lo += $digit * $power;
if ($digit_to_x[$min_state]) { $x_min += $len; }
if ($digit_to_y[$min_state]) { $x_min += $len; }
$min_state = $next_state[$min_state + $min_digit];
Math-PlanePath-122/tools/dekking-curve-table.pl 0000644 0001750 0001750 00000015435 12021305065 017221 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use List::Util 'max';
use Math::PlanePath::DekkingCentres;
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {defined $_ ? length : 5} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if ($entry_width >= 2 && ($i % 25) == 4) {
print " # ".($i-4);
}
if (($i % 25) == 24
|| $entry_width >= 2 && ($i % 5) == 4) {
print "\n ".(" " x length($name));
} elsif (($i % 5) == 4) {
print " ";
}
}
}
}
sub make_state {
my ($rev, $rot) = @_;
$rev %= 2;
$rot %= 4;
return 25*($rot + 4*$rev);
}
my @next_state;
my @edge_dx;
my @edge_dy;
my @yx_to_digit;
foreach my $rev (0, 1) {
foreach my $rot (0, 1, 2, 3) {
foreach my $orig_digit (0 .. 24) {
my $digit = $orig_digit;
if ($rev) {
$digit = 25-$digit;
}
my $xo;
my $yo;
my $new_rot = $rot;
my $new_rev = $rev;
if ($digit == 0) {
$xo = 0;
$yo = 0;
} elsif ($digit == 1) {
$xo = 1;
$yo = 0;
} elsif ($digit == 2) {
$xo = 2;
$yo = 0;
$new_rot = $rot - 1;
$new_rev ^= 1;
} elsif ($digit == 3) {
$xo = 2;
$yo = 1;
$new_rev ^= 1;
} elsif ($digit == 4) {
$xo = 1;
$yo = 1;
$new_rot = $rot + 1;
} elsif ($digit == 5) {
$xo = 1;
$yo = 2;
} elsif ($digit == 6) {
$xo = 2;
$yo = 2;
$new_rot = $rot - 1;
$new_rev ^= 1;
} elsif ($digit == 7) {
$xo = 2;
$yo = 3;
$new_rev ^= 1;
} elsif ($digit == 8) {
$xo = 1;
$yo = 3;
$new_rot = $rot + 2;
} elsif ($digit == 9) {
$xo = 0;
$yo = 3;
$new_rot = $rot - 1;
$new_rev ^= 1;
} elsif ($digit == 10) {
$xo = 0;
$yo = 4;
} elsif ($digit == 11) {
$xo = 1;
$yo = 4;
} elsif ($digit == 12) {
$xo = 2;
$yo = 4;
$new_rot = $rot + 2;
$new_rev ^= 1;
} elsif ($digit == 13) {
$xo = 3;
$yo = 4;
$new_rot = $rot + 1;
} elsif ($digit == 14) {
$xo = 3;
$yo = 5;
$new_rot = $rot + 2;
$new_rev ^= 1;
} elsif ($digit == 15) {
$xo = 4;
$yo = 5;
$new_rot = $rot - 1;
} elsif ($digit == 16) {
$xo = 4;
$yo = 4;
$new_rot = $rot - 1;
} elsif ($digit == 17) {
$xo = 4;
$yo = 3;
$new_rev ^= 1;
} elsif ($digit == 18) {
$xo = 3;
$yo = 3;
$new_rot = $rot - 1;
} elsif ($digit == 19) {
$xo = 3;
$yo = 2;
$new_rot = $rot + 1;
$new_rev ^= 1;
} elsif ($digit == 20) {
$xo = 3;
$yo = 1;
$new_rot = $rot + 2;
$new_rev ^= 1;
} elsif ($digit == 21) {
$xo = 4;
$yo = 1;
$new_rot = $rot + 1;
} elsif ($digit == 22) {
$xo = 4;
$yo = 2;
} elsif ($digit == 23) {
$xo = 5;
$yo = 2;
$new_rot = $rot + 1;
$new_rev ^= 1;
} elsif ($digit == 24) {
$xo = 5;
$yo = 1;
$new_rot = $rot + 1;
$new_rev ^= 1;
} elsif ($digit == 25) {
$xo = 5;
$yo = 0;
$new_rot = $rot + 1;
} else {
die;
}
### base: "$xo, $yo"
my $state = make_state ($rev, $rot);
my $shift_xo = $xo;
my $shift_yo = $yo;
if ($rot & 2) {
$shift_xo = 5 - $shift_xo;
$shift_yo = 5 - $shift_yo;
}
if ($rot & 1) {
($shift_xo,$shift_yo) = (5-$shift_yo,$shift_xo);
}
$yx_to_digit[$state + $shift_yo*5 + $shift_xo] = $orig_digit;
# if ($rev) {
# if (($rot % 4) == 0) {
# } elsif (($rot % 4) == 1) {
# $yo -= 1;
# } elsif (($rot % 4) == 2) {
# $yo -= 1;
# $xo -= 1;
# } elsif (($rot % 4) == 3) {
# $xo -= 1;
# }
# } else {
# if (($rot % 4) == 0) {
# } elsif (($rot % 4) == 1) {
# $yo -= 1;
# } elsif (($rot % 4) == 2) {
# $yo -= 1;
# $xo -= 1;
# } elsif (($rot % 4) == 3) {
# $xo -= 1;
# }
# # $xo -= 1;
# }
if ($rot & 2) {
$xo = 5 - $xo;
$yo = 5 - $yo;
}
if ($rot & 1) {
($xo,$yo) = (5-$yo,$xo);
}
### rot to: "$xo, $yo"
$edge_dx[$state+$orig_digit] = $xo - $Math::PlanePath::DekkingCentres::_digit_to_x[$state+$orig_digit];
$edge_dy[$state+$orig_digit] = $yo - $Math::PlanePath::DekkingCentres::_digit_to_y[$state+$orig_digit];
my $next_state = make_state ($new_rev, $new_rot);
$next_state[$state+$orig_digit] = $next_state;
}
}
}
print "# state length ",scalar(@next_state)," in each of 4 tables\n";
# print_table ("next_state", \@next_state);
print_table ("edge_dx", \@edge_dx);
print_table ("edge_dy", \@edge_dy);
# print_table ("last_yx_to_digit", \@yx_to_digit);
### @next_state
### @edge_dx
### @edge_dy
### @yx_to_digit
### next_state length: scalar(@next_state)
print "\n";
exit 0;
Math-PlanePath-122/tools/beta-omega-table.pl 0000644 0001750 0001750 00000027037 12161517122 016471 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl beta-omega-table.pl
#
# Print the state tables used in BetaOmega.pm.
#
# This isn't a thing of beauty. A state incorporates the beta vs omega
# shape and the orientation of that shape as 4 rotations by 90-degrees, a
# transpose swapping X,Y, and a reversal for numbering points the opposite
# way around.
#
# The reversal is only needed for the beta, as noted in the
# Math::PlanePath::BetaOmega POD. For an omega the reverse is the same as
# the forward. make_state() collapses a reverse omega down to corresponding
# plain forward omega.
#
# State values are 0, 4, 8, etc. Having them 4 apart means a base 4 digit
# from N in n_to_xy() can be added state+digit to make an index into the
# tables.
#
# For @max_digit and @min_digit the input is instead 3*3=9 values, and in
# those tables the index is "state*3 + input". 3*state puts states 12
# apart, which is more than the 9 input values needs, but 3*state is a
# little less work in the code than say (state/4)*9 to change from 4-stride
# to exactly 9-stride.
#
use 5.010;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 16) == 15
|| ($entry_width >= 3 && ($i % 4) == 3)) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
sub print_table12 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 12) == 11) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @xy_to_digit;
my @min_digit;
my @max_digit;
sub state_string {
my ($state) = @_;
my $digit = $state % 4; $state = int($state/4);
my $transpose = $state % 2; $state = int($state/2);
my $rot = $state % 4; $state = int($state/4);
my $rev = $state % 2; $state = int($state/2);
my $omega = $state % 2; $state = int($state/2);
my $omega_str = ($omega ? 'omega' : 'beta');
return "$omega_str transpose=$transpose rot=$rot rev=$rev";
}
sub make_state {
my ($omega, $rev, $rot, $transpose, $digit) = @_;
if ($omega && $rev) {
$rev = 0;
if ($transpose) {
$rot--;
} else {
$rot++;
}
$transpose ^= 1;
}
$transpose %= 2;
$rev %= 2;
$rot %= 4;
return $digit + 4*($transpose + 2*($rot + 4*($rev + 2*$omega)));
}
foreach my $omega (0, 1) {
foreach my $rev (0, ($omega ? () : (1))) {
foreach my $rot (0, 1, 2, 3) {
foreach my $transpose (0, 1) {
my $state = make_state ($omega, $rev, $rot, $transpose, 0);
### $state
# range 0 [X,_]
# range 1 [X,X]
# range 2 [_,X]
foreach my $xrange (0,1,2) {
foreach my $yrange (0,1,2) {
my $xr = $xrange;
my $yr = $yrange;
my $bits = $xr + 3*$yr; # before transpose etc
if ($rot & 1) {
($xr,$yr) = ($yr,2-$xr);
}
if ($rot & 2) {
$xr = 2-$xr;
$yr = 2-$yr;
}
if ($transpose) {
($xr,$yr) = ($yr,$xr);
}
if ($rev) {
# 2--1
# | |
# 3 0
$xr = 2-$xr;
}
my ($min_digit, $max_digit);
# 1--2
# | |
# 0 3
if ($xr == 0) {
# 0 or 1 only
if ($yr == 0) {
# x,y both low, 0 only
$min_digit = 0;
$max_digit = 0;
} elsif ($yr == 1) {
# y either, 0 or 1
$min_digit = 0;
$max_digit = 1;
} elsif ($yr == 2) {
# y high, 1 only
$min_digit = 1;
$max_digit = 1;
}
} elsif ($xr == 1) {
# x either, any 0,1,2,3
if ($yr == 0) {
# y low, 0 or 3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 1) {
# y either, 0,1,2,3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 1,2 only
$min_digit = 1;
$max_digit = 2;
}
} else {
# x high, 2 or 3
if ($yr == 0) {
# y low, 3 only
$min_digit = 3;
$max_digit = 3;
} elsif ($yr == 1) {
# y either, 2 or 3
$min_digit = 2;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 2 only
$min_digit = 2;
$max_digit = 2;
}
}
### range store: $state+$bits
my $key = 3*$state + $bits;
if (defined $min_digit[$key]) {
die "oops min_digit[] already: state=$state bits=$bits value=$min_digit[$state+$bits], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
foreach my $orig_digit (0, 1, 2, 3) {
my $digit = $orig_digit;
if ($rev) {
$digit = 3-$digit;
}
my $xo = 0;
my $yo = 0;
my $new_transpose = $transpose;
my $new_rot = $rot;
my $new_omega = 0;
my $new_rev = $rev;
if ($omega) {
# 1---2
# | |
# --0 3--
$new_omega = 0;
if ($digit == 0) {
$new_transpose = $transpose ^ 1;
if ($transpose) {
$new_rot = $rot + 1;
} else {
$new_rot = $rot - 1;
}
} elsif ($digit == 1) {
$yo = 1;
if ($transpose) {
$new_rot = $rot - 1;
} else {
$new_rot = $rot + 1;
}
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_transpose = $transpose ^ 1;
$new_rev ^= 1;
} elsif ($digit == 3) {
$xo = 1;
$new_rot = $rot + 2;
$new_rev ^= 1;
}
} else {
# 1---2
# | |
# --0 3
# |
if ($digit == 0) {
$new_transpose = $transpose ^ 1;
if ($transpose) {
$new_rot = $rot + 1;
} else {
$new_rot = $rot - 1;
}
} elsif ($digit == 1) {
$yo = 1;
if ($transpose) {
$new_rot = $rot - 1;
} else {
$new_rot = $rot + 1;
}
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_transpose = $transpose ^ 1;
$new_rev ^= 1;
} elsif ($digit == 3) {
$xo = 1;
if ($transpose) {
$new_rot = $rot + 1;
} else {
$new_rot = $rot - 1;
}
$new_omega = 1;
}
}
### base: "$xo, $yo"
if ($transpose) {
($xo,$yo) = ($yo,$xo);
}
### transp to: "$xo, $yo"
if ($rot & 2) {
$xo ^= 1;
$yo ^= 1;
}
if ($rot & 1) {
($xo,$yo) = ($yo^1,$xo);
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$xy_to_digit[$state + $xo*2+$yo] = $orig_digit;
my $next_state = make_state
($new_omega, $new_rev, $new_rot, $new_transpose, 0);
$next_state[$state+$orig_digit] = $next_state;
}
}
}
}
}
### @next_state
### @digit_to_x
### @digit_to_y
### next_state length: 4*(4*2*2 + 4*2)
### next_state length: scalar(@next_state)
my $next_state_size = scalar(@next_state);
my $state_count = $next_state_size/4;
print "# next_state table has $next_state_size entries, is $state_count states\n";
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("xy_to_digit", \@xy_to_digit);
print_table12 ("min_digit", \@min_digit);
print_table12 ("max_digit", \@max_digit);
my $invert_state = make_state (0, # omega
0, # rev
3, # rot
1, # transpose
0); # digit
### $invert_state
print "\n";
{
my @pending_state = (0);
my $count = 0;
my @seen_state;
my $depth = 0;
$seen_state[0] = $depth;
while (@pending_state) {
$depth++;
my @new_pending_state;
foreach my $state (@pending_state) {
$count++;
### consider state: $state
foreach my $digit (0 .. 3) {
my $next_state = $next_state[$state+$digit];
if (! defined $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @new_pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
}
@pending_state = @new_pending_state;
}
for (my $state = 0; $state < @next_state; $state += 4) {
print "# used state $state depth $seen_state[$state]\n";
}
print "used state count $count\n";
}
{
print "\n";
print "initial 0: ",state_string(0),"\n";
print "initial 28: ",state_string(28),"\n";
require Graph::Easy;
my $g = Graph::Easy->new;
for (my $state = 0; $state < scalar(@next_state); $state += 4) {
my $next = $next_state[$state];
$g->add_edge("$state: ".state_string($state),
"$next: ".state_string($next));
}
print $g->as_ascii();
}
exit 0;
Math-PlanePath-122/tools/pythagorean-tree.pl 0000644 0001750 0001750 00000003223 12301760112 016643 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl pythagorean-tree.pl
#
# Print tree diagrams used in the Math::PlanePath::PythagoreanTree docs.
#
use 5.010;
use strict;
use Math::PlanePath::PythagoreanTree;
foreach my $tree_type ('UAD','UArD','FB','UMT') {
my $str = <<"HERE";
tree_type => "$tree_type"
+-> 00005
+-> 00002 --+-> 00006
| +-> 00007
|
| +-> 00008
001 --+-> 00003 --+-> 00009
| +-> 00010
|
| +-> 00011
+-> 00004 --+-> 00012
+-> 00013
HERE
my $path = Math::PlanePath::PythagoreanTree->new(tree_type => $tree_type,
coordinates => 'AB');
$str =~ s{(\d+)}
{
my ($x,$y) = $path->n_to_xy($1);
my $len = length($1);
sprintf '%-*s', $len, "$x,$y";
}ge;
print $str;
}
Math-PlanePath-122/tools/hilbert-curve-table.pl 0000644 0001750 0001750 00000014713 12036160013 017232 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%d", $aref->[$i];
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 16) == 15) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
sub print_table12 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 12) == 11) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
sub make_state {
my ($rot, $transpose) = @_;
$transpose %= 2;
$rot %= 2;
return 4*($transpose + 2*$rot);
}
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @yx_to_digit;
my @min_digit;
my @max_digit;
foreach my $rot (0, 1) {
foreach my $transpose (0, 1) {
my $state = make_state ($rot, $transpose);
# range 0 [X,_]
# range 1 [X,X]
# range 2 [_,X]
foreach my $xrange (0,1,2) {
foreach my $yrange (0,1,2) {
my $xr = $xrange;
my $yr = $yrange;
my $bits = $xr + 3*$yr; # before rot+transpose
if ($rot) {
$xr = 2-$xr;
$yr = 2-$yr;
}
if ($transpose) {
($xr,$yr) = ($yr,$xr);
}
my ($min_digit, $max_digit);
# 3--2
# |
# 0--1
if ($xr == 0) {
# 0 or 3
if ($yr == 0) {
# x,y both low, 0 only
$min_digit = 0;
$max_digit = 0;
} elsif ($yr == 1) {
# y either, 0 or 3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 3 only
$min_digit = 3;
$max_digit = 3;
}
} elsif ($xr == 1) {
# x either, any 0,1,2,3
if ($yr == 0) {
# y low, 0 or 1
$min_digit = 0;
$max_digit = 1;
} elsif ($yr == 1) {
# y either, 0,1,2,3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 2,3 only
$min_digit = 2;
$max_digit = 3;
}
} else {
# x high, 1 or 2
if ($yr == 0) {
# y low, 1 only
$min_digit = 1;
$max_digit = 1;
} elsif ($yr == 1) {
# y either, 1 or 2
$min_digit = 1;
$max_digit = 2;
} elsif ($yr == 2) {
# y high, 2 only
$min_digit = 2;
$max_digit = 2;
}
}
### range store: $state+$bits
my $key = 3*$state + $bits;
if (defined $min_digit[$key]) {
die "oops min_digit[] already: state=$state bits=$bits value=$min_digit[$state+$bits], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
foreach my $orig_digit (0, 1, 2, 3) {
my $digit = $orig_digit;
my $xo = 0;
my $yo = 0;
my $new_transpose = $transpose;
my $new_rot = $rot;
# 3--2
# |
# 0--1
if ($digit == 0) {
$new_transpose ^= 1;
} elsif ($digit == 1) {
$xo = 1;
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
} elsif ($digit == 3) {
$yo = 1;
$new_transpose ^= 1;
$new_rot ^= 1;
}
### base: "$xo, $yo"
if ($transpose) {
($xo,$yo) = ($yo,$xo);
}
### transp to: "$xo, $yo"
if ($rot) {
$xo ^= 1;
$yo ^= 1;
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$yx_to_digit[$state + 2*$yo + $xo] = $orig_digit;
my $next_state = make_state ($new_rot, $new_transpose);
$next_state[$state+$orig_digit] = $next_state;
}
}
}
### @next_state
### @digit_to_x
### @digit_to_y
### next_state length: 4*(4*2*2 + 4*2)
### next_state length: scalar(@next_state)
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("yx_to_digit", \@yx_to_digit);
print_table12 ("min_digit", \@min_digit);
print_table12 ("max_digit", \@max_digit);
my $invert_state = make_state (1, # rot
1); # transpose
### $invert_state
print "\n";
exit 0;
__END__
my $x_cmp = $x_max + $len;
my $y_cmp = $y_max + $len;
my $digit = $min_digit[4*$min_state + ($x1 >= $x_cmp) + 2*($x2 >= $x_cmp)
+ ($y1 >= $y_cmp) + 2*($y2 >= $y_cmp)];
$min_state += $digit;
$n_lo += $digit * $power;
if ($digit_to_x[$min_state]) { $x_min += $len; }
if ($digit_to_y[$min_state]) { $x_min += $len; }
$min_state = $next_state[$min_state + $min_digit];
Math-PlanePath-122/tools/kochel-curve-table.pl 0000644 0001750 0001750 00000020264 11666767323 017075 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use List::Util 'min','max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {defined && length} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print "); # ",$i-8,"\n";
} else {
print ",";
if (($i % 9) == 8) {
print " # ".($i-8);
}
if (($i % 9) == 8) {
print "\n ".(" " x length($name));
} elsif (($i % 3) == 2) {
print " ";
}
}
}
}
sub print_table36 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {defined && length} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*d", $entry_width, $aref->[$i];
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 36) == 5) {
print " # ".($i-5);
}
if (($i % 6) == 5) {
print "\n ".(" " x length($name));
} elsif (($i % 6) == 5) {
print " ";
}
}
}
}
sub make_state {
my ($f, $rev, $rot) = @_;
$rev %= 2;
if ($f && $rev) {
$rot += 2;
$rev = 0;
}
$rot %= 4;
return 9*($rot + 4*($rev + 2*$f));
}
# x__ 0
# xx_ 1
# xxx 2
# _xx 3
# __x 4
# _x_ 5
my @r_to_cover = ([1,0,0],
[1,1,0],
[1,1,1],
[0,1,1],
[0,0,1],
[0,1,0]);
my @reverse_range = (4,3,2,1,0,5);
my @min_digit;
my @max_digit;
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @xy_to_digit;
foreach my $f (0, 1) {
foreach my $rot (0, 1, 2, 3) {
foreach my $rev (0, ($f ? () : (1))) {
my $state = make_state ($f, $rev, $rot);
foreach my $orig_digit (0 .. 8) {
my $digit = $orig_digit;
if ($rev) {
$digit = 8-$digit;
}
my $xo;
my $yo;
my $new_rot = $rot;
my $new_rev = $rev;
my $new_f;
if ($f) {
if ($digit == 0) {
$xo = 0;
$yo = 0;
$new_f = 0;
$new_rev ^= 1;
$new_rot = $rot - 1;
} elsif ($digit == 1) {
$xo = 0;
$yo = 1;
$new_f = 1;
} elsif ($digit == 2) {
$xo = 0;
$yo = 2;
$new_f = 0;
$new_rot = $rot + 1;
} elsif ($digit == 3) {
$xo = 1;
$yo = 2;
$new_rot = $rot - 1;
$new_f = 1;
} elsif ($digit == 4) {
$xo = 1;
$yo = 1;
$new_f = 1;
$new_rot = $rot + 2;
} elsif ($digit == 5) {
$xo = 1;
$yo = 0;
$new_f = 1;
$new_rot = $rot - 1;
} elsif ($digit == 6) {
$xo = 2;
$yo = 0;
$new_f = 0;
$new_rot = $rot - 1;
$new_rev ^= 1;
} elsif ($digit == 7) {
$xo = 2;
$yo = 1;
$new_f = 1;
} elsif ($digit == 8) {
$xo = 2;
$yo = 2;
$new_f = 0;
$new_rot = $rot + 1;
} else {
die;
}
} else {
if ($digit == 0) {
$xo = 0;
$yo = 0;
$new_rev ^= 1;
$new_f = 0;
$new_rot = $rot - 1;
} elsif ($digit == 1) {
$xo = 0;
$yo = 1;
$new_f = 1;
} elsif ($digit == 2) {
$xo = 0;
$yo = 2;
$new_f = 0;
$new_rot = $rot + 1;
} elsif ($digit == 3) {
$xo = 1;
$yo = 2;
$new_rot = $rot - 1;
$new_f = 1;
} elsif ($digit == 4) {
$xo = 2;
$yo = 2;
$new_f = 0;
} elsif ($digit == 5) {
$xo = 2;
$yo = 1;
$new_f = 1;
$new_rot = $rot + 2;
} elsif ($digit == 6) {
$xo = 1;
$yo = 1;
$new_f = 0;
$new_rev ^= 1;
} elsif ($digit == 7) {
$xo = 1;
$yo = 0;
$new_f = 1;
$new_rot = $rot - 1;
} elsif ($digit == 8) {
$xo = 2;
$yo = 0;
$new_f = 0;
} else {
die;
}
}
### base: "$xo, $yo"
if ($rot & 2) {
$xo = 2 - $xo;
$yo = 2 - $yo;
}
if ($rot & 1) {
($xo,$yo) = (2-$yo,$xo);
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$xy_to_digit[$state + 3*$xo + $yo] = $orig_digit;
my $next_state = make_state ($new_f, $new_rev, $new_rot);
$next_state[$state+$orig_digit] = $next_state;
}
foreach my $xrange (0 .. 5) {
foreach my $yrange (0 .. 5) {
my $xr = $xrange;
my $yr = $yrange;
my $bits = $xr + 6*$yr; # before transpose etc
my $key = 4*$state + $bits;
### assert: (4*$state % 36) == 0
my $min_digit = 8;
my $max_digit = 0;
foreach my $digit (0 .. 8) {
my $x = $digit_to_x[$state + $digit];
my $y = $digit_to_y[$state + $digit];
next unless $r_to_cover[$xr]->[$x];
next unless $r_to_cover[$yr]->[$y];
$min_digit = min($digit,$min_digit);
$max_digit = max($digit,$max_digit);
}
### min/max: "state=$state 4*state=".(4*$state)." bits=$bits key=$key"
if (defined $min_digit[$key]) {
# die "oops min_digit[] already: state=$state bits=$bits value=$min_digit[$state+$bits], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
}
}
}
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("xy_to_digit", \@xy_to_digit);
print_table36 ("min_digit", \@min_digit);
print_table36 ("max_digit", \@max_digit);
print "# state length ",scalar(@next_state)," in each of 4 tables\n\n";
print "# R reverse state ",make_state(0,1,-1),"\n";
### @next_state
### @digit_to_x
### @digit_to_y
### @xy_to_digit
### next_state length: scalar(@next_state)
{
my @pending_state = (0);
my $count = 0;
my @seen_state;
my $depth = 1;
$seen_state[0] = $depth;
while (@pending_state) {
my $state = pop @pending_state;
$count++;
### consider state: $state
foreach my $digit (0 .. 8) {
my $next_state = $next_state[$state+$digit];
if (! $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
$depth++;
}
for (my $state = 0; $state < @next_state; $state += 9) {
print "# used state $state depth $seen_state[$state]\n";
}
print "used state count $count\n";
}
print "\n";
exit 0;
Math-PlanePath-122/tools/dragon-curve-dxdy.pl 0000644 0001750 0001750 00000011634 12022543023 016734 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl dragon-curve-dxdy.pl
#
# Print the state tables used for DragonCurve n_to_dxdy(). These are not
# the same as the tables for n_to_xy() which are in dragon-curve-table.pl.
use 5.010;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 16) == 15
|| ($entry_width >= 3 && ($i % 4) == 3)) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
my @next_state;
my @state_to_dxdy;
sub make_state {
my %param = @_;
my $state = 0;
$state <<= 1; $state |= delete $param{'nextturn'}; # high
$state <<= 2; $state |= delete $param{'rot'};
$state <<= 1; $state |= delete $param{'prevbit'};
$state <<= 1; $state |= delete $param{'digit'}; # low
if (%param) { die; }
return $state;
}
sub state_string {
my ($state) = @_;
my $digit = $state & 1; $state >>= 1;
my $prevbit = $state & 1; $state >>= 1;
my $rot = $state & 3; $state >>= 2;
my $nextturn = $state & 1; $state >>= 1;
return "rot=$rot prevbit=$prevbit (digit=$digit)";
}
foreach my $nextturn (0, 1) {
foreach my $rot (0, 1, 2, 3) {
foreach my $prevbit (0, 1) {
my $state = make_state (nextturn => $nextturn,
rot => $rot,
prevbit => $prevbit,
digit => 0);
### $state
foreach my $bit (0, 1) {
my $new_nextturn = $nextturn;
my $new_prevbit = $bit;
my $new_rot = $rot;
if ($bit != $prevbit) { # count 0<->1 transitions
$new_rot++;
$new_rot &= 3;
}
if ($bit == 0) {
$new_nextturn = $prevbit; # bit above lowest 0
}
my $dx = 1;
my $dy = 0;
if ($rot & 2) {
$dx = -$dx;
$dy = -$dy;
}
if ($rot & 1) {
($dx,$dy) = (-$dy,$dx); # rotate +90
}
### rot to: "$dx, $dy"
my $next_dx = $dx;
my $next_dy = $dy;
if ($nextturn) {
($next_dx,$next_dy) = ($next_dy,-$next_dx); # right, rotate -90
} else {
($next_dx,$next_dy) = (-$next_dy,$next_dx); # left, rotate +90
}
my $frac_dx = $next_dx - $dx;
my $frac_dy = $next_dy - $dy;
my $masked_state = $state & 0x1C;
$state_to_dxdy[$masked_state] = $dx;
$state_to_dxdy[$masked_state + 1] = $dy;
$state_to_dxdy[$masked_state + 2] = $frac_dx;
$state_to_dxdy[$masked_state + 3] = $frac_dy;
my $next_state = make_state
(nextturn => $new_nextturn,
rot => $new_rot,
prevbit => $new_prevbit,
digit => 0);
$next_state[$state+$bit] = $next_state;
}
}
}
}
### @next_state
### @state_to_dxdy
### next_state length: 4*(4*2*2 + 4*2)
print "# next_state length ", scalar(@next_state), "\n";
print_table ("next_state", \@next_state);
print_table ("state_to_dxdy", \@state_to_dxdy);
print "\n";
{
my @pending_state = (0, 4, 8, 12); # in 4 arm directions
my $count = 0;
my @seen_state;
my $depth = 1;
foreach my $state (@pending_state) {
$seen_state[$state] = $depth;
}
while (@pending_state) {
my @new_pending_state;
foreach my $state (@pending_state) {
$count++;
### consider state: $state
foreach my $bit (0 .. 1) {
my $next_state = $next_state[$state+$bit];
if (! $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @new_pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
$depth++;
}
@pending_state = @new_pending_state;
}
for (my $state = 0; $state < @next_state; $state += 2) {
$seen_state[$state] ||= '-';
my $state_string = state_string($state);
print "# used state $state depth $seen_state[$state] $state_string\n";
}
print "used state count $count\n";
}
exit 0;
Math-PlanePath-122/tools/flowsnake-centres-table.pl 0000644 0001750 0001750 00000013732 12063226253 020122 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Not working
# Usage: perl flowsnake-centres-table.pl
#
# Print the state tables used for Math:PlanePath::FlowsnakeCentres n_to_xy().
use 5.010;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table14 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
my $entry_str = $aref->[$i]//'undef';
if ($i == $#$aref) {
$entry_str .= ");";
} else {
$entry_str .= ",";
}
if ($i % 14 == 0 && $#$aref > 14) {
printf "%-*s", $entry_width+1, $entry_str;
} else {
printf "%*s", $entry_width+1, $entry_str;
}
if ($i % 14 == 13) {
print " # ",$i-13,",",$i-6,"\n";
if ($i != $#$aref) {
print " ".(" " x length($name));
}
} elsif ($i % 7 == 6) {
print " ";
}
}
}
sub print_table12 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
my $entry_str = $aref->[$i]//'undef';
if ($i == $#$aref) {
$entry_str .= ");";
} else {
$entry_str .= ",";
}
if ($i % 12 == 0 && $#$aref > 12) {
printf "%-*s", $entry_width+1, $entry_str;
} else {
printf "%*s", $entry_width+1, $entry_str;
}
if ($i % 12 == 11) {
print "\n";
if ($i != $#$aref) {
print " ".(" " x length($name));
}
} elsif ($i % 6 == 5) {
print " ";
}
}
}
my @next_state;
my @digit_to_i;
my @digit_to_j;
my @state_to_di;
my @state_to_dj;
sub make_state {
my %param = @_;
my $state = 0;
$state *= 6; $state += delete $param{'rot'}; # high
$state *= 2; $state += delete $param{'rev'};
$state *= 7; $state += delete $param{'digit'}; # low
if (%param) { die; }
return $state;
}
sub state_string {
my ($state) = @_;
my $digit = $state % 7; $state = int($state/7); # low
my $rev = $state % 2; $state = int($state/2);
my $rot = $state % 6; $state = int($state/6); # high
return "rot=$rot rev=$rev (digit=$digit)";
}
foreach my $rev (0, 1) {
foreach my $rot (0 .. 5) {
foreach my $digit (0 .. 6) {
my $state = make_state (rot => $rot,
rev => $rev,
digit => $digit);
my $new_rev = $rev;
my $new_rot = $rot;
my $plain_digit = ($rev ? 6-$digit : $digit);
my ($i, $j);
if ($rev) {
#
# 0 5
# ^ ^
# / / \
# 1 4 6----
# \ \
#
# 2-----3
if ($digit == 0) {
$i = 0;
$j = 0;
$new_rev = 0;
} elsif ($digit == 1) {
$i = 1;
$j = 0;
$new_rev = 1;
$new_rot += 1;
} elsif ($digit == 2) {
$i = 2;
$j = -1;
$new_rev = 1;
} elsif ($digit == 3) {
$i = 3;
$j = -1;
$new_rot += 1;
$new_rev = 1;
} elsif ($digit == 4) {
$i = 3;
$j = 0;
$new_rot += 3;
$new_rev = 0;
} elsif ($digit == 5) {
$i = 2;
$j = 0;
$new_rot += 2;
$new_rev = 0;
} elsif ($digit == 6) {
$i = 1;
$j = 1;
$new_rev = 1;
}
} else {
# 4-->5
# ^ \
# / v
# 3-->2 6<---7
# \
# v
# 0-->1
if ($digit == 0) {
$i = 0;
$j = 0;
$new_rev = 0;
} elsif ($digit == 1) {
$i = 1;
$j = 0;
$new_rev = 1;
$new_rot += 2;
} elsif ($digit == 2) {
$i = 0;
$j = 1;
$new_rev = 1;
$new_rot += 3;
} elsif ($digit == 3) {
$i = -1;
$j = 1;
$new_rev = 0;
$new_rot += 1;
} elsif ($digit == 4) {
$i = -1;
$j = 2;
$new_rev = 0;
} elsif ($digit == 5) {
$i = 0;
$j = 2;
$new_rev = 0;
$new_rot -= 1;
} elsif ($digit == 6) {
$i = 1;
$j = 1;
$new_rev = 1;
}
}
foreach (1 .. $rot) {
($i,$j) = (-$j, $i+$j); # rotate +60
}
$new_rot %= 6;
my $next_state = make_state
(rot => $new_rot,
rev => $new_rev,
digit => 0);
$next_state[$state] = $next_state;
$digit_to_i[$state] = $i;
$digit_to_j[$state] = $j;
}
my $state = make_state (rot => $rot,
rev => $rev,
digit => 0);
my $di = 1;
my $dj = 0;
foreach (1 .. $rot) {
($di,$dj) = (-$dj, $di+$dj); # rotate +60
}
$state_to_di[$state/7] = $di;
$state_to_dj[$state/7] = $dj;
}
}
### @next_state
### @digit_to_dxdy
### next_state length: 4*(4*2*2 + 4*2)
print "# next_state length ", scalar(@next_state), "\n";
print_table14 ("next_state", \@next_state);
print_table14 ("digit_to_i", \@digit_to_i);
print_table14 ("digit_to_j", \@digit_to_j);
print_table12 ("state_to_di", \@state_to_di);
print_table12 ("state_to_dj", \@state_to_dj);
print "\n";
exit 0;
Math-PlanePath-122/tools/flowsnake-table.pl 0000644 0001750 0001750 00000017173 12065504530 016463 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl flowsnake-table.pl
#
# Print the state tables used for Math:PlanePath::Flowsnake n_to_xy().
use 5.010;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table14 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
my $entry_str = $aref->[$i]//'undef';
if ($i == $#$aref) {
$entry_str .= ");";
} else {
$entry_str .= ",";
}
if ($i % 14 == 0 && $#$aref > 14) {
printf "%-*s", $entry_width+1, $entry_str;
} else {
printf "%*s", $entry_width+1, $entry_str;
}
if ($i % 14 == 13) {
print " # ",$i-13,",",$i-6,"\n";
if ($i != $#$aref) {
print " ".(" " x length($name));
}
} elsif ($i % 7 == 6) {
print " ";
}
}
}
sub print_table12 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
my $entry_str = $aref->[$i]//'undef';
if ($i == $#$aref) {
$entry_str .= ");";
} else {
$entry_str .= ",";
}
if ($i % 12 == 0 && $#$aref > 12) {
printf "%-*s", $entry_width+1, $entry_str;
} else {
printf "%*s", $entry_width+1, $entry_str;
}
if ($i % 12 == 11) {
print "\n";
if ($i != $#$aref) {
print " ".(" " x length($name));
}
} elsif ($i % 6 == 5) {
print " ";
}
}
}
my @next_state;
my @digit_to_i;
my @digit_to_j;
my @state_to_di;
my @state_to_dj;
sub make_state {
my %param = @_;
my $state = 0;
$state *= 6; $state += delete $param{'rot'}; # high
$state *= 2; $state += delete $param{'rev'};
$state *= 7; $state += delete $param{'digit'}; # low
if (%param) { die; }
return $state;
}
sub state_string {
my ($state) = @_;
my $digit = $state % 7; $state = int($state/7); # low
my $rev = $state % 2; $state = int($state/2);
my $rot = $state % 6; $state = int($state/6); # high
return "rot=$rot rev=$rev (digit=$digit)";
}
foreach my $rev (0, 1) {
foreach my $rot (0 .. 5) {
foreach my $digit (0 .. 6) {
my $state = make_state (rot => $rot,
rev => $rev,
digit => $digit);
my $new_rev = $rev;
my $new_rot = $rot;
my $plain_digit = ($rev ? 6-$digit : $digit);
my ($i, $j);
if ($rev) {
# 6<---7
# ^
# /
# 0 5<--4
# \ \
# v v
# 1<--2<--3
if ($digit == 0) {
$i = 0;
$j = 0;
$new_rev = 0;
$new_rot -= 1;
} elsif ($digit == 1) {
$i = 1;
$j = -1;
$new_rev = 1;
} elsif ($digit == 2) {
$i = 2;
$j = -1;
$new_rev = 1;
} elsif ($digit == 3) {
$i = 3;
$j = -1;
$new_rot += 2;
$new_rev = 1;
} elsif ($digit == 4) {
$i = 2;
$j = 0;
$new_rot += 3;
$new_rev = 0;
} elsif ($digit == 5) {
$i = 1;
$j = 0;
$new_rot += 1;
$new_rev = 0;
} elsif ($digit == 6) {
$i = 1;
$j = 1;
$new_rev = 1;
}
} else {
# 4-->5-->6
# ^ ^
# \ \
# 3-->2 7
# /
# v
# 0-->1
if ($digit == 0) {
$i = 0;
$j = 0;
$new_rev = 0;
} elsif ($digit == 1) {
$i = 1;
$j = 0;
$new_rev = 1;
$new_rot++;
} elsif ($digit == 2) {
$i = 1;
$j = 1;
$new_rev = 1;
$new_rot += 3;
} elsif ($digit == 3) {
$i = 0;
$j = 1;
$new_rev = 0;
$new_rot += 2;
} elsif ($digit == 4) {
$i = -1;
$j = 2;
$new_rev = 0;
} elsif ($digit == 5) {
$i = 0;
$j = 2;
$new_rev = 0;
} elsif ($digit == 6) {
$i = 1;
$j = 2;
$new_rev = 1;
$new_rot += 5;
}
}
foreach (1 .. $rot) {
($i,$j) = (-$j, $i+$j); # rotate +60
}
$new_rot %= 6;
my $next_state = make_state
(rot => $new_rot,
rev => $new_rev,
digit => 0);
$next_state[$state] = $next_state;
$digit_to_i[$state] = $i;
$digit_to_j[$state] = $j;
}
my $state = make_state (rot => $rot,
rev => $rev,
digit => 0);
my $di = 1;
my $dj = 0;
foreach (1 .. $rot) {
($di,$dj) = (-$dj, $di+$dj); # rotate +60
}
$state_to_di[$state/7] = $di;
$state_to_dj[$state/7] = $dj;
}
}
my @digit_to_next_di;
my @digit_to_next_dj;
my $end_i = 2;
my $end_j = 1;
my $state = 0;
foreach my $rot (0 .. 5) {
foreach my $rev (0, 1) {
foreach my $digit (0 .. 5) {
my $di;
if ($digit < 5) {
$di = $digit_to_i[$state + $digit + 2]
} else {
$di = $end_i;
}
$di -= $digit_to_i[$state + $digit + 1];
$digit_to_next_di[$state + $digit] = $di;
my $dj;
if ($digit < 5) {
$dj = $digit_to_j[$state + $digit + 2];
} else {
$dj = $end_j;
}
$dj -= $digit_to_j[$state + $digit + 1];
$digit_to_next_dj[$state + $digit] = $dj;
if ($di == 0 && $dj == 0) {
die "no delta at state=$state digit=$digit";
}
if ($rev) {
if ($digit == 0) {
($di,$dj) = ($di+$dj, -$di); # rotate -60
} elsif ($digit == 1) {
($di,$dj) = ($di+$dj, -$di); # rotate -60
} elsif ($digit == 2) {
($di,$dj) = ($di+$dj, -$di); # rotate -60
} elsif ($digit == 5) {
($di,$dj) = ($di+$dj, -$di); # rotate -60
}
} else {
if ($digit == 0) {
($di,$dj) = ($di+$dj, -$di); # rotate -60
} elsif ($digit == 1) {
($di,$dj) = ($di+$dj, -$di); # rotate -60
} elsif ($digit == 5) {
($di,$dj) = ($di+$dj, -$di); # rotate -60
}
}
$digit_to_next_di[$state + $digit + 84] = $di;
$digit_to_next_dj[$state + $digit + 84] = $dj;
}
$state += 7;
}
($end_i,$end_j) = (-$end_j, $end_i+$end_j); # rotate +60
}
### @next_state
### @digit_to_dxdy
### next_state length: 4*(4*2*2 + 4*2)
print "# next_state length ", scalar(@next_state), "\n";
print_table14 ("next_state", \@next_state);
print_table14 ("digit_to_i", \@digit_to_i);
print_table14 ("digit_to_j", \@digit_to_j);
print_table12 ("state_to_di", \@state_to_di);
print_table12 ("state_to_dj", \@state_to_dj);
print "\n";
print_table14 ("digit_to_next_di", \@digit_to_next_di);
print "\n";
print_table14 ("digit_to_next_dj", \@digit_to_next_dj);
print "\n";
exit 0;
Math-PlanePath-122/tools/moore-spiral-table.pl 0000644 0001750 0001750 00000006637 11713712763 017116 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
# uncomment this to run the ### lines
#use Smart::Comments;
sub make_state {
my ($rev, $rot) = @_;
$rev %= 2;
$rot %= 4;
return 10*($rot + 4*$rev);
}
sub state_string {
my ($state) = @_;
my $digit = $state % 10; $state = int($state/10);
my $rot = $state % 4; $state = int($state/4);
my $rev = $state % 2; $state = int($state/2);
return "rot=$rot rev=$rev" . ($digit ? " digit=$digit" : "");
}
my @min_digit;
my @max_digit;
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @xy_to_digit;
my @unrot_digit_to_x = (0,1,1, 0,-1,-2, -2,-2,-3, -3);
my @unrot_digit_to_y = (0,0,1, 1, 1, 1, 0,-1,-1, 0);
my @segment_to_rev = (0,0,0, 1,0,0, 1,1,1, 0);
my @segment_to_dir = (0,1,2, 2,2,3, 3,2,1, 0);
foreach my $rot (0, 1, 2, 3) {
foreach my $rev (0, 1) {
my $state = make_state ($rev, $rot);
foreach my $digit (0 .. 9) {
my $xo = $unrot_digit_to_x[$rev ? 9-$digit : $digit];
my $yo = $unrot_digit_to_y[$rev ? 9-$digit : $digit];
if ($rev) { $xo += 3 }
my $new_rev = $rev ^ $segment_to_rev[$rev ? 8-$digit : $digit];
my $new_rot = $rot + $segment_to_dir[$rev ? 8-$digit : $digit];
if ($new_rev) {
$new_rot += 0;
} else {
$new_rot += 2;
}
if ($rev) {
$new_rot += 2;
} else {
$new_rot += 0;
}
if ($rot & 2) {
$xo = - $xo;
$yo = - $yo;
}
if ($rot & 1) {
($xo,$yo) = (-$yo,$xo);
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$digit] = $xo;
$digit_to_y[$state+$digit] = $yo;
# $xy_to_digit[$state + 3*$xo + $yo] = $orig_digit;
my $next_state = make_state ($new_rev, $new_rot);
if ($digit == 9) { $next_state = undef; }
$next_state[$state+$digit] = $next_state;
}
}
}
use List::Util 'min','max';
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {defined && length} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print "); # ",$i-9,"\n";
} else {
print ",";
if (($i % 10) == 9) {
print " # ".($i-9);
}
if (($i % 10) == 9) {
print "\n ".(" " x length($name));
} elsif (($i % 3) == 2) {
print " ";
}
}
}
}
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
# print_table ("xy_to_digit", \@xy_to_digit);
# print_table36 ("min_digit", \@min_digit);
# print_table36 ("max_digit", \@max_digit);
print "# state length ",scalar(@next_state)," in each of 4 tables\n";
print "# rot2 state ",make_state(0,2),"\n";
exit 0;
Math-PlanePath-122/tools/cellular-rule-limits.pl 0000644 0001750 0001750 00000101247 12311703413 017443 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::CellularRule;
# uncomment this to run the ### lines
# use Smart::Comments;
my %h;
use Tie::IxHash;
tie %h, 'Tie::IxHash';
foreach my $rule (# 141,
0 .. 255,
) {
print "$rule\n";
my $path = Math::PlanePath::CellularRule->new(rule=>$rule);
unless (ref $path eq 'Math::PlanePath::CellularRule') {
### skip subclass: ref $path
next;
}
my @x;
my @y;
my @sumxy;
my @diffxy;
my $x_negative_at_n;
my @dx;
my @dy;
my @dsumxy;
my @ddiffxy;
my $n_start = $path->n_start;
foreach my $n ($n_start .. 200) {
my ($x,$y) = $path->n_to_xy($n)
or last;
### at: "n=$n xy=$x,$y"
push @x, $x;
push @y, $y;
push @sumxy, $x+$y;
push @diffxy, $x-$y;
if ($x < 0 && ! defined $x_negative_at_n) {
$x_negative_at_n = $n - $n_start;
### $x_negative_at_n
}
if (my ($dx,$dy) = $path->n_to_dxdy($n)) {
push @dx, $dx;
push @dy, $dy;
push @dsumxy, $dx+$dy;
push @ddiffxy, $dx-$dy;
}
}
$h{'x_minimum'}->[$rule] = min(@x);
$h{'x_maximum'}->[$rule] = max(@x);
$h{'y_maximum'}->[$rule] = max(@y);
### $x_negative_at_n
$h{'x_negative_at_n'}->[$rule] = $x_negative_at_n;
$h{'dx_minimum'}->[$rule] = min(@dx);
$h{'dx_maximum'}->[$rule] = max(@dx);
$h{'dy_minimum'}->[$rule] = min(@dy);
$h{'dy_maximum'}->[$rule] = max(@dy);
$h{'absdx_minimum'}->[$rule] = min(map{abs}@dx);
$h{'absdx_maximum'}->[$rule] = max(map{abs}@dx);
$h{'absdy_minimum'}->[$rule] = min(map{abs}@dy);
$h{'sumxy_minimum'}->[$rule] = min(@sumxy);
$h{'sumxy_maximum'}->[$rule] = max(@sumxy);
$h{'diffxy_minimum'}->[$rule] = min(@diffxy);
$h{'diffxy_maximum'}->[$rule] = max(@diffxy);
$h{'dsumxy_minimum'}->[$rule] = min(@dsumxy);
$h{'dsumxy_maximum'}->[$rule] = max(@dsumxy);
$h{'ddiffxy_minimum'}->[$rule] = min(@ddiffxy);
$h{'ddiffxy_maximum'}->[$rule] = max(@ddiffxy);
}
foreach my $name (keys %h,
# 'x_negative_at_n',
) {
print " my \@${name} = (\n";
my $aref = $h{$name};
while (@$aref && ! defined $aref->[-1]) {
pop @$aref;
}
my $row_rule;
foreach my $rule (0 .. $#$aref) {
if ($rule % 8 == 0) {
print " ";
$row_rule = $rule;
}
my $value = $aref->[$rule];
if (defined $value && $name ne 'x_negative_at_n' && ($value < -5 || $value > 5)) { $value = undef; }
if (! defined $value) { $value = 'undef'; }
printf " %5s,", $value;
if ($rule % 8 == 7 || $rule == $#$aref) { print " # rule=$row_rule\n"; }
}
}
exit 0;
__END__
my @dx_minimum = (
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -2, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -2, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, 0, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, 0, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -2, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -2, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, 0, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, 0, undef, undef, undef,
undef, undef, undef, undef, undef, undef,
my @dy_maximum = (
undef, 2, undef, 1, undef, 1, undef, 2,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 1, undef, 2, undef, 2, 1, 2,
undef, 1, undef, 1, 1, 1, 1, 2,
undef, 2, undef, 1, undef, 1, undef, 1,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 1, undef, 1, undef, 1, undef, 2,
undef, undef, undef, 1, undef, 1, 1, 2,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 1, undef, 1, 1, 1, 1, 2,
undef, 1, undef, 1, 1, 1, 1, 2,
undef, 2, undef, undef, undef, 1, undef, 1,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 1, undef, 1, 1, 1, 1, 2,
undef, 1, undef, 1, 1, 1, 1, 2,
undef, 2, undef, 1, undef, 1, undef, 1,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 1, undef, 1, undef, 1, 1, undef,
undef, 1, undef, 1, 1, 1, 1, undef,
undef, 2, undef, 1, undef, 1, undef, 1,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 1, undef, undef, undef, 1, 1, undef,
undef, 1, undef, 1, 1, 1, undef, undef,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 2, undef, 1, undef, 1, undef, 1,
undef, 1, undef, 1, 1, 1, 1, undef,
undef, 1, undef, 1, undef, 1, undef, undef,
undef, 2, undef, 1, undef, 1, 1, 1,
undef, 2, undef, 1, undef, 1, undef, 1,
undef, 1, undef, 1, 1, 1, undef, undef,
undef, 1, undef, 1, undef, 1,
my @absdy_minimum = (
undef, 0, undef, 0, undef, 0, undef, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
undef, 0, undef, 0, undef, 0, undef, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, undef, 0,
undef, undef, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
undef, 0, undef, undef, undef, 0, undef, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
undef, 0, undef, 0, undef, 0, undef, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, 0, undef,
undef, 0, undef, 0, 0, 0, 0, undef,
undef, 0, undef, 0, undef, 0, undef, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, undef, undef, 0, 0, undef,
undef, 0, undef, 0, 0, 0, undef, undef,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, undef, 0,
undef, 0, undef, 0, 0, 0, 0, undef,
undef, 0, undef, 0, undef, 0, undef, undef,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, undef, 0,
undef, 0, undef, 0, 0, 0, undef, undef,
undef, 0, undef, 0, undef, 0,
my @sum_maximum = (
0, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, 1, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, 1, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, 1, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, 1, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
0, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef,
my @diff_maximum = (
0, 0, undef, 0, undef, 0, undef, 0,
0, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
0, 0, undef, 0, undef, 0, undef, 0,
0, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, undef, 0,
undef, undef, undef, 0, undef, 0, 0, 0,
0, 0, undef, 0, undef, 0, 0, 0,
0, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
0, 0, undef, undef, undef, 0, undef, 0,
0, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
undef, 0, undef, 0, 0, 0, 0, 0,
0, 0, undef, 0, undef, 0, undef, 0,
0, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, 0, undef, 0, 0, undef,
undef, 0, undef, 0, 0, 0, 0, undef,
0, 0, undef, 0, undef, 0, undef, 0,
0, 0, undef, 0, undef, 0, 0, 0,
undef, 0, undef, undef, undef, 0, 0, undef,
undef, 0, undef, 0, 0, 0, undef, undef,
0, 0, undef, 0, undef, 0, 0, 0,
0, 0, undef, 0, undef, 0, undef, 0,
undef, 0, undef, 0, 0, 0, 0, undef,
undef, 0, undef, 0, undef, 0, undef, undef,
0, 0, undef, 0, undef, 0, 0, 0,
0, 0, undef, 0, undef, 0, undef, 0,
undef, 0, undef, 0, 0, 0, undef, undef,
undef, 0, undef, 0, undef, 0,
my @dsum_minimum = (
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -1, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -1, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, 1, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, 1, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -1, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -1, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, 1, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, 1, undef, undef, undef,
undef, undef, undef, undef, undef, undef,
my @ddiffxy_minimum = (
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -3, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -3, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, -1, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, -1, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -3, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, -3, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, -1, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, -1, undef, undef, undef,
undef, undef, undef, undef, undef, undef,
Math-PlanePath-122/tools/terdragon-midpoint-offset.pl 0000644 0001750 0001750 00000003216 11711717744 020502 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use Math::PlanePath::TerdragonMidpoint;
# uncomment this to run the ### lines
#use Smart::Comments;
my $path = Math::PlanePath::TerdragonMidpoint->new (arms => 1);
my @yx_to_dxdy;
foreach my $n (0 .. 3**10) {
my ($x,$y) = $path->n_to_xy($n);
my $to_n = $n;
if (($n % 3) == 0) {
$to_n = $n + 1;
} elsif (($n % 3) == 2) {
$to_n = $n - 1;
}
my ($to_x,$to_y) = $path->n_to_xy($to_n);
my $dx = $to_x - $x;
my $dy = $to_y - $y;
my $k = 2*(12*($y%12) + ($x%12));
$yx_to_dxdy[$k+0] = $dx;
$yx_to_dxdy[$k+1] = $dy;
}
print_72(\@yx_to_dxdy);
sub print_72 {
my ($aref) = @_;
print "(";
for (my $i = 0; $i < @$aref; ) {
my $v1 = $aref->[$i++] // 'undef';
my $v2 = $aref->[$i++] // 'undef';
my $str = "$v1,$v2";
if ($i != $#$aref) { $str .= ", " }
my $width = (($i % 4) == 2 ? 6 : 6);
printf "%-*s", $width, $str;
if (($i % 12) == 0) { print "\n " }
}
print ");\n";
}
exit 0;
Math-PlanePath-122/tools/corner-replicate-table.pl 0000644 0001750 0001750 00000007052 11660104640 017721 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
# There's no states for CornerReplicate, just two tables of 9 values for
# min/max digits.
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%d", $aref->[$i];
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 16) == 15) {
print "\n ".(" " x length($name));
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
sub print_table9 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 9) == 8) {
print "\n ".(" " x length($name));
} elsif (($i % 3) == 2) {
print " ";
}
}
}
}
my @min_digit;
my @max_digit;
# range 0 [X,_]
# range 1 [X,X]
# range 2 [_,X]
foreach my $xrange (0,1,2) {
foreach my $yrange (0,1,2) {
my $xr = $xrange;
my $yr = $yrange;
my $key = $xr + 3*$yr; # before rot+transpose
my ($min_digit, $max_digit);
# 3--2
# |
# 0--1
if ($xr == 0) {
# 0 or 3
if ($yr == 0) {
# x,y both low, 0 only
$min_digit = 0;
$max_digit = 0;
} elsif ($yr == 1) {
# y either, 0 or 3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 3 only
$min_digit = 3;
$max_digit = 3;
}
} elsif ($xr == 1) {
# x either, any 0,1,2,3
if ($yr == 0) {
# y low, 0 or 1
$min_digit = 0;
$max_digit = 1;
} elsif ($yr == 1) {
# y either, 0,1,2,3
$min_digit = 0;
$max_digit = 3;
} elsif ($yr == 2) {
# y high, 2,3 only
$min_digit = 2;
$max_digit = 3;
}
} else {
# x high, 1 or 2
if ($yr == 0) {
# y low, 1 only
$min_digit = 1;
$max_digit = 1;
} elsif ($yr == 1) {
# y either, 1 or 2
$min_digit = 1;
$max_digit = 2;
} elsif ($yr == 2) {
# y high, 2 only
$min_digit = 2;
$max_digit = 2;
}
}
if (defined $min_digit[$key]) {
die "oops min_digit[] already: key=$key value=$min_digit[$key], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
print_table9 ("min_digit", \@min_digit);
print_table9 ("max_digit", \@max_digit);
print "\n";
exit 0;
Math-PlanePath-122/tools/wythoff-array-zeck.pl 0000644 0001750 0001750 00000003746 12113742706 017145 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl wythoff-array-zeck.pl
#
# Print some of the Wythoff array with N values in Zeckendorf base.
#
use 5.010;
use strict;
use List::Util 'max';
use Math::NumSeq::Fibbinary;
use Math::PlanePath::WythoffArray;
my $class = 'Math::PlanePath::WythoffArray';
# $class = 'Math::PlanePath::WythoffDifference';
# $class = 'Math::PlanePath::WythoffPreliminaryTriangle';
my $width = 4;
my $height = 9;
eval "require $class";
my $path = $class->new;
my $fib = Math::NumSeq::Fibbinary->new;
my @z;
my @colwidth;
foreach my $x (0 .. $width) {
foreach my $y (0 .. $height) {
my $n = $path->xy_to_n ($x,$y);
my $z = $n && $fib->ith($n);
my $zb = $z && sprintf '%b', $z;
# $zb = $n && sprintf '%d', $n;
if (! defined $n) { $zb = ''; }
$z[$x][$y] = $zb;
$colwidth[$x] = max($colwidth[$x]||0, length($z[$x][$y]));
}
}
my $ywidth = length($height);
foreach my $y (reverse 0 .. $height) {
printf "%*d |", $ywidth, $y;
foreach my $x (0 .. $width) {
my $value = $z[$x][$y] // '';
printf " %*s", $colwidth[$x], $z[$x][$y];
}
print "\n";
}
printf "%*s +-", $ywidth, '';
foreach my $x (0 .. $width) {
print '-' x ($colwidth[$x]+1);
}
print "\n";
printf "%*s ", $ywidth, '';
foreach my $x (0 .. $width) {
printf " %*s", $colwidth[$x], $x;
}
print "\n";
exit 0;
Math-PlanePath-122/tools/dekking-centres-table.pl 0000644 0001750 0001750 00000013745 12020130531 017533 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*d", $entry_width, $aref->[$i];
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if ($entry_width >= 2 && ($i % 25) == 4) {
print " # ".($i-4);
}
if (($i % 25) == 24
|| $entry_width >= 2 && ($i % 5) == 4) {
print "\n ".(" " x length($name));
} elsif (($i % 5) == 4) {
print " ";
}
}
}
}
sub make_state {
my ($rev, $rot) = @_;
$rev %= 2;
$rot %= 4;
return 25*($rot + 4*$rev);
}
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @yx_to_digit;
foreach my $rev (0, 1) {
foreach my $rot (0, 1, 2, 3) {
foreach my $orig_digit (0 .. 24) {
my $digit = $orig_digit;
if ($rev) {
$digit = 24-$digit;
}
my $xo;
my $yo;
my $new_rot = $rot;
my $new_rev = $rev;
if ($digit == 0) {
$xo = 0;
$yo = 0;
} elsif ($digit == 1) {
$xo = 1;
$yo = 0;
} elsif ($digit == 2) {
$xo = 2;
$yo = 0;
$new_rot = $rot - 1;
$new_rev ^= 1;
} elsif ($digit == 3) {
$xo = 1;
$yo = 1;
$new_rev ^= 1;
} elsif ($digit == 4) {
$xo = 0;
$yo = 1;
$new_rot = $rot + 1;
} elsif ($digit == 5) {
$xo = 1;
$yo = 2;
} elsif ($digit == 6) {
$xo = 2;
$yo = 2;
$new_rot = $rot - 1;
$new_rev ^= 1;
} elsif ($digit == 7) {
$xo = 1;
$yo = 3;
$new_rev ^= 1;
} elsif ($digit == 8) {
$xo = 0;
$yo = 2;
$new_rot = $rot + 2;
} elsif ($digit == 9) {
$xo = 0;
$yo = 3;
$new_rot = $rot - 1;
$new_rev ^= 1;
} elsif ($digit == 10) {
$xo = 0;
$yo = 4;
} elsif ($digit == 11) {
$xo = 1;
$yo = 4;
} elsif ($digit == 12) {
$xo = 2;
$yo = 3;
$new_rot = $rot + 2;
$new_rev ^= 1;
} elsif ($digit == 13) {
$xo = 2;
$yo = 4;
$new_rot = $rot + 1;
} elsif ($digit == 14) {
$xo = 3;
$yo = 4;
$new_rot = $rot + 2;
$new_rev ^= 1;
} elsif ($digit == 15) {
$xo = 4;
$yo = 4;
$new_rot = $rot - 1;
} elsif ($digit == 16) {
$xo = 4;
$yo = 3;
$new_rot = $rot - 1;
} elsif ($digit == 17) {
$xo = 3;
$yo = 3;
$new_rev ^= 1;
} elsif ($digit == 18) {
$xo = 3;
$yo = 2;
$new_rot = $rot - 1;
} elsif ($digit == 19) {
$xo = 2;
$yo = 1;
$new_rot = $rot + 1;
$new_rev ^= 1;
} elsif ($digit == 20) {
$xo = 3;
$yo = 0;
$new_rot = $rot + 2;
$new_rev ^= 1;
} elsif ($digit == 21) {
$xo = 3;
$yo = 1;
$new_rot = $rot + 1;
} elsif ($digit == 22) {
$xo = 4;
$yo = 2;
} elsif ($digit == 23) {
$xo = 4;
$yo = 1;
$new_rot = $rot + 1;
$new_rev ^= 1;
} elsif ($digit == 24) {
$xo = 4;
$yo = 0;
$new_rot = $rot + 1;
$new_rev ^= 1;
} else {
die;
}
### base: "$xo, $yo"
if ($rot & 2) {
$xo = 4 - $xo;
$yo = 4 - $yo;
}
if ($rot & 1) {
($xo,$yo) = (4-$yo,$xo);
}
### rot to: "$xo, $yo"
my $state = make_state ($rev, $rot);
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$yx_to_digit[$state + $yo*5+$xo] = $orig_digit;
my $next_state = make_state ($new_rev, $new_rot);
$next_state[$state+$orig_digit] = $next_state;
}
}
}
print "# state length ",scalar(@next_state)," in each of 4 tables\n";
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("yx_to_digit", \@yx_to_digit);
### @next_state
### @digit_to_x
### @digit_to_y
### @yx_to_digit
### next_state length: scalar(@next_state)
{
my @pending_state = (0);
my $count = 0;
my @seen_state;
my $depth = 1;
$seen_state[0] = $depth;
while (@pending_state) {
my $state = pop @pending_state;
$count++;
### consider state: $state
foreach my $digit (0 .. 24) {
my $next_state = $next_state[$state+$digit];
if (! $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
$depth++;
}
for (my $state = 0; $state < @next_state; $state += 25) {
print "# used state $state depth $seen_state[$state]\n";
}
print "used state count $count\n";
}
print "\n";
exit 0;
Math-PlanePath-122/tools/cinco-curve-table.pl 0000644 0001750 0001750 00000020232 11665051545 016705 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use List::Util 'min','max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub min_maybe {
return min(grep {defined} @_);
}
sub max_maybe {
return max(grep {defined} @_);
}
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {length($_//'undef')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if ($entry_width >= 2 && ($i % 25) == 4) {
print " # ".($i-4);
}
if (($i % 25) == 24
|| $entry_width >= 2 && ($i % 5) == 4) {
print "\n ".(" " x length($name));
} elsif (($i % 5) == 4) {
print " ";
}
}
}
}
sub make_state {
my ($transpose, $rot) = @_;
$transpose %= 2;
$rot %= 4;
unless ($rot == 0 || $rot == 2) {
die "bad rotation $rot";
}
return 25*($rot/2 + 2*$transpose);
}
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @yx_to_digit;
my @min_digit;
my @max_digit;
foreach my $transpose (0, 1) {
foreach my $rot (0, 2) {
my $state = make_state ($transpose, $rot);
### $state
foreach my $orig_digit (0 .. 24) {
my $digit = $orig_digit;
# if ($rev) {
# $digit = 24-$digit;
# }
my $xo;
my $yo;
my $new_rot = $rot;
my $new_transpose = $transpose;
my $inc_rot = 0;
if ($digit == 0) {
$xo = 0;
$yo = 0;
} elsif ($digit == 1) {
$xo = 1;
$yo = 0;
} elsif ($digit == 2) {
$xo = 2;
$yo = 0;
$new_transpose ^= 1;
} elsif ($digit == 3) {
$xo = 2;
$yo = 1;
$new_transpose ^= 1;
} elsif ($digit == 4) {
$xo = 2;
$yo = 2;
$new_transpose ^= 1;
} elsif ($digit == 5) {
$xo = 1;
$yo = 2;
$inc_rot = 2;
$new_transpose ^= 1;
} elsif ($digit == 6) {
$xo = 1;
$yo = 1;
$inc_rot = 2;
} elsif ($digit == 7) {
$xo = 0;
$yo = 1;
$inc_rot = 2;
} elsif ($digit == 8) {
$xo = 0;
$yo = 2;
$new_transpose ^= 1;
} elsif ($digit == 9) {
$xo = 0;
$yo = 3;
$new_transpose ^= 1;
} elsif ($digit == 10) {
$xo = 0;
$yo = 4;
} elsif ($digit == 11) {
$xo = 1;
$yo = 4;
} elsif ($digit == 12) {
$xo = 1;
$yo = 3;
$inc_rot = 2;
$new_transpose ^= 1;
} elsif ($digit == 13) {
$xo = 2;
$yo = 3;
$new_transpose ^= 1;
} elsif ($digit == 14) {
$xo = 2;
$yo = 4;
} elsif ($digit == 15) {
$xo = 3;
$yo = 4;
} elsif ($digit == 16) {
$xo = 4;
$yo = 4;
} elsif ($digit == 17) {
$xo = 4;
$yo = 3;
$inc_rot = 2;
} elsif ($digit == 18) {
$xo = 3;
$yo = 3;
$inc_rot = 2;
$new_transpose ^= 1;
} elsif ($digit == 19) {
$xo = 3;
$yo = 2;
$inc_rot = 2;
$new_transpose ^= 1;
} elsif ($digit == 20) {
$xo = 4;
$yo = 2;
} elsif ($digit == 21) {
$xo = 4;
$yo = 1;
$inc_rot = 2;
} elsif ($digit == 22) {
$xo = 3;
$yo = 1;
$inc_rot = 2;
$new_transpose ^= 1;
} elsif ($digit == 23) {
$xo = 3;
$yo = 0;
$inc_rot = 2;
$new_transpose ^= 1;
} elsif ($digit == 24) {
$xo = 4;
$yo = 0;
} else {
die;
}
### base: "$xo, $yo"
if ($transpose) {
($xo,$yo) = ($yo,$xo);
$inc_rot = - $inc_rot;
}
$new_rot = $rot + $inc_rot;
if ($rot & 2) {
$xo = 4 - $xo;
$yo = 4 - $yo;
}
if ($rot & 1) {
($xo,$yo) = (4-$yo,$xo);
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$yx_to_digit[$state + $yo*5+$xo] = $orig_digit;
my $next_state = make_state ($new_transpose, $new_rot);
$next_state[$state+$orig_digit] = $next_state;
}
# N = (- 1/2 d^2 + 9/2 d)
# = (- 1/2*$d**2 + 9/2*$d)
# = ((9 - d)d/2
# (9-d)*d/2
# d=0 (9-0)*0/2 = 0
# d=1 (9-1)*1/2 - 1 = 8/2-1 = 3
# d=2 (9-2)*2/2 - 2 = 7-1 = 6
# d=4 (9-4)*4/2 = 5*4/2 = 10
#
foreach my $x1pos (0 .. 4) {
foreach my $x2pos ($x1pos .. 4) {
my $xkey = (9-$x1pos)*$x1pos/2 + $x2pos;
### $xkey
### assert: $xkey >= 0
### assert: $xkey < 15
foreach my $y1pos (0 .. 4) {
foreach my $y2pos ($y1pos .. 4) {
my $ykey = (9-$y1pos)*$y1pos/2 + $y2pos;
### $ykey
### assert: $ykey >= 0
### assert: $ykey < 15
my $min_digit = undef;
my $max_digit = undef;
foreach my $digit (0 .. 24) {
my $x = $digit_to_x[$digit];
my $y = $digit_to_y[$digit];
if ($rot & 2) {
$x = 4 - $x;
$y = 4 - $y;
}
if ($transpose) {
($x,$y) = ($y,$x);
}
next unless $x >= $x1pos;
next unless $x <= $x2pos;
next unless $y >= $y1pos;
next unless $y <= $y2pos;
$min_digit = min_maybe($digit,$min_digit);
$max_digit = max_maybe($digit,$max_digit);
}
my $key = $state*9 + $xkey*15 + $ykey;
### $key
if (defined $min_digit[$key]) {
die "oops min_digit[] already: state=$state key=$key y1p=$y1pos y2p=$y2pos value=$min_digit[$key], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
}
}
}
}
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("yx_to_digit", \@yx_to_digit);
print_table ("min_digit", \@min_digit);
print_table ("max_digit", \@max_digit);
print "# state length ",scalar(@next_state)," in each of 4 tables\n\n";
### @next_state
### @digit_to_x
### @digit_to_y
### @yx_to_digit
### next_state length: scalar(@next_state)
{
my @pending_state = (0);
my $count = 0;
my @seen_state;
my $depth = 1;
$seen_state[0] = $depth;
while (@pending_state) {
my $state = pop @pending_state;
$count++;
### consider state: $state
foreach my $digit (0 .. 24) {
my $next_state = $next_state[$state+$digit];
if (! $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
$depth++;
}
for (my $state = 0; $state < @next_state; $state += 25) {
print "# used state $state depth ",$seen_state[$state]//'undef',"\n";
}
print "used state count $count\n";
}
print "\n";
exit 0;
Math-PlanePath-122/tools/gallery.pl 0000644 0001750 0001750 00000145033 12551142301 015033 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl gallery.pl
#
# Create .png files as for the web page
# http://user42.tuxfamily.org/math-planepath/gallery.html
# Output is to $target_dir = "$ENV{HOME}/tux/web/math-planepath".
#
use 5.004;
use strict;
use warnings;
use File::Compare ();
use File::Copy;
use File::Temp;
use Image::Base::GD;
use POSIX 'floor';
# uncomment this to run the ### lines
# use Smart::Comments;
my $target_dir = "$ENV{HOME}/tux/web/math-planepath";
my $tempfh = File::Temp->new (SUFFIX => '.png');
my $tempfile = $tempfh->filename;
my $big_bytes = 0;
my %seen_filename;
foreach my $elem
(
['hilbert-sides-small.png',
'math-image --path=HilbertSides --lines --scale=2 --size=32 --figure=point'],
['hilbert-sides-big.png',
'math-image --path=HilbertSides --lines --scale=4 --size=257 --figure=point'],
['hilbert-small.png',
'math-image --path=HilbertCurve --lines --scale=3 --size=32 --figure=point'],
['hilbert-big.png',
'math-image --path=HilbertCurve --lines --scale=7 --size=225 --figure=point'],
['hilbert-spiral-small.png',
'math-image --path=HilbertSpiral --lines --scale=3 --size=32 --figure=point'],
['hilbert-spiral-big.png',
'math-image --path=HilbertSpiral --lines --scale=7 --size=230 --figure=point'],
['dekking-curve-4arm-big.png',
'math-image --path=DekkingCurve,arms=4 --lines --scale=7 --size=181 --figure=point'],
['dekking-curve-big.png',
'math-image --path=DekkingCurve --lines --scale=7 --size=183 --figure=point'],
['dekking-curve-small.png',
'math-image --path=DekkingCurve --lines --scale=5 --size=32 --figure=point'],
['dekking-centres-small.png',
'math-image --path=DekkingCentres --lines --scale=6 --size=32 --figure=point'],
['dekking-centres-big.png',
'math-image --path=DekkingCentres --lines --scale=7 --size=176 --figure=point'],
['ulam-warburton-quarter-small.png',
"math-image --path=UlamWarburtonQuarter --expression='i<50?i:0' --scale=2 --size=32"],
['ulam-warburton-quarter-octant.png',
"math-image --path=UlamWarburtonQuarter,parts=octant --expression='i<132?i:0' --scale=4 --size=150"],
['ulam-warburton-quarter-octant-up.png',
"math-image --path=UlamWarburtonQuarter,parts=octant_up --values=Lines --scale=2 --size=150 --figure=point"],
['ulam-warburton-quarter-big.png',
"math-image --path=UlamWarburtonQuarter --expression='i<233?i:0' --scale=4 --size=150"],
['gcd-rationals-rows-big.png',
"math-image --path=GcdRationals --expression='i<=68*67/2?i:0' --scale=2 --size=140x140"],
['gcd-rationals-diagonals-big.png',
"math-image --path=GcdRationals,pairs_order=diagonals_down --expression='i<=47**2?i:0' --scale=2 --size=160x200"],
['gcd-rationals-small.png',
'math-image --path=GcdRationals --lines --scale=6 --size=32 --offset=-4,-4'],
['gcd-rationals-big.png',
'math-image --path=GcdRationals --lines --scale=15 --size=200'],
['gcd-rationals-reverse-big.png',
'math-image --path=GcdRationals,pairs_order=rows_reverse --lines --scale=15 --size=200'],
['wythoff-preliminary-triangle-small.png',
'math-image --path=WythoffPreliminaryTriangle --lines --scale=5 --size=32'],
['wythoff-preliminary-triangle-big.png',
'math-image --path=WythoffPreliminaryTriangle --lines --scale=12 --size=200'],
['wythoff-array-small.png',
'math-image --path=WythoffArray --lines --scale=8 --size=32'],
['wythoff-array-big.png',
'math-image --path=WythoffArray --lines --scale=16 --size=200'],
['pythagorean-tree-ltoh.png',
'math-image --path=PythagoreanTree,digit_order=LtoH --values=LinesTree --scale=2 --size=200'],
['pythagorean-tree-big.png',
'math-image --path=PythagoreanTree --values=LinesTree --scale=4 --size=200'],
['pythagorean-tree-uard-rows-pq.png',
'math-image --path=PythagoreanTree,tree_type=UArD,digit_order=LtoH,coordinates=PQ --lines --scale=14 --size=200 --figure=point'],
['pythagorean-tree-uard-rows.png',
'math-image --path=PythagoreanTree,tree_type=UArD,digit_order=LtoH --lines --scale=1 --size=200 --figure=point'],
['pythagorean-tree-umt-big.png',
'math-image --path=PythagoreanTree,tree_type=UMT --values=LinesTree --scale=4 --size=200'],
['pythagorean-tree-fb-big.png',
'math-image --path=PythagoreanTree,tree_type=FB --values=LinesTree --scale=4 --size=200'],
['pythagorean-points-sm-big.png',
'math-image --path=PythagoreanTree,coordinates=SM --all --scale=1 --size=150'],
['pythagorean-points-sc-big.png',
'math-image --path=PythagoreanTree,coordinates=SC --all --scale=1 --size=150'],
['pythagorean-points-mc-big.png',
'math-image --path=PythagoreanTree,coordinates=MC --all --scale=1 --size=150'],
['pythagorean-points-bc-big.png',
'math-image --path=PythagoreanTree,coordinates=BC --all --scale=1 --size=200'],
['pythagorean-points-ac-big.png',
'math-image --path=PythagoreanTree,coordinates=AC --all --scale=1 --size=200'],
['pythagorean-small.png',
'math-image --path=PythagoreanTree --values=LinesTree --scale=1 --size=32'],
['pythagorean-points-big.png',
'math-image --path=PythagoreanTree --all --scale=1 --size=200'],
['htree-big.png',
'math-image --path=HTree --values=LinesTree --scale=6 --size=196 --offset=2,2 --figure=point'],
['htree-small.png',
'math-image --path=HTree --values=LinesTree --scale=4 --size=32 --offset=2,2'],
['chan-tree-rows-ltoh.png', \&special_chan_rows,
title => 'ChanTree,digit_order=LtoH rows' ],
['cfrac-digits-growth.png',
"math-image --path=CfracDigits --expression='i<=3**7?i:0' --scale=1 --size=100x200"],
['cfrac-digits-small.png',
'math-image --path=CfracDigits --lines --scale=4 --size=32 --offset=-4,-8'],
['cfrac-digits-big.png',
'math-image --path=CfracDigits --lines --scale=10 --size=200'],
['cfrac-digits-radix3.png',
'math-image --path=CfracDigits,radix=3 --lines --scale=10 --size=200'],
['cfrac-digits-radix4.png',
'math-image --path=CfracDigits,radix=4 --lines --scale=10 --size=200'],
['chan-tree-lines.png',
'math-image --path=ChanTree --values=LinesTree --scale=12 --size=200'],
['chan-tree-small.png',
'math-image --path=ChanTree --all --scale=2 --size=32'],
['chan-tree-big.png',
'math-image --path=ChanTree --all --scale=3 --size=200'],
['chan-tree-k4.png',
'math-image --path=ChanTree,k=4 --all --scale=3 --size=200'],
['chan-tree-k5.png',
'math-image --path=ChanTree,k=5 --all --scale=3 --size=200'],
['toothpick-spiral-small.png',
'math-image --path=ToothpickSpiral --values=Lines --scale=5 --size=32 --figure=point'],
['toothpick-spiral-big.png',
'math-image --path=ToothpickSpiral --values=Lines --scale=9 --size=200x200'],
['toothpick-upist-small.png',
'math-image --path=ToothpickUpist --values=LinesTree --scale=4 --size=32 --figure=toothpick --offset=0,5'],
['toothpick-upist-big.png',
'math-image --path=ToothpickUpist --values=LinesTree --scale=5 --size=300x150 --figure=toothpick'],
['lcorner-tree-1.png',
'math-image --path=LCornerTree,parts=1 --values=LinesTree --scale=7 --size=99'],
['lcorner-tree-big.png',
'math-image --path=LCornerTree --values=LinesTree --scale=7 --size=199'],
['lcorner-tree-octant-up.png',
'math-image --path=LCornerTree,parts=octant_up --values=LinesTree --scale=7 --size=99 --figure=point'],
['lcorner-tree-octant-up+1.png',
'math-image --path=LCornerTree,parts=octant_up+1 --values=LinesTree --scale=7 --size=99 --figure=point'],
['lcorner-tree-wedge.png',
'math-image --path=LCornerTree,parts=wedge --values=LinesTree --scale=6 --size=200x95 --figure=point'],
['lcorner-tree-wedge+1.png',
'math-image --path=LCornerTree,parts=wedge+1 --values=LinesTree --scale=6 --size=200x95 --figure=point'],
['lcorner-tree-octant.png',
'math-image --path=LCornerTree,parts=octant --values=LinesTree --scale=7 --size=99 --figure=point'],
['lcorner-tree-octant+1.png',
'math-image --path=LCornerTree,parts=octant+1 --values=LinesTree --scale=7 --size=99 --figure=point'],
['lcorner-tree-diagonal.png',
'math-image --path=LCornerTree,parts=diagonal --values=LinesTree --scale=7 --size=99 --figure=point'],
['lcorner-tree-diagonal-1.png',
'math-image --path=LCornerTree,parts=diagonal-1 --values=LinesTree --scale=7 --size=99'],
['lcorner-tree-small.png',
'math-image --path=LCornerTree --values=LinesTree --scale=4 --size=32'],
['toothpick-tree-3.png',
'math-image --path=ToothpickTree,parts=3 --values=LinesTree --scale=6 --size=200 --figure=point'],
['toothpick-tree-octant.png',
'math-image --path=ToothpickTree,parts=octant --values=LinesTree --scale=6 --size=200 --figure=point'],
['toothpick-tree-wedge.png',
'math-image --path=ToothpickTree,parts=wedge --values=LinesTree --scale=6 --size=200x104 --figure=toothpick --offset=0,5'],
['toothpick-tree-small.png',
'math-image --path=ToothpickTree --values=LinesTree --scale=4 --size=32'],
['toothpick-tree-big.png',
'math-image --path=ToothpickTree --values=LinesTree --scale=6 --size=200'],
['toothpick-replicate-small.png',
'math-image --path=ToothpickReplicate --lines --scale=4 --size=32 --figure=toothpick'],
['toothpick-replicate-big.png',
'math-image --path=ToothpickReplicate --all --scale=6 --size=200 --figure=toothpick'],
['ulam-warburton-1.png',
"math-image --path=UlamWarburton,parts=1 --values=LinesTree --figure=diamond --scale=8 --size=150"],
['ulam-warburton-2.png',
"math-image --path=UlamWarburton,parts=2 --values=Lines --figure=point --scale=6 --size=360x130"],
['ulam-warburton-tree-big.png',
"math-image --path=UlamWarburton --values=LinesTree --scale=7 --figure=point --size=150"],
['ulam-warburton-small.png',
"math-image --path=UlamWarburton --expression='i<50?i:0' --scale=2 --size=32"],
['ulam-warburton-big.png',
"math-image --path=UlamWarburton --expression='i<233?i:0' --scale=4 --size=150"],
['one-of-eight-wedge.png',
'math-image --path=OneOfEight,parts=wedge --all --scale=3 --size=200x99'],
['one-of-eight-1-nonleaf.png',
'math-image --path=OneOfEight,parts=1 --values=PlanePathCoord,planepath=\"OneOfEight,parts=1\",coordinate_type=IsNonLeaf --scale=3 --size=99'],
['one-of-eight-small.png',
'math-image --path=OneOfEight --values=LinesTree --scale=4 --size=32'],
['one-of-eight-big.png',
'math-image --path=OneOfEight --values=LinesTree --scale=6 --size=200'],
['one-of-eight-1.png',
'math-image --path=OneOfEight,parts=1 --all --scale=3 --size=99'],
['one-of-eight-octant.png',
'math-image --path=OneOfEight,parts=octant --all --scale=3 --size=99'],
['one-of-eight-3mid.png',
'math-image --path=OneOfEight,parts=3mid --all --scale=3 --size=99'],
['one-of-eight-3side.png',
'math-image --path=OneOfEight,parts=3side --all --scale=3 --size=99'],
['flowsnake-3arm-big.png',
'math-image --path=Flowsnake,arms=3 --lines --scale=6 --size=200 --figure=point'],
['flowsnake-small.png',
'math-image --path=Flowsnake --lines --scale=4 --size=32 --offset=-5,-13'],
['flowsnake-big.png',
'math-image --path=Flowsnake --lines --scale=8 --size=200 --offset=-20,-90'],
['flowsnake-centres-small.png',
'math-image --path=FlowsnakeCentres --lines --scale=4 --size=32 --offset=-5,-13'],
['flowsnake-centres-big.png',
'math-image --path=FlowsnakeCentres --lines --scale=8 --size=200 --offset=-20,-90'],
['rationals-tree-rows-sb.png', \&special_sb_rows,
title => 'RationalsTree,tree_type=SB rows' ],
['rationals-tree-lines-ayt.png',
'math-image --path=RationalsTree,tree_type=AYT --values=LinesTree --scale=20 --size=200'],
['rationals-tree-lines-hcs.png',
'math-image --path=RationalsTree,tree_type=HCS --values=LinesTree --scale=20 --size=200'],
['rationals-tree-lines-l.png',
'math-image --path=RationalsTree,tree_type=L --values=LinesTree --scale=20 --size=200'],
['rationals-tree-small.png',
'math-image --path=RationalsTree --values=LinesTree --scale=8 --size=32 --offset=-8,-8'],
['rationals-tree-big.png',
'math-image --path=RationalsTree --all --scale=3 --size=200'],
['rationals-tree-lines-sb.png',
'math-image --path=RationalsTree,tree_type=SB --values=LinesTree --scale=20 --size=200'],
['rationals-tree-lines-cw.png',
'math-image --path=RationalsTree,tree_type=CW --values=LinesTree --scale=20 --size=200'],
['rationals-tree-lines-bird.png',
'math-image --path=RationalsTree,tree_type=Bird --values=LinesTree --scale=20 --size=200'],
['rationals-tree-lines-drib.png',
'math-image --path=RationalsTree,tree_type=Drib --values=LinesTree --scale=20 --size=200'],
['triangle-spiral-skewed-small.png',
'math-image --path=TriangleSpiralSkewed --lines --scale=3 --size=32'],
['triangle-spiral-skewed-big.png',
'math-image --path=TriangleSpiralSkewed --lines --scale=13 --size=150'],
['triangle-spiral-skewed-right-big.png',
'math-image --path=TriangleSpiralSkewed,skew=right --lines --scale=13 --size=150'],
['triangle-spiral-skewed-up-big.png',
'math-image --path=TriangleSpiralSkewed,skew=up --lines --scale=13 --size=150'],
['triangle-spiral-skewed-down-big.png',
'math-image --path=TriangleSpiralSkewed,skew=down --lines --scale=13 --size=150'],
['triangle-spiral-small.png',
'math-image --path=TriangleSpiral --lines --scale=3 --size=32'],
['triangle-spiral-big.png',
'math-image --path=TriangleSpiral --lines --scale=13 --size=300x150'],
['koch-curve-small.png',
'math-image --path=KochCurve --lines --scale=2 --size=32 --offset=0,8'],
['koch-curve-big.png',
'math-image --path=KochCurve --lines --scale=5 --size=250x100 --offset=0,5'],
['lcorner-replicate-small.png',
'math-image --path=LCornerReplicate --lines --scale=4 --size=32'],
['lcorner-replicate-big.png',
'math-image --path=LCornerReplicate --lines --scale=7 --size=200'],
['imaginaryhalf-small.png',
'math-image --path=ImaginaryHalf --lines --scale=7 --size=32'],
['imaginaryhalf-big.png',
'math-image --path=ImaginaryHalf --lines --scale=18 --size=200'],
['imaginaryhalf-radix5-big.png',
'math-image --path=ImaginaryHalf,radix=5 --lines --scale=18 --size=200'],
['imaginaryhalf-xxy-big.png',
'math-image --path=ImaginaryHalf,digit_order=XXY --lines --scale=10 --size=75'],
['imaginaryhalf-yxx-big.png',
'math-image --path=ImaginaryHalf,digit_order=YXX --lines --scale=10 --size=75'],
['imaginaryhalf-xnyx-big.png',
'math-image --path=ImaginaryHalf,digit_order=XnYX --lines --scale=10 --size=75'],
['imaginaryhalf-xnxy-big.png',
'math-image --path=ImaginaryHalf,digit_order=XnXY --lines --scale=10 --size=75'],
['imaginaryhalf-yxnx-big.png',
'math-image --path=ImaginaryHalf,digit_order=YXnX --lines --scale=10 --size=75'],
['imaginarybase-small.png',
'math-image --path=ImaginaryBase --lines --scale=7 --size=32'],
['imaginarybase-big.png',
'math-image --path=ImaginaryBase --lines --scale=18 --size=200'],
['imaginarybase-radix5-big.png',
'math-image --path=ImaginaryBase,radix=5 --lines --scale=18 --size=200'],
['h-indexing-small.png',
'math-image --path=HIndexing --scale=3 --size=32 --lines --figure=point'],
['h-indexing-big.png',
'math-image --path=HIndexing --lines --scale=5 --size=200 --figure=point'],
['sierpinski-curve-small.png',
'math-image --path=SierpinskiCurve,arms=2 --scale=3 --size=32 --lines --figure=point'],
['sierpinski-curve-big.png',
'math-image --path=SierpinskiCurve --lines --scale=3 --size=200 --figure=point'],
['sierpinski-curve-8arm-big.png',
'math-image --path=SierpinskiCurve,arms=8 --lines --scale=3 --size=200 --figure=point'],
['alternate-paper-midpoint-small.png',
'math-image --path=AlternatePaperMidpoint --lines --scale=3 --size=32'],
['alternate-paper-midpoint-big.png',
'math-image --path=AlternatePaperMidpoint --lines --figure=point --scale=4 --size=200'],
['alternate-paper-midpoint-8arm-big.png',
'math-image --path=AlternatePaperMidpoint,arms=8 --lines --figure=point --scale=4 --size=200'],
['sierpinski-curve-stair-small.png',
'math-image --path=SierpinskiCurveStair,arms=2 --scale=3 --size=32 --lines --figure=point'],
['sierpinski-curve-stair-big.png',
'math-image --path=SierpinskiCurveStair --lines --scale=5 --size=200 --figure=point'],
['sierpinski-curve-stair-8arm-big.png',
'math-image --path=SierpinskiCurveStair,arms=8 --lines --scale=5 --size=200 --figure=point'],
['alternate-paper-small.png',
'math-image --path=AlternatePaper --lines --scale=4 --size=32'],
['alternate-paper-big.png',
'math-image --path=AlternatePaper --lines --figure=point --scale=8 --size=200'],
['alternate-paper-rounded-big.png',
'math-image --path=AlternatePaper --values=Lines,lines_type=rounded,midpoint_offset=0.4 --figure=point --scale=16 --size=200'],
['pyramid-rows-small.png',
'math-image --path=PyramidRows --lines --scale=5 --size=32'],
['pyramid-rows-big.png',
'math-image --path=PyramidRows --lines --scale=15 --size=300x150'],
['pyramid-rows-right-big.png',
'math-image --path=PyramidRows,step=4,align=right --lines --scale=15 --size=300x150'],
['pyramid-rows-left-big.png',
'math-image --path=PyramidRows,step=1,align=left --lines --scale=15 --size=160x150 --offset=65,0'],
['sierpinski-triangle-small.png',
'math-image --path=SierpinskiTriangle --all --scale=2 --size=32'],
['sierpinski-triangle-big.png',
'math-image --path=SierpinskiTriangle --all --scale=3 --size=400x200'],
['sierpinski-triangle-right-big.png',
'math-image --path=SierpinskiTriangle,align=right --all --scale=3 --size=200x200'],
['sierpinski-triangle-left-big.png',
'math-image --path=SierpinskiTriangle,align=left --all --scale=3 --size=200x200 --offset=98,0'],
['sierpinski-triangle-diagonal-big.png',
'math-image --path=SierpinskiTriangle,align=diagonal --values=LinesTree --scale=4 --size=200x200'],
['sierpinski-arrowhead-centres-small.png',
'math-image --path=SierpinskiArrowheadCentres --lines --scale=2 --size=32'],
['sierpinski-arrowhead-centres-big.png',
'math-image --path=SierpinskiArrowheadCentres --lines --scale=3 --size=400x200'],
['sierpinski-arrowhead-centres-right-big.png',
'math-image --path=SierpinskiArrowheadCentres,align=right --lines --scale=4 --size=200x200'],
['sierpinski-arrowhead-centres-left-big.png',
'math-image --path=SierpinskiArrowheadCentres,align=left --lines --scale=4 --size=200x200 --offset=98,0'],
['sierpinski-arrowhead-centres-diagonal-big.png',
'math-image --path=SierpinskiArrowheadCentres,align=diagonal --lines --scale=5 --size=200x200 --figure=point'],
['sierpinski-arrowhead-small.png',
'math-image --path=SierpinskiArrowhead --lines --scale=2 --size=32'],
['sierpinski-arrowhead-big.png',
'math-image --path=SierpinskiArrowhead --lines --scale=3 --size=400x200'],
['sierpinski-arrowhead-right-big.png',
'math-image --path=SierpinskiArrowhead,align=right --lines --scale=4 --size=200x200'],
['sierpinski-arrowhead-left-big.png',
'math-image --path=SierpinskiArrowhead,align=left --lines --scale=4 --size=200x200 --offset=98,0'],
['sierpinski-arrowhead-diagonal-big.png',
'math-image --path=SierpinskiArrowhead,align=diagonal --lines --scale=5 --size=200x200 --figure=point'],
['wunderlich-meander-small.png',
'math-image --path=WunderlichMeander --lines --scale=4 --size=32 --figure=point'],
['wunderlich-meander-big.png',
'math-image --path=WunderlichMeander --lines --scale=7 --size=192 --figure=point'],
['cinco-small.png',
'math-image --path=CincoCurve --lines --scale=6 --size=32 --figure=point'],
['cinco-big.png',
'math-image --path=CincoCurve --lines --scale=7 --size=176 --figure=point'],
['power-array-small.png',
'math-image --path=PowerArray --lines --scale=8 --size=32'],
['power-array-big.png',
'math-image --path=PowerArray --lines --scale=16 --size=200'],
['power-array-radix5-big.png',
'math-image --path=PowerArray,radix=5 --lines --scale=16 --size=200'],
['complexminus-small.png',
"math-image --path=ComplexMinus --expression='i<32?i:0' --scale=2 --size=32"],
['complexminus-big.png',
"math-image --path=ComplexMinus --expression='i<1024?i:0' --scale=3 --size=200"],
['complexminus-r2-small.png',
"math-image --path=ComplexMinus,realpart=2 --expression='i<125?i:0' --scale=2 --size=32"],
['complexminus-r2-big.png',
"math-image --path=ComplexMinus,realpart=2 --expression='i<3125?i:0' --scale=1 --size=200"],
['pyramid-sides-small.png',
'math-image --path=PyramidSides --lines --scale=5 --size=32'],
['pyramid-sides-big.png',
'math-image --path=PyramidSides --lines --scale=15 --size=300x150'],
['triangular-hypot-small.png',
'math-image --path=TriangularHypot --lines --scale=4 --size=32'],
['triangular-hypot-big.png',
'math-image --path=TriangularHypot --lines --scale=15 --size=200x150'],
['triangular-hypot-odd-big.png',
'math-image --path=TriangularHypot,points=odd --lines --scale=15 --size=200x150'],
['triangular-hypot-all-big.png',
'math-image --path=TriangularHypot,points=all --lines --scale=15 --size=200x150'],
['triangular-hypot-hex-big.png',
'math-image --path=TriangularHypot,points=hex --lines --scale=15 --size=200x150'],
['triangular-hypot-hex-rotated-big.png',
'math-image --path=TriangularHypot,points=hex_rotated --lines --scale=15 --size=200x150'],
['triangular-hypot-hex-centred-big.png',
'math-image --path=TriangularHypot,points=hex_centred --lines --scale=15 --size=200x150'],
['greek-key-small.png',
'math-image --path=GreekKeySpiral --lines --scale=4 --size=32'],
['greek-key-big.png',
'math-image --path=GreekKeySpiral --lines --scale=8 --size=200'],
['greek-key-turns1-big.png',
'math-image --path=GreekKeySpiral,turns=1 --lines --scale=8 --figure=point --size=200'],
['greek-key-turns5-big.png',
'math-image --path=GreekKeySpiral,turns=5 --lines --scale=8 --figure=point --size=200'],
['c-curve-small.png',
'math-image --path=CCurve --lines --scale=3 --size=32 --offset=8,0'],
['c-curve-big.png',
'math-image --path=CCurve --lines --figure=point --scale=3 --size=250x250 --offset=20,-70'],
['diagonals-octant-small.png',
'math-image --path=DiagonalsOctant --lines --scale=6 --size=32'],
['diagonals-octant-big.png',
'math-image --path=DiagonalsOctant --lines --scale=15 --size=195'],
['diagonals-alternating-small.png',
'math-image --path=DiagonalsAlternating --lines --scale=6 --size=32'],
['diagonals-alternating-big.png',
'math-image --path=DiagonalsAlternating --lines --scale=15 --size=195'],
['diagonals-small.png',
'math-image --path=Diagonals --lines --scale=6 --size=32'],
['diagonals-big.png',
'math-image --path=Diagonals --lines --scale=15 --size=195'],
['terdragon-rounded-small.png',
'math-image --path=TerdragonRounded --lines --scale=2 --size=32 --offset=-5,-10'],
['terdragon-rounded-big.png',
'math-image --path=TerdragonRounded --lines --figure=point --scale=3 --size=200 --offset=65,-20'],
['terdragon-rounded-6arm-big.png',
'math-image --path=TerdragonRounded,arms=6 --lines --figure=point --scale=5 --size=200'],
['terdragon-small.png',
'math-image --path=TerdragonCurve --lines --scale=5 --size=32 --offset=-3,-7'],
['terdragon-big.png',
'math-image --path=TerdragonCurve --lines --figure=point --scale=4 --size=200 --offset=75,50'],
# ['terdragon-6arm-big.png',
# 'math-image --path=TerdragonCurve,arms=6 --lines --figure=point --scale=4 --size=200'],
# ['terdragon-rounded-big.png',
# 'math-image --path=TerdragonCurve --values=Lines,lines_type=rounded,midpoint_offset=.4 --figure=point --scale=16 --size=200 --offset=35,-30'],
# ['terdragon-rounded-6arm-big.png',
# 'math-image --path=TerdragonCurve,arms=6 --values=Lines,lines_type=rounded,midpoint_offset=.4 --figure=point --scale=10 --size=200'],
['terdragon-midpoint-6arm-big.png',
'math-image --path=TerdragonMidpoint,arms=6 --lines --figure=circle --scale=4 --size=200'],
['terdragon-midpoint-small.png',
'math-image --path=TerdragonMidpoint --lines --scale=2 --size=32 --offset=2,-9'],
['terdragon-midpoint-big.png',
'math-image --path=TerdragonMidpoint --lines --figure=circle --scale=8 --size=200 --offset=50,-50'],
['r5dragon-small.png',
'math-image --path=R5DragonCurve --lines --scale=4 --size=32 --offset=6,-5'],
['r5dragon-big.png',
'math-image --path=R5DragonCurve --lines --figure=point --scale=10 --size=200x200 --offset=20,45'],
['r5dragon-rounded-big.png',
'math-image --path=R5DragonCurve --values=Lines,lines_type=rounded,midpoint_offset=.6 --figure=point --scale=10 --size=200x200 --offset=20,45'],
['r5dragon-rounded-4arm-big.png',
'math-image --path=R5DragonCurve,arms=4 --values=Lines,lines_type=rounded,midpoint_offset=.6 --figure=point --scale=20 --size=200x200'],
['r5dragon-midpoint-small.png',
'math-image --path=R5DragonMidpoint --lines --scale=3 --size=32 --offset=3,-9'],
['r5dragon-midpoint-big.png',
'math-image --path=R5DragonMidpoint --lines --figure=point --scale=8 --size=200 --offset=65,-15'],
['r5dragon-midpoint-4arm-big.png',
'math-image --path=R5DragonMidpoint,arms=4 --lines --figure=point --scale=12 --size=200'],
['cubicbase-small.png',
'math-image --path=CubicBase --lines --scale=5 --size=32'],
['cubicbase-big.png',
'math-image --path=CubicBase --lines --scale=18 --size=200'],
['cubicbase-radix5-big.png',
'math-image --path=CubicBase,radix=5 --lines --scale=18 --size=200'],
['peano-small.png',
'math-image --path=PeanoCurve --lines --scale=3 --size=32'],
['peano-big.png',
'math-image --path=PeanoCurve --lines --scale=7 --size=192'],
['peano-radix7-big.png',
'math-image --path=PeanoCurve,radix=7 --values=Lines --scale=5 --size=192'],
['gray-code-small.png',
'math-image --path=GrayCode --lines --scale=6 --size=32'],
['gray-code-big.png',
'math-image --path=GrayCode --lines --scale=14 --size=226'],
['gray-code-radix4-big.png',
'math-image --path=GrayCode,radix=4 --lines --scale=14 --size=226'],
['zorder-small.png',
'math-image --path=ZOrderCurve --lines --scale=6 --size=32'],
['zorder-big.png',
'math-image --path=ZOrderCurve --lines --scale=14 --size=226'],
['zorder-radix5-big.png',
'math-image --path=ZOrderCurve,radix=5 --lines --scale=14 --size=226'],
['zorder-fibbinary.png',
'math-image --path=ZOrderCurve --values=Fibbinary --scale=1 --size=704x320'],
['wunderlich-serpentine-small.png',
'math-image --path=WunderlichSerpentine --lines --scale=4 --size=32'],
['wunderlich-serpentine-big.png',
'math-image --path=WunderlichSerpentine --lines --scale=7 --size=192'],
['wunderlich-serpentine-coil-big.png',
'math-image --path=WunderlichSerpentine,serpentine_type=coil --values=Lines --scale=7 --size=192'],
['wunderlich-serpentine-radix7-big.png',
'math-image --path=WunderlichSerpentine,radix=7 --values=Lines --scale=5 --size=192'],
['cretan-labyrinth-small.png',
'math-image --path=CretanLabyrinth --lines --scale=3 --size=32'],
['cretan-labyrinth-big.png',
'math-image --path=CretanLabyrinth --lines --scale=9 --size=185x195 --offset=5,0'],
['theodorus-small.png',
'math-image --path=TheodorusSpiral --lines --scale=3 --size=32'],
['theodorus-big.png',
'math-image --path=TheodorusSpiral --lines --scale=10 --size=200'],
['filled-rings-small.png',
'math-image --path=FilledRings --lines --scale=4 --size=32'],
['filled-rings-big.png',
'math-image --path=FilledRings --lines --scale=10 --size=200'],
['pixel-small.png',
'math-image --path=PixelRings --lines --scale=4 --size=32'],
['pixel-big.png',
'math-image --path=PixelRings --all --figure=circle --scale=10 --size=200',
border => 1 ],
['pixel-lines-big.png',
'math-image --path=PixelRings --lines --scale=10 --size=200'],
['staircase-small.png',
'math-image --path=Staircase --lines --scale=4 --size=32'],
['staircase-big.png',
'math-image --path=Staircase --lines --scale=12 --size=200x200'],
['staircase-alternating-square-small.png',
'math-image --path=StaircaseAlternating,end_type=square --lines --scale=4 --size=32'],
['staircase-alternating-big.png',
'math-image --path=StaircaseAlternating --lines --scale=12 --size=200x200'],
['staircase-alternating-square-big.png',
'math-image --path=StaircaseAlternating,end_type=square --lines --scale=12 --size=200x200'],
['cellular-rule-30-small.png',
'math-image --path=CellularRule,rule=30 --all --scale=2 --size=32'],
['cellular-rule-30-big.png',
'math-image --path=CellularRule,rule=30 --all --scale=4 --size=300x150'],
['cellular-rule-73-big.png',
'math-image --path=CellularRule,rule=73 --all --scale=4 --size=300x150'],
['cellular-rule190-small.png',
'math-image --path=CellularRule190 --all --scale=3 --size=32'],
['cellular-rule190-big.png',
'math-image --path=CellularRule190 --all --scale=4 --size=300x150'],
['cellular-rule190-mirror-big.png',
'math-image --path=CellularRule190,mirror=1 --all --scale=4 --size=300x150'],
['cellular-rule54-small.png',
'math-image --path=CellularRule54 --all --scale=3 --size=32'],
['cellular-rule54-big.png',
'math-image --path=CellularRule54 --all --scale=4 --size=300x150'],
['complexplus-small.png',
"math-image --path=ComplexPlus --all --scale=2 --size=32"],
['complexplus-big.png',
"math-image --path=ComplexPlus --all --scale=3 --size=200",
border => 1],
['complexplus-r2-small.png',
"math-image --path=ComplexPlus,realpart=2 --all --scale=2 --size=32"],
['complexplus-r2-big.png',
"math-image --path=ComplexPlus,realpart=2 --all --scale=1 --size=200",
border => 1],
['digit-groups-small.png',
"math-image --path=DigitGroups --expression='i<256?i:0' --scale=2 --size=32"],
# --foreground=red
['digit-groups-big.png',
"math-image --path=DigitGroups --expression='i<2048?i:0' --scale=3 --size=200",
border => 1],
['digit-groups-radix5-big.png',
"math-image --path=DigitGroups,radix=5 --expression='i<15625?i:0' --scale=3 --size=200",
border => 1],
['l-tiling-small.png',
'math-image --path=LTiling --all --scale=2 --size=32' ],
['l-tiling-big.png',
'math-image --path=LTiling --all --scale=10 --size=200',
border => 1 ],
['l-tiling-ends-big.png',
'math-image --path=LTiling,L_fill=ends --all --scale=10 --size=200',
border => 1],
['l-tiling-all-big.png',
'math-image --path=LTiling,L_fill=all --lines --scale=10 --size=200'],
['dragon-rounded-small.png',
'math-image --path=DragonRounded --lines --scale=2 --size=32 --offset=6,-3'],
['dragon-rounded-big.png',
'math-image --path=DragonRounded --lines --figure=point --scale=3 --size=200 --offset=-20,0'],
['dragon-rounded-3arm-big.png',
'math-image --path=DragonRounded,arms=3 --lines --figure=point --scale=3 --size=200'],
['dragon-midpoint-small.png',
'math-image --path=DragonMidpoint --lines --scale=3 --size=32 --offset=7,-6'],
['dragon-midpoint-big.png',
'math-image --path=DragonMidpoint --lines --figure=point --scale=8 --size=200 --offset=-10,50'],
['dragon-midpoint-4arm-big.png',
'math-image --path=DragonMidpoint,arms=4 --lines --figure=point --scale=8 --size=200'],
['dragon-small.png',
'math-image --path=DragonCurve --lines --scale=4 --size=32 --offset=6,0'],
['dragon-big.png',
'math-image --path=DragonCurve --lines --figure=point --scale=8 --size=250x200 --offset=-55,0'],
['cellular-rule57-small.png',
'math-image --path=CellularRule57 --all --scale=3 --size=32'],
['cellular-rule57-big.png',
'math-image --path=CellularRule57 --all --scale=4 --size=300x150'],
['cellular-rule57-mirror-big.png',
'math-image --path=CellularRule57,mirror=1 --all --scale=4 --size=300x150'],
['quadric-islands-small.png',
'math-image --path=QuadricIslands --lines --scale=4 --size=32'],
['quadric-islands-big.png',
'math-image --path=QuadricIslands --lines --scale=2 --size=200'],
['quadric-curve-small.png',
'math-image --path=QuadricCurve --lines --scale=2 --size=32'],
['quadric-curve-big.png',
'math-image --path=QuadricCurve --lines --scale=4 --size=300x200'],
['divisible-columns-small.png',
'math-image --path=DivisibleColumns --all --scale=3 --size=32'],
['divisible-columns-big.png',
'math-image --path=DivisibleColumns --all --scale=3 --size=200'],
['divisible-columns-proper-big.png',
'math-image --path=DivisibleColumns,divisor_type=proper --all --scale=3 --size=400x200'],
['vogel-small.png',
'math-image --path=VogelFloret --all --scale=3 --size=32'],
['vogel-big.png',
'math-image --path=VogelFloret --all --scale=4 --size=200'],
['vogel-sqrt2-big.png',
'math-image --path=VogelFloret,rotation_type=sqrt2 --all --scale=4 --size=200'],
['vogel-sqrt5-big.png',
'math-image --path=VogelFloret,rotation_type=sqrt5 --all --scale=4 --size=200'],
['anvil-small.png',
'math-image --path=AnvilSpiral --lines --scale=4 --size=32'],
['anvil-big.png',
'math-image --path=AnvilSpiral --lines --scale=13 --size=200'],
['anvil-wider4-big.png',
'math-image --path=AnvilSpiral,wider=4 --lines --scale=13 --size=200'],
['octagram-small.png',
'math-image --path=OctagramSpiral --lines --scale=4 --size=32'],
['octagram-big.png',
'math-image --path=OctagramSpiral --lines --scale=13 --size=200'],
['complexrevolving-small.png',
"math-image --path=ComplexRevolving --expression='i<64?i:0' --scale=2 --size=32"],
['complexrevolving-big.png',
"math-image --path=ComplexRevolving --expression='i<4096?i:0' --scale=2 --size=200"],
['fractions-tree-small.png',
'math-image --path=FractionsTree --values=LinesTree --scale=8 --size=32 --offset=-8,-12'],
['fractions-tree-big.png',
'math-image --path=FractionsTree --all --scale=3 --size=200'],
['fractions-tree-lines-kepler.png',
'math-image --path=FractionsTree,tree_type=Kepler --values=LinesTree --scale=20 --size=200'],
['factor-rationals-small.png',
'math-image --path=FactorRationals --lines --scale=6 --size=32 --offset=-4,-4'],
['factor-rationals-big.png',
'math-image --path=FactorRationals --lines --scale=15 --size=200'],
['ar2w2-small.png',
'math-image --path=AR2W2Curve --lines --scale=4 --size=32 --figure=point'],
['ar2w2-a1-big.png',
'math-image --path=AR2W2Curve --lines --scale=7 --size=225 --figure=point'],
['ar2w2-d2-big.png',
'math-image --path=AR2W2Curve,start_shape=D2 --lines --scale=7 --size=113 --figure=point'],
['ar2w2-b2-big.png',
'math-image --path=AR2W2Curve,start_shape=B2 --lines --scale=7 --size=113 --figure=point'],
['ar2w2-b1rev-big.png',
'math-image --path=AR2W2Curve,start_shape=B1rev --lines --scale=7 --size=113 --figure=point'],
['ar2w2-d1rev-big.png',
'math-image --path=AR2W2Curve,start_shape=D1rev --lines --scale=7 --size=113 --figure=point'],
['ar2w2-a2rev-big.png',
'math-image --path=AR2W2Curve,start_shape=A2rev --lines --scale=7 --size=113 --figure=point'],
['diagonal-rationals-small.png',
'math-image --path=DiagonalRationals --lines --scale=4 --size=32'],
['diagonal-rationals-big.png',
'math-image --path=DiagonalRationals --lines --scale=10 --size=200'],
['coprime-columns-small.png',
'math-image --path=CoprimeColumns --all --scale=3 --size=32'],
['coprime-columns-big.png',
'math-image --path=CoprimeColumns --all --scale=3 --size=200'],
['corner-small.png',
'math-image --path=Corner --lines --scale=4 --size=32'],
['corner-big.png',
'math-image --path=Corner --lines --scale=12 --size=200'],
['corner-wider4-big.png',
'math-image --path=Corner,wider=4 --lines --scale=12 --size=200'],
['kochel-small.png',
'math-image --path=KochelCurve --lines --scale=4 --size=32 --figure=point'],
['kochel-big.png',
'math-image --path=KochelCurve --lines --scale=7 --size=192 --figure=point'],
['beta-omega-small.png',
'math-image --path=BetaOmega --lines --scale=4 --size=32 --figure=point'],
['beta-omega-big.png',
'math-image --path=BetaOmega --lines --scale=7 --size=226 --figure=point'],
['mpeaks-small.png',
'math-image --path=MPeaks --lines --scale=4 --size=32'],
['mpeaks-big.png',
'math-image --path=MPeaks --lines --scale=13 --size=200x180'],
['hex-small.png',
'math-image --path=HexSpiral --lines --scale=3 --size=32'],
['hex-big.png',
'math-image --path=HexSpiral --lines --scale=13 --size=300x150'],
['hex-wider4-big.png',
'math-image --path=HexSpiral,wider=4 --lines --scale=13 --size=300x150'],
['hex-arms-small.png',
'math-image --path=HexArms --lines --scale=3 --size=32'],
['hex-arms-big.png',
'math-image --path=HexArms --lines --scale=10 --size=300x150'],
['hex-skewed-small.png',
'math-image --path=HexSpiralSkewed --lines --scale=3 --size=32'],
['hex-skewed-big.png',
'math-image --path=HexSpiralSkewed --lines --scale=13 --size=150'],
['hex-skewed-wider4-big.png',
'math-image --path=HexSpiralSkewed,wider=4 --lines --scale=13 --size=150'],
['fibonacci-word-fractal-small.png',
'math-image --path=FibonacciWordFractal --lines --scale=2 --size=32 --offset=2,2'],
['fibonacci-word-fractal-big.png',
'math-image --path=FibonacciWordFractal --lines --scale=2 --size=345x170'],
['corner-replicate-small.png',
'math-image --path=CornerReplicate --lines --scale=4 --size=32'],
['corner-replicate-big.png',
'math-image --path=CornerReplicate --lines --scale=10 --size=200'],
['aztec-diamond-rings-small.png',
'math-image --path=AztecDiamondRings --lines --scale=4 --size=32 --offset=3,3'],
['aztec-diamond-rings-big.png',
'math-image --path=AztecDiamondRings --lines --scale=13 --size=200x200'],
['diamond-spiral-small.png',
'math-image --path=DiamondSpiral --lines --scale=4 --size=32'],
['diamond-spiral-big.png',
'math-image --path=DiamondSpiral --lines --scale=13 --size=200x200'],
['square-replicate-small.png',
'math-image --path=SquareReplicate --lines --scale=4 --size=32'],
['square-replicate-big.png',
'math-image --path=SquareReplicate --lines --scale=10 --size=215'],
['gosper-replicate-small.png', # 7^2-1=48
"math-image --path=GosperReplicate --expression='i<48?i:0' --scale=2 --size=32"],
['gosper-replicate-big.png', # 7^4-1=16806
"math-image --path=GosperReplicate --expression='i<16806?i:0' --scale=1 --size=320x200"],
['gosper-side-small.png',
'math-image --path=GosperSide --lines --scale=3 --size=32 --offset=-13,-7'],
['gosper-side-big.png',
'math-image --path=GosperSide --lines --scale=1 --size=250x200 --offset=95,-95'],
['gosper-islands-small.png',
'math-image --path=GosperIslands --lines --scale=3 --size=32'],
['gosper-islands-big.png',
'math-image --path=GosperIslands --lines --scale=2 --size=250x200'],
['square-small.png',
'math-image --path=SquareSpiral --lines --scale=4 --size=32'],
['square-big.png',
'math-image --path=SquareSpiral --lines --scale=13 --size=200'],
['square-wider4-big.png',
'math-image --path=SquareSpiral,wider=4 --lines --scale=13 --size=253x200'],
['quintet-replicate-small.png',
"math-image --path=QuintetReplicate --expression='i<125?i:0' --scale=2 --size=32"],
['quintet-replicate-big.png',
"math-image --path=QuintetReplicate --expression='i<3125?i:0' --scale=2 --size=200"],
['quintet-curve-small.png',
'math-image --path=QuintetCurve --lines --scale=4 --size=32 --offset=-10,0 --figure=point'],
['quintet-curve-big.png',
'math-image --path=QuintetCurve --lines --scale=7 --size=200 --offset=-20,-70 --figure=point'],
['quintet-curve-4arm-big.png',
'math-image --path=QuintetCurve,arms=4 --lines --scale=7 --size=200 --figure=point'],
['quintet-centres-small.png',
'math-image --path=QuintetCentres --lines --scale=4 --size=32 --offset=-10,0 --figure=point'],
['quintet-centres-big.png',
'math-image --path=QuintetCentres --lines --scale=7 --size=200 --offset=-20,-70 --figure=point'],
['koch-squareflakes-inward-small.png',
'math-image --path=KochSquareflakes,inward=1 --lines --scale=2 --size=32'],
['koch-squareflakes-inward-big.png',
'math-image --path=KochSquareflakes,inward=1 --lines --scale=2 --size=150x150'],
['koch-squareflakes-small.png',
'math-image --path=KochSquareflakes --lines --scale=1 --size=32'],
['koch-squareflakes-big.png',
'math-image --path=KochSquareflakes --lines --scale=2 --size=150x150'],
['koch-snowflakes-small.png',
'math-image --path=KochSnowflakes --lines --scale=2 --size=32'],
['koch-snowflakes-big.png',
'math-image --path=KochSnowflakes --lines --scale=3 --size=200x150'],
['koch-peaks-small.png',
'math-image --path=KochPeaks --lines --scale=2 --size=32'],
['koch-peaks-big.png',
'math-image --path=KochPeaks --lines --scale=3 --size=200x100'],
['diamond-arms-small.png',
'math-image --path=DiamondArms --lines --scale=5 --size=32'],
['diamond-arms-big.png',
'math-image --path=DiamondArms --lines --scale=15 --size=150x150'],
['square-arms-small.png',
'math-image --path=SquareArms --lines --scale=3 --size=32'],
['square-arms-big.png',
'math-image --path=SquareArms --lines --scale=10 --size=150x150'],
['hept-skewed-small.png',
'math-image --path=HeptSpiralSkewed --lines --scale=4 --size=32'],
['hept-skewed-big.png',
'math-image --path=HeptSpiralSkewed --lines --scale=13 --size=200'],
['pent-small.png',
'math-image --path=PentSpiral --lines --scale=4 --size=32'],
['pent-big.png',
'math-image --path=PentSpiral --lines --scale=13 --size=200'],
['hypot-octant-small.png',
'math-image --path=HypotOctant --lines --scale=5 --size=32'],
['hypot-octant-big.png',
'math-image --path=HypotOctant --lines --scale=15 --size=200x150'],
['hypot-small.png',
'math-image --path=Hypot --lines --scale=6 --size=32'],
['hypot-big.png',
'math-image --path=Hypot --lines --scale=15 --size=200x150'],
['knight-small.png',
'math-image --path=KnightSpiral --lines --scale=7 --size=32'],
['knight-big.png',
'math-image --path=KnightSpiral --lines --scale=11 --size=197'],
['multiple-small.png',
'math-image --path=MultipleRings --lines --scale=4 --size=32'],
['multiple-big.png',
'math-image --path=MultipleRings --lines --scale=10 --size=200'],
['sacks-small.png',
'math-image --path=SacksSpiral --lines --scale=5 --size=32'],
['sacks-big.png',
'math-image --path=SacksSpiral --lines --scale=10 --size=200'],
['archimedean-small.png',
'math-image --path=ArchimedeanChords --lines --scale=5 --size=32'],
['archimedean-big.png',
'math-image --path=ArchimedeanChords --lines --scale=10 --size=200'],
) {
my ($filename, $command, %option) = @$elem;
if ($seen_filename{$filename}++) {
die "Duplicate filename $filename";
}
if (ref $command) {
&$command ($tempfile);
} else {
$command .= " --png >$tempfile";
### $command
my $status = system $command;
if ($status) {
die "Exit $status";
}
}
if ($option{'border'}) {
png_border($tempfile);
}
pngtextadd($tempfile, 'Author', 'Kevin Ryde');
pngtextadd($tempfile, 'Generator',
'Math-PlanePath tools/gallery.pl running math-image');
{
my $title = $option{'title'};
if (! defined $title) {
$command =~ /--path=([^ ]+)/
or die "Oops no --path in command: $command";
$title = $1;
if ($command =~ /--values=(Fibbinary)/) {
$title .= " $1";
}
}
pngtextadd ($tempfile, 'Title', $title);
}
system ("optipng -quiet -o2 $tempfile");
my $targetfile = "$target_dir/$filename";
if (File::Compare::compare($tempfile,$targetfile) == 0) {
print "Unchanged $filename\n";
} else {
print "Update $filename\n";
File::Copy::copy($tempfile,$targetfile);
}
if ($filename !~ /small/) {
$big_bytes += -s $targetfile;
}
}
foreach my $filename (<*.png>) {
$filename =~ s{.*/}{};
if (! $seen_filename{$filename}) {
print "leftover file: $filename\n";
}
}
my $gallery_html_filename = "$target_dir/gallery.html";
my $gallery_html_bytes = -s $gallery_html_filename;
my $total_gallery_bytes = $big_bytes + $gallery_html_bytes;
print "total gallery bytes $total_gallery_bytes ($gallery_html_bytes html, $big_bytes \"big\" images)\n";
exit 0;
# draw a 1-pixel black border around the png image in $filename
sub png_border {
my ($filename) = @_;
my $image = Image::Base::GD->new(-file => $filename);
$image->rectangle (0,0,
$image->get('-width') - 1,
$image->get('-height') - 1,
'black');
$image->save;
}
# add text to the png image in $filename
sub pngtextadd {
my ($filename, $keyword, $value) = @_;
system('pngtextadd', "--keyword=$keyword", "--text=$value", $tempfile) == 0
or die "system(pngtextadd)";
}
sub special_chan_rows {
my ($filename) = @_;
my $scale = 8;
my $width = 400;
my $height = 200;
my $margin = int($scale * .2);
my $xhi = int($width/$scale) + 3;
my $yhi = int($height/$scale) + 3;
require Geometry::AffineTransform;
my $affine = Geometry::AffineTransform->new;
$affine->scale ($scale, -$scale);
$affine->translate (-$scale+$margin, $height-1 - (-$scale+$margin));
{
my ($x,$y) = $affine->transform (0,0);
### $x
### $y
}
require Image::Base::GD;
my $image = Image::Base::GD->new (-width => $width, -height => $height);
$image->rectangle (0,0, $width-1,$height-1, 'black');
require Math::PlanePath::ChanTree;
my $path = Math::PlanePath::ChanTree->new (digit_order => 'LtoH',
reduced => 0);
foreach my $y (0 .. $yhi) {
foreach my $x (0 .. $xhi) {
my $n = $path->xy_to_n($x,$y) // next;
next unless $path->tree_n_root($n) == 0; # first root only
my $depth = $path->tree_n_to_depth($n);
foreach my $n2 ($n + 1, $n - 1) {
next unless $n2 >= 1;
next unless $path->tree_n_to_depth($n2) == $depth; # within same depth
next unless $path->tree_n_root($n2) == 0; # first root only
my ($x2,$y2) = $path->n_to_xy($n2);
my ($sx1,$sy1) = $affine->transform($x,$y);
my ($sx2,$sy2) = $affine->transform($x2,$y2);
_image_line_clipped ($image, $sx1,$sy1, $sx2,$sy2,
$width,$height, 'white');
}
}
}
$image->save($filename);
}
sub special_sb_rows {
my ($filename) = @_;
my $scale = 14;
my $width = 200;
my $height = 200;
my $margin = int($scale * .2);
my $xhi = int($width/$scale) + 3;
my $yhi = int($height/$scale) + 3;
require Geometry::AffineTransform;
my $affine = Geometry::AffineTransform->new;
$affine->scale ($scale, -$scale);
$affine->translate (-$scale+$margin, $height-1 - (-$scale+$margin));
{
my ($x,$y) = $affine->transform (0,0);
### $x
### $y
}
require Image::Base::GD;
my $image = Image::Base::GD->new (-width => $width, -height => $height);
$image->rectangle (0,0, $width-1,$height-1, 'black');
require Math::PlanePath::RationalsTree;
my $path = Math::PlanePath::RationalsTree->new;
foreach my $y (0 .. $yhi) {
foreach my $x (0 .. $xhi) {
my $n = $path->xy_to_n($x,$y) // next;
my $depth = $path->tree_n_to_depth($n);
foreach my $n2 ($n + 1, $n - 1) {
next unless $n2 >= 1;
next unless $path->tree_n_to_depth($n2) == $depth;
my ($x2,$y2) = $path->n_to_xy($n2);
my ($sx1,$sy1) = $affine->transform($x,$y);
my ($sx2,$sy2) = $affine->transform($x2,$y2);
_image_line_clipped ($image, $sx1,$sy1, $sx2,$sy2,
$width,$height, 'white');
}
}
}
$image->save($filename);
}
sub _image_line_clipped {
my ($image, $x1,$y1, $x2,$y2, $width,$height, $colour) = @_;
### _image_line_clipped(): "$x1,$y1 $x2,$y2 ${width}x${height}"
if (($x1,$y1, $x2,$y2) = line_clipper ($x1,$y1, $x2,$y2, $width,$height)) {
### clipped draw: "$x1,$y1 $x2,$y2"
$image->line ($x1,$y1, $x2,$y2, $colour);
return 1;
} else {
return 0;
}
}
sub line_clipper {
my ($x1,$y1, $x2,$y2, $width, $height) = @_;
return if ($x1 < 0 && $x2 < 0)
|| ($x1 >= $width && $x2 >= $width)
|| ($y1 < 0 && $y2 < 0)
|| ($y1 >= $height && $y2 >= $height);
my $x1new = $x1;
my $y1new = $y1;
my $x2new = $x2;
my $y2new = $y2;
my $xlen = ($x1 - $x2);
my $ylen = ($y1 - $y2);
if ($x1new < 0) {
$x1new = 0;
$y1new = floor (0.5 + ($y1 * (-$x2)
+ $y2 * ($x1)) / $xlen);
### x1 neg: "y1new to $x1new,$y1new"
} elsif ($x1new >= $width) {
$x1new = $width-1;
$y1new = floor (0.5 + ($y1 * ($x1new-$x2)
+ $y2 * ($x1 - $x1new)) / $xlen);
### x1 big: "y1new to $x1new,$y1new"
}
if ($y1new < 0) {
$y1new = 0;
$x1new = floor (0.5 + ($x1 * (-$y2)
+ $x2 * ($y1)) / $ylen);
### y1 neg: "x1new to $x1new,$y1new left ".($y1new-$y2)." right ".($y1-$y1new)
### x1new to: $x1new
} elsif ($y1new >= $height) {
$y1new = $height-1;
$x1new = floor (0.5 + ($x1 * ($y1new-$y2)
+ $x2 * ($y1 - $y1new)) / $ylen);
### y1 big: "x1new to $x1new,$y1new left ".($y1new-$y2)." right ".($y1-$y1new)
}
if ($x1new < 0 || $x1new >= $width) {
### x1new outside
return;
}
if ($x2new < 0) {
$x2new = 0;
$y2new = floor (0.5 + ($y2 * ($x1)
+ $y1 * (-$x2)) / $xlen);
### x2 neg: "y2new to $x2new,$y2new"
} elsif ($x2new >= $width) {
$x2new = $width-1;
$y2new = floor (0.5 + ($y2 * ($x1-$x2new)
+ $y1 * ($x2new-$x2)) / $xlen);
### x2 big: "y2new to $x2new,$y2new"
}
if ($y2new < 0) {
$y2new = 0;
$x2new = floor (0.5 + ($x2 * ($y1)
+ $x1 * (-$y2)) / $ylen);
### y2 neg: "x2new to $x2new,$y2new"
} elsif ($y2new >= $height) {
$y2new = $height-1;
$x2new = floor (0.5 + ($x2 * ($y1-$y2new)
+ $x1 * ($y2new-$y2)) / $ylen);
### y2 big: "x2new $x2new,$y2new"
}
if ($x2new < 0 || $x2new >= $width) {
### x2new outside
return;
}
return ($x1new,$y1new, $x2new,$y2new);
}
Math-PlanePath-122/tools/ar2w2-curve-table.pl 0000644 0001750 0001750 00000027637 12161517106 016557 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use List::Util 'min','max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub min_maybe {
return min(grep {defined} @_);
}
sub max_maybe {
return max(grep {defined} @_);
}
my $table_total = 0;
sub print_table {
my ($name, $aref) = @_;
$table_total += scalar(@$aref);
print "my \@$name\n = (";
my $entry_width = max (map {defined $_ ? length : 0} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 16) == 15) {
print "\n ";
} elsif (($i % 4) == 3) {
print " ";
}
}
}
}
sub print_table12 {
my ($name, $aref) = @_;
$table_total += scalar(@$aref);
print "my \@$name = (";
my $entry_width = max (map {length($_//'')} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*s", $entry_width, $aref->[$i]//'undef';
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 12) == 11) {
my $state = ($i-11)/3;
print " # 3* $state";
print "\n ".(" " x length($name));
} elsif (($i % 3) == 2) {
print " ";
}
}
}
}
sub make_state {
my ($part, $rot, $rev) = @_;
$rot %= 4;
return 4*($rot + 4*($rev + 2*$part));
}
my @part_name = ('A1','A2',
'B1','B2',
'C1','C2',
'D1','D2');
my @rev_name = ('','rev');
sub state_string {
my ($state) = @_;
my $digit = $state % 4; $state = int($state/4);
my $rot = $state % 4; $state = int($state/4);
my $rev = $state % 2; $state = int($state/2);
my $part = $state;
return "part=$part_name[$part]$rev_name[$rev] rot=$rot digit=$digit";
}
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @yx_to_digit;
my @min_digit;
my @max_digit;
use constant A1 => 0;
use constant A2 => 1;
use constant B1 => 2;
use constant B2 => 3;
use constant C1 => 4;
use constant C2 => 5;
use constant D1 => 6;
use constant D2 => 7;
foreach my $part (A1, A2, B1, B2, C1, C2, D1, D2) {
foreach my $rot (0, 1, 2, 3) {
foreach my $rev (0, 1) {
my $state = make_state ($part, $rot, $rev);
foreach my $orig_digit (0, 1, 2, 3) {
my $digit = $orig_digit;
if ($rev) {
$digit = 3-$digit;
}
my $xo = 0;
my $yo = 0;
my $new_part = $part;
my $new_rot = $rot;
my $new_rev = $rev;
if ($part == A1) {
if ($digit == 0) {
$new_part = D2;
} elsif ($digit == 1) {
$xo = 1;
$new_part = B1;
$new_rev ^= 1;
$new_rot = $rot - 1;
} elsif ($digit == 2) {
$yo = 1;
$new_part = C1;
$new_rot = $rot + 1;
} elsif ($digit == 3) {
$xo = 1;
$yo = 1;
$new_part = B2;
$new_rev ^= 1;
$new_rot = $rot + 2;
}
} elsif ($part == A2) {
if ($digit == 0) {
$new_part = B1;
$new_rev ^= 1;
$new_rot = $rot - 1;
} elsif ($digit == 1) {
$yo = 1;
$new_part = C2;
} elsif ($digit == 2) {
$xo = 1;
$new_part = B2;
$new_rev ^= 1;
$new_rot = $rot + 2;
} elsif ($digit == 3) {
$xo = 1;
$yo = 1;
$new_part = D1;
$new_rot = $rot + 1;
}
} elsif ($part == B1) {
if ($digit == 0) {
$new_part = D1;
$new_rev ^= 1;
$new_rot = $rot - 1;
} elsif ($digit == 1) {
$yo = 1;
$new_part = C2;
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_part = B1;
} elsif ($digit == 3) {
$xo = 1;
$new_part = B2;
$new_rev ^= 1;
$new_rot = $rot + 1;
}
} elsif ($part == B2) {
if ($digit == 0) {
$new_part = B1;
$new_rev ^= 1;
$new_rot = $rot - 1;
} elsif ($digit == 1) {
$yo = 1;
$new_part = B2;
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_part = C1;
} elsif ($digit == 3) {
$xo = 1;
$new_part = D2;
$new_rev ^= 1;
$new_rot = $rot + 1;
}
} elsif ($part == C1) {
if ($digit == 0) {
$new_part = A2;
} elsif ($digit == 1) {
$yo = 1;
$new_part = B1;
$new_rot = $rot + 1;
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_part = A1;
$new_rot = $rot - 1;
} elsif ($digit == 3) {
$xo = 1;
$new_part = B2;
$new_rev ^= 1;
$new_rot = $rot + 1;
}
} elsif ($part == C2) {
if ($digit == 0) {
$new_part = B1;
$new_rev ^= 1;
$new_rot = $rot - 1;
} elsif ($digit == 1) {
$yo = 1;
$new_part = A2;
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_part = B2;
$new_rot = $rot - 1;
} elsif ($digit == 3) {
$xo = 1;
$new_part = A1;
$new_rot = $rot - 1;
}
} elsif ($part == D1) {
if ($digit == 0) {
$new_part = D1;
$new_rev ^= 1;
$new_rot = $rot - 1;
} elsif ($digit == 1) {
$yo = 1;
$new_part = A2;
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_part = C2;
$new_rot = $rot - 1;
} elsif ($digit == 3) {
$xo = 1;
$new_part = A2;
$new_rot = $rot - 1;
}
} elsif ($part == D2) {
if ($digit == 0) {
$new_part = A1;
} elsif ($digit == 1) {
$yo = 1;
$new_part = C1;
$new_rot = $rot + 1;
} elsif ($digit == 2) {
$xo = 1;
$yo = 1;
$new_part = A1;
$new_rot = $rot - 1;
} elsif ($digit == 3) {
$xo = 1;
$new_part = D2;
$new_rev ^= 1;
$new_rot = $rot + 1;
}
} else {
die;
}
### base: "$xo, $yo"
if ($rot & 2) {
$xo ^= 1;
$yo ^= 1;
}
if ($rot & 1) {
($xo,$yo) = ($yo^1,$xo);
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$yx_to_digit[$state + $yo*2 + $xo] = $orig_digit;
my $next_state = make_state
($new_part, $new_rot, $new_rev);
$next_state[$state+$orig_digit] = $next_state;
}
foreach my $x1pos (0 .. 1) {
foreach my $x2pos ($x1pos .. 1) {
my $xr = ($x1pos ? 2 : $x2pos ? 1 : 0);
### $xr
foreach my $y1pos (0 .. 1) {
foreach my $y2pos ($y1pos .. 1) {
my $yr = ($y1pos ? 6 : $y2pos ? 3 : 0);
### $yr
my $min_digit = undef;
my $max_digit = undef;
foreach my $digit (0 .. 3) {
my $x = $digit_to_x[$state+$digit];
my $y = $digit_to_y[$state+$digit];
next unless $x >= $x1pos;
next unless $x <= $x2pos;
next unless $y >= $y1pos;
next unless $y <= $y2pos;
$min_digit = min_maybe($digit,$min_digit);
$max_digit = max_maybe($digit,$max_digit);
}
my $key = 3*$state + $xr + $yr;
### $key
if (defined $min_digit[$key]) {
die "oops min_digit[] already: state=$state key=$key y1p=$y1pos y2p=$y2pos value=$min_digit[$key], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
}
}
}
}
}
sub check_used {
my @pending_state = @_;
my $count = 0;
my @seen_state;
my $depth = 1;
while (@pending_state) {
my $state = pop @pending_state;
$count++;
### consider state: $state
foreach my $digit (0 .. 3) {
my $next_state = $next_state[$state+$digit];
if (! $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
$depth++;
}
for (my $state = 0; $state < @next_state; $state += 4) {
if (! defined $seen_state[$state]) { $seen_state[$state] = 'none'; }
my $str = state_string($state);
print "# used state $state depth $seen_state[$state] $str\n";
}
print "used state count $count\n";
}
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("yx_to_digit", \@yx_to_digit);
print_table12 ("min_digit", \@min_digit);
print_table12 ("max_digit", \@max_digit);
print "# state length ",scalar(@next_state)," in each of 4 tables\n";
print "# grand total $table_total\n";
print "\n";
{
my %seen;
my @pending;
for (my $state = 0; $state < @next_state; $state += 4) {
push @pending, $state;
}
while (@pending) {
my $state = shift @pending;
next if $seen{$state}++;
next if $digit_to_x[$state] != 0 || $digit_to_y[$state] != 0;
my $next = $next_state[$state];
if ($next_state[$next] == $state) {
print "# cycle $state/$next ",state_string($state)," <-> ",state_string($next),"\n";
unshift @pending, $next;
}
}
print "#\n";
}
{
my $a1 = make_state(A1,0,0);
my $d2 = make_state(D2,0,0);
my $d1rev = make_state(D1,3,1);
my $a2rev = make_state(A2,2,1);
my $b2 = make_state(B2,0,0);
my $b1rev3 = make_state(B1,-1,1);
my $b1rev = make_state(B1,0,1);
my $b2_1 = make_state(B2,1,0);
my $str = <<"HERE";
my %start_state = (A1 => [$a1, $d2],
D2 => [$d2, $a1],
B2 => [$b2, $b1rev3],
B1rev => [$b1rev3, $b2],
D1rev => [$d1rev, $a2rev],
A2rev => [$a2rev, $d1rev],
);
HERE
print $str;
my %start_state = eval "$str; %start_state";
foreach my $elem (values %start_state) {
my ($s1, $s2) = @$elem;
$next_state[$s1]==$s2 or die;
$next_state[$s2]==$s1 or die;
$digit_to_x[$s1]==0 or die "$s1 not at 0,0";
$digit_to_y[$s1]==0 or die;
$digit_to_x[$s2]==0 or die;
$digit_to_y[$s2]==0 or die;
}
}
# print "# state A1=",make_state(A1,0,0),"\n";
# print "# state D2=",make_state(D2,0,0),"\n";
# print "# state D1=",make_state(D1,0,0),"\n";
# print "from A1/D2\n";
# check_used (make_state(A1,0,0), make_state(D2,0,0));
# print "from D1\n";
# check_used (make_state(D1,0,0));
{
print "\n";
require Graph::Easy;
my $g = Graph::Easy->new;
for (my $state = 0; $state < scalar(@next_state); $state += 4) {
my $next = $next_state[$state];
$g->add_edge("$state: ".state_string($state),
"$next: ".state_string($next));
}
print $g->as_ascii();
}
exit 0;
Math-PlanePath-122/tools/r5dragon-midpoint-offset.pl 0000644 0001750 0001750 00000004211 12201363223 020212 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use Math::PlanePath::R5DragonMidpoint;
# uncomment this to run the ### lines
#use Smart::Comments;
my $path = Math::PlanePath::R5DragonMidpoint->new (arms => 1);
my @yx_to_digdxdy;
foreach my $n (0 .. 5**10) {
my ($x,$y) = $path->n_to_xy($n);
my $digit = $n % 5;
my $to_n = ($n-$digit)/5;
my ($to_x,$to_y) = $path->n_to_xy($to_n);
# (x+iy)*(1+2i) = x-2y + 2x+y
($to_x,$to_y) = ($to_x-2*$to_y, 2*$to_x+$to_y);
my $dx = $to_x - $x;
my $dy = $to_y - $y;
my $k = 3*(10*($y%10) + ($x%10));
my $v0 = $digit;
my $v1 = $dx;
my $v2 = $dy;
if (defined $yx_to_digdxdy[$k+0] && $yx_to_digdxdy[$k+0] != $v0) {
die "diff v0 $yx_to_digdxdy[$k+0] $v0 k=$k n=$n";
}
if (defined $yx_to_digdxdy[$k+1] && $yx_to_digdxdy[$k+1] != $v1) {
die "diff v1 $yx_to_digdxdy[$k+1] $v1 k=$k n=$n";
}
if (defined $yx_to_digdxdy[$k+2] && $yx_to_digdxdy[$k+2] != $v2) {
die "diff v2 $yx_to_digdxdy[$k+2] $v2 k=$k n=$n";
}
$yx_to_digdxdy[$k+0] = $v0;
$yx_to_digdxdy[$k+1] = $v1;
$yx_to_digdxdy[$k+2] = $v2;
}
print_table(\@yx_to_digdxdy);
sub print_table {
my ($aref) = @_;
print "(";
for (my $i = 0; $i < @$aref; ) {
my $v0 = $aref->[$i++] // 'undef';
my $v1 = $aref->[$i++] // 'undef';
my $v2 = $aref->[$i++] // 'undef';
my $str = "$v0,$v1,$v2";
if ($i != $#$aref) { $str .= ", " }
printf "%-9s", $str;
if (($i % (3*5)) == 0) { print "\n " }
}
print ");\n";
}
exit 0;
Math-PlanePath-122/tools/wunderlich-meander-table.pl 0000644 0001750 0001750 00000015535 11660132465 020253 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
# uncomment this to run the ### lines
#use Smart::Comments;
sub print_table {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {defined && length} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*d", $entry_width, $aref->[$i];
if ($i == $#$aref) {
print "); # ",$i-8,"\n";
} else {
print ",";
if (($i % 9) == 8) {
print " # ".($i-8);
}
if (($i % 9) == 8) {
print "\n ".(" " x length($name));
} elsif (($i % 3) == 2) {
print " ";
}
}
}
}
sub print_table36 {
my ($name, $aref) = @_;
print "my \@$name = (";
my $entry_width = max (map {defined && length} @$aref);
foreach my $i (0 .. $#$aref) {
printf "%*d", $entry_width, $aref->[$i];
if ($i == $#$aref) {
print ");\n";
} else {
print ",";
if (($i % 36) == 5) {
print " # ".($i-5);
}
if (($i % 6) == 5) {
print "\n ".(" " x length($name));
} elsif (($i % 6) == 5) {
print " ";
}
}
}
}
sub make_state {
my ($transpose, $rot) = @_;
$transpose %= 2;
$rot %= 4;
($rot % 2) == 0 or die;
$rot /= 2;
return 9*($rot + 2*$transpose);
}
# x__ 0
# xx_ 1
# xxx 2
# _xx 3
# __x 4
# _x_ 5
my @r_to_cover = ([1,0,0],
[1,1,0],
[1,1,1],
[0,1,1],
[0,0,1],
[0,1,0]);
my @reverse_range = (4,3,2,1,0,5);
my @next_state;
my @digit_to_x;
my @digit_to_y;
my @xy_to_digit;
my @min_digit;
my @max_digit;
# 8 5-- 4
# | | |
# 7-- 6 3
# |
# 0-- 1-- 2
#
foreach my $transpose (0, 1) {
foreach my $rot (0, 2) {
my $state = make_state ($transpose, $rot);
foreach my $orig_digit (0 .. 8) {
my $digit = $orig_digit;
my $xo;
my $yo;
my $new_rot = $rot;
my $new_transpose = $transpose;
if ($digit == 0) {
$xo = 0;
$yo = 0;
$new_transpose ^= 1;
} elsif ($digit == 1) {
$xo = 1;
$yo = 0;
$new_transpose ^= 1;
} elsif ($digit == 2) {
$xo = 2;
$yo = 0;
} elsif ($digit == 3) {
$xo = 2;
$yo = 1;
} elsif ($digit == 4) {
$xo = 2;
$yo = 2;
} elsif ($digit == 5) {
$xo = 1;
$yo = 2;
$new_rot = $rot + 2;
} elsif ($digit == 6) {
$xo = 1;
$yo = 1;
$new_transpose ^= 1;
$new_rot = $rot + 2;
} elsif ($digit == 7) {
$xo = 0;
$yo = 1;
$new_transpose ^= 1;
$new_rot = $rot + 2;
} elsif ($digit == 8) {
$xo = 0;
$yo = 2;
} else {
die;
}
### base: "$xo, $yo"
if ($transpose) {
($xo,$yo) = ($yo,$xo);
}
if ($rot & 2) {
$xo = 2 - $xo;
$yo = 2 - $yo;
}
if ($rot & 1) {
($xo,$yo) = (2-$yo,$xo);
}
### rot to: "$xo, $yo"
$digit_to_x[$state+$orig_digit] = $xo;
$digit_to_y[$state+$orig_digit] = $yo;
$xy_to_digit[$state + 3*$xo + $yo] = $orig_digit;
my $next_state = make_state ($new_transpose, $new_rot);
$next_state[$state+$orig_digit] = $next_state;
}
foreach my $xrange (0 .. 5) {
foreach my $yrange (0 .. 5) {
my $xr = $xrange;
my $yr = $yrange;
my $bits = $xr + 6*$yr; # before transpose etc
my $key = 4*$state + $bits;
### assert: (4*$state % 36) == 0
if ($rot & 1) {
($xr,$yr) = ($yr,$reverse_range[$xr]);
}
if ($rot & 2) {
$xr = $reverse_range[$xr];
$yr = $reverse_range[$yr];
}
if ($transpose) {
($xr,$yr) = ($yr,$xr);
}
# now xr,yr plain unrotated etc
my $min_digit = 8;
my $max_digit = 0;
foreach my $digit (0 .. 8) {
my $x = $digit_to_x[$digit];
my $y = $digit_to_y[$digit];
next unless $r_to_cover[$xr]->[$x];
next unless $r_to_cover[$yr]->[$y];
$min_digit = min($digit,$min_digit);
$max_digit = max($digit,$max_digit);
}
### min/max: "state=$state 4*state=".(4*$state)." bits=$bits key=$key"
if (defined $min_digit[$key]) {
die "oops min_digit[] already: state=$state bits=$bits value=$min_digit[$state+$bits], new=$min_digit";
}
$min_digit[$key] = $min_digit;
$max_digit[$key] = $max_digit;
}
}
### @min_digit
}
}
print_table ("next_state", \@next_state);
print_table ("digit_to_x", \@digit_to_x);
print_table ("digit_to_y", \@digit_to_y);
print_table ("xy_to_digit", \@xy_to_digit);
print_table36 ("min_digit", \@min_digit);
print_table36 ("max_digit", \@max_digit);
print "# transpose state ",make_state(1,0),"\n";
print "# state length ",scalar(@next_state)," in each of 4 tables\n";
print "# min/max length ",scalar(@min_digit)," in each of 2 tables\n\n";
### @next_state
### @digit_to_x
### @digit_to_y
### @xy_to_digit
### next_state length: scalar(@next_state)
{
my @pending_state = (0);
my $count = 0;
my @seen_state;
my $depth = 1;
$seen_state[0] = $depth;
while (@pending_state) {
my $state = pop @pending_state;
$count++;
### consider state: $state
foreach my $digit (0 .. 8) {
my $next_state = $next_state[$state+$digit];
if (! $seen_state[$next_state]) {
$seen_state[$next_state] = $depth;
push @pending_state, $next_state;
### push: "$next_state depth $depth"
}
}
$depth++;
}
for (my $state = 0; $state < @next_state; $state += 9) {
print "# used state $state depth ".($seen_state[$state]||0)."\n";
}
print "used state count $count\n";
}
print "\n";
exit 0;
Math-PlanePath-122/Changes 0000644 0001750 0001750 00000037135 12641634630 013210 0 ustar gg gg Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License along
with Math-PlanePath. If not, see .
Version 122, January 2016
- test fix a sloppy test exposed by recent Math::BigFloat
Version 121, September 2015
- new methods xyxy_to_n_list(), xyxy_to_n_list_either(),
turn_any_left(), turn_any_right(), turn_any_straight()
Version 120, August 2015
- new HilbertSides
- PlanePathTurn new turn_type "Straight"
Version 119, May 2015
- fixes to most n_to_level()
- Math::PlanePath::Base::Digits new round_up_pow()
Version 118, February 2015
- new methods xyxy_to_n(), xyxy_to_n_either()
- DekkingCurve new "arms" parameter, correction to level N range
Version 117, September 2014
- new methods n_to_level(), level_to_n_range()
- UlamWarburton,UlamWarburtonQuarter parameter parts=>octant,octant_up
Version 116, June 2014
- new WythoffPreliminaryTriangle
- new methods is_tree(), x_negative_at_n(), y_negative_at_n()
Version 115, March 2014
- CoprimeColumns new parameter direction=down
- MPeaks new parameter n_start
- Math::PlanePath::Base::Generic new parameter_info_nstart0()
Version 114, February 2014
- PlanePathDelta new delta_type=>"dRadius","dRSquared"
- CCurve xy_to_n() by division instead of search
Version 113, December 2013
- PythagoreanTree new tree_type="UArD", digit_order="LtoH"
- PlanePathCoord new coordinate_type "MinAbs","MaxAbs"
Version 112, December 2013
- PythagoreanTree new tree_type="UMT"
Version 111, November 2013
- FactorRationals new factor_coding "odd/even","negabinary","revbinary"
- new sumabsxy_minimum(), sumabsxy_maximum(), absdiffxy_minimum(),
absdiffxy_maximum()
Version 110, August 2013
- PlanePathTurn new turn_type "SLR","SRL"
Version 109, August 2013
- TerdragonCurve correction to dx_minimum()
- TerdragonMidpoint correction to dx_maximum()
Version 108, July 2013
- new tree_n_to_subheight()
- PlanePathCoord new coordinate_type "SubHeight"
- tests skip some 64-bit perl 5.6.2 dodginess in "%" operator
Version 107, July 2013
- PentSpiral,PentSpiralSkewed,HeptSpiralSkewed,OctagramSpiral,
Staircase,StaircaseAlternating new parameter n_start
- FilledRings fix parameter_info_array() missing n_start
- StaircaseAlternating fix parameter_info_array() missing end_type
Version 106, June 2013
- new methods tree_n_root(), tree_num_roots(), tree_root_n_list(),
tree_depth_to_n_range(), tree_depth_to_width(), tree_num_children_list(),
dsumxy_minimum(),dsumxy_maximum(), ddiffxy_minimum(),ddiffxy_maximum()
- PyramidSpiral new parameter n_start
- PlanePathCoord new coordinate_type "RootN"
Version 105, June 2013
- PlanePathCoord new coordinate_type "NumSiblings"
Version 104, May 2013
- new method n_to_radius()
Version 103, May 2013
- UlamWarburton new parts=2,1
- PythagoreanTree new coordinates="SM","SC","MC"
Version 102, April 2013
- new sumxy_minimum(),sumxy_maximum(), diffxy_minimum(),diffxy_maximum(),
- PlanePathDelta new delta_type=>"dSumAbs"
Version 101, April 2013
- MultipleRings fixes for ring_shape=polygon xy_to_n(), rect_to_n_range()
- CellularRule,CellularRule54,CellularRule57,CellularRule190
new parameter n_start
- DiagonalRationals new parameter direction=up
Version 100, March 2013
- new absdx_minimum(),absdx_maximum(), absdy_minimum(),absdy_maximum(),
dir_minimum_dxdy(),dir_maximum_dxdy()
- AztecDiamondRings new parameter n_start
- TriangleSpiralSkewed new parameter skew=right,up,down
- WythoffArray new parameters x_start,y_start
- PlanePathDelta new delta_type=>"dAbsDiff"
Version 99, February 2013
- oops, correction to IntXY on negatives
Version 98, February 2013
- CoprimeColumns,DiagonalRationals,DivisibleColumns new n_start parameter
- PlanePathCoord new coordinate_type "IntXY"
Version 97, January 2013
- new tree_num_children_minimum(), tree_num_children_maximum()
Version 96, January 2013
- AnvilSpiral,HexSpiral,HexSpiralSkewed new n_start, which was in
parameter_info but did nothing
- FilledRings new n_start parameter
Version 95, December 2012
- new tree_any_leaf()
- PythagoreanTree new coordinates="AC" and "BC"
Version 94, December 2012
- new rsquared_minimum(), rsquared_maximum()
- PlanePathCoord new coordinate_type "IsLeaf","IsNonLeaf"
- ImaginaryHalf new option "digit_order"
- Math::PlanePath::Base::Generic new parameter_info_nstart1()
Version 93, November 2012
- new xy_is_visited()
- PlanePathCoord new coordinate_type "Min","Max","BitAnd","BitOr","BitXor"
Version 92, October 2012
- new x_minimum(),x_maximum(), y_minimum(),y_maximum(),
dx_minimum(),dx_maximum(), dy_minimum(),dy_maximum()
Version 91, October 2012
- new tree_depth_to_n(), tree_depth_to_n_end()
- RationalsTree new tree_type "HCS"
- UlamWarburton,UlamWarburtonQuarter new "n_start" parameter
- PlanePathN new line_type=>"Depth_start","Depth_end"
- Math::PlanePath::Base::Digits new bit_split_lowtohigh()
Version 90, October 2012
- new CfracDigits, ChanTree
- tree_n_num_children() return undef when no such N
- Diagonals new x_start,y_start parameters
- PlanePathCoord new coordinate_type "GCD"
Version 89, September 2012
- RationalsTree new tree_type=L
Version 88, September 2012
- new DekkingCurve, DekkingCentres
- new tree_n_to_depth()
- PlanePathCoord new coordinate_type "Depth"
- DiamondSpiral new "n_start" parameter
Version 87, August 2012
- new tree_n_num_children()
- PlanePathCoord new coordinate_type "NumChildren"
- SierpinskiArrowhead,SierpinskiArrowheadCentres new parameter
align=right,left,diagonal
- Rows,Columns new "n_start" parameter
- KnightSpiral,PentSpiral,SierpinskiCurve fixes for n_to_xy() on
some fractional N
Version 86, August 2012
- Diagonals,DiagonalsOctant,DiagonalsAlternating,PyramidRows,PyramidSides,
Corner new "n_start" parameter
Version 85, August 2012
- SquareSpiral new "n_start" parameter
- PlanePathDelta new delta_type=>"AbsdX","AbsdY"
Version 84, August 2012
- PyramidRows new "align" parameter
Version 83, July 2012
- new n_to_dxdy()
- SierpinskiTriangle new parameter align=right,left,diagonal
- SierpinskiTriangle,TriangleSpiral,TriangleSpiralSkewed,Hypot new
"n_start" parameter
- PlanePathDelta new delta_type=>"dDiffYX"
- PlanePathN new line_type=>"Diagonal_NW","Diagonal_SW","Diagonal_SE"
- Math::PlanePath::Base::Digits new digit_join_lowtohigh()
- new Math::PlanePath::Base::Generic round_nearest()
Version 82, July 2012
- new tree_n_children(), tree_n_parent()
- PlanePathDelta new delta_type=>"dDiffXY"
- ImaginaryBase,ImaginaryHalf rect_to_n_range() exact
- new Math::PlanePath::Base::Digits round_down_pow(),
digit_split_lowtohigh(), parameter_info_array(), parameter_info_radix2()
Version 81, July 2012
- TriangularHypot new points=hex,hex_rotated,hex_centred
Version 80, July 2012
- new AlternatePaperMidpoint
- AlternatePaper new "arms"
- GreekKeySpiral new "turns"
- ComplexPlus, Flowsnake, FlowsnakeCentres, TerdragonMidpoint,
TerdragonRounded, R5DragonMidpoint fix for arms>1 fractional N
Version 79, June 2012
- TriangularHypot new option points=odd,even
Version 78, June 2012
- new WythoffArray, PowerArray
- GcdRationals new option pairs_order
- Hypot,HypotOctant new option points=odd,even
- Diagonals new options direction=up,down
Version 77, June 2012
- new DiagonalsOctant
Version 76, May 2012
- tests allow for as_float() only in recent Math::BigRat
Version 75, May 2012
- new CubicBase, CCurve, R5DragonCurve, R5DragonMidpoint, TerdragonRounded
- MultipleRings new ring_shape=>"polygon"
- PlanePathDelta new delta_type=>"dSum"
- fix TheodorusSpiral n_to_rsquared() on fractional N
Version 74, May 2012
- new ImaginaryBase
- new method n_to_rsquared()
- PlanePathN new line_type X_neg,Y_neg
- fix ImaginaryBase xy_to_n() possible infloop on floating point rounding
- fix TerdragonMidpoint xy_to_n() undef on points outside requested arms
Version 73, April 2012
- new GrayCode, SierpinskiCurveStair, WunderlichSerpentine
- fix GcdRationals xy_to_n() on BigInt
- PlanePathCoord new coordinate_type "SumAbs","TRadius","TRSquared"
Version 72, March 2012
- PlanePathTurn new turn_type "Right"
Version 71, February 2012
- new FilledRings
- misc fixes for Math::NumSeq::PlanePathCoord etc values_min etc
Version 70, February 2012
- TheodorusSpiral fix n_to_xy() position saving
- StaircaseAlternating new end_type=>"square"
Version 69, February 2012
- new Math::NumSeq::PlanePathTurn
- Math::NumSeq::PlanePathN new pred()
Version 68, February 2012
- new xy_to_n_list()
- new CretanLabyrinth
Version 67, February 2012
- oops, DragonMidpoint,DragonRounded xy_to_n() exclude points on the
arm one past what was requested
- new CellularRule57
Version 66, February 2012
- new TerdragonMidpoint
- DragonCurve,DragonMidpoint,DragonRounded,TerdragonCurve faster xy_to_n()
Version 65, January 2012
- new parameter_info_hash(), n_frac_discontinuity()
Version 64, January 2012
- new AnvilSpiral, AlternatePaper, ComplexPlus, TerdragonCurve
Version 63, January 2012
- new class_x_negative() and class_y_negative() methods
- new CellularRule, ComplexRevolving, Math::NumSeq::PlanePathN
- Math::NumSeq::PlanePathCoord etc new planepath_object option
Version 62, December 2011
- new FractionsTree
Version 61, December 2011
- new FactorRationals
Version 60, December 2011
- new GcdRationals
Version 59, December 2011
- new AR2W2Curve
Version 58, December 2011
- new DiagonalRationals, StaircaseAlternating,
Math::NumSeq::PlanePathDelta
Version 57, December 2011
- new HilbertSpiral
- LTiling new L_fill "left" and "upper"
Version 56, December 2011
- new CincoCurve, DiagonalsAlternating, LTiling
Version 55, November 2011
- new KochelCurve, MPeaks
- Flowsnake,QuintetCurve faster xy_to_n()
Version 54, November 2011
- new WunderlichMeander
- PlanePathCoord new coordinate_type "Product","DiffXY","DiffYX","AbsDiff"
- BetaOmega,CellularRule190 exact rect_to_n_range()
Version 53, November 2011
- new FibonacciWordFractal, Math::NumSeq::PlanePathCoord
Version 52, November 2011
- new BetaOmega, CornerReplicate, DigitGroups, HIndexing
Version 51, October 2011
- new CellularRule190
Version 50, October 2011
- DragonRounded fix xy_to_n() with arms=2,3,4 on innermost XY=0,1
- SierpinskiCurve fixes for rect_to_n_range()
Version 49, October 2011
- new AztecDiamondRings, DivisibleColumns, SierpinskiCurve,
UlamWarburtonQuarter
- SierpinskiArrowheadCentres fix for n_to_xy() on fractional $n
Version 48, October 2011
- new UlamWarburton
Version 47, October 2011
- new SquareReplicate
Version 46, September 2011
- new GosperReplicate
Version 45, September 2011
- new QuintetCurve, QuintetCentres, QuintetReplicate
Version 44, September 2011
- new ComplexMinus
- RationalsTree new tree_type=Drib
- Corner new wider parameter
Version 43, September 2011
- new KochSquareflakes, RationalsTree
- new parameter_info_array(), parameter_info_list()
Version 42, September 2011
- new SierpinskiArrowheadCentres, SierpinskiTriangle
Version 41, August 2011
- new QuadricCurve, QuadricIslands, ImaginaryBase
Version 40, August 2011
- new DragonRounded, CellularRule54
- new arms_count() method
- Flowsnake, FlowsnakeCentres new "arms" parameter
Version 39, August 2011
- new DragonCurve, DragonMidpoint
Version 38, August 2011
- new Flowsnake, FlowsnakeCentres
Version 37, July 2011
- new SquareArms, DiamondArms, File
Version 36, July 2011
- new HexArms
- PeanoCurve new radix parameter
Version 35, July 2011
- new GosperSide
- fixes for experimental BigFloat support
Version 34, July 2011
- ZOrderCurve new radix parameter
Version 33, July 2011
- new GosperIslands
Version 32, June 2011
- new SierpinskiArrowhead, CoprimeColumns
Version 31, June 2011
- KochCurve fix for fractional N
Version 31, June 2011
- PythagoreanTree avoid dubious hypot() on darwin 8.11.0
Version 30, May 2011
- new TriangularHypot, KochCurve, KochPeaks, KochSnowflakes
Version 29, May 2011
- GreekKeySpiral rect_to_n_range() tighter $n_lo
- tests more diagnostics on PythagoreanTree
Version 28, May 2011
- PixelRings xy_to_n() fix some X==Y points should be undef
Version 27, May 2011
- new GreekKeySpiral
Version 26, May 2011
- new PythagoreanTree
- Rows,Columns more care against width<=0 or height<=0
Version 25, May 2011
- tests fix neg zero for long double NV
Version 24, May 2011
- tests fix OEIS file comparisons
- MultipleRings xy_to_n() fix for x=-0,y=0
Version 23, April 2011
- new ArchimedeanChords
- TheodorusSpiral rect_to_n_range() tighter $n_lo
Version 22, March 2011
- new n_start() method
- SacksSpiral rect_to_n_range() include N=0
Version 21, February 2011
- new Hypot, HypotOctant, OctagramSpiral
- TheodorusSpiral, VogelFloret allow for xy_to_n() result bigger than IV
(though that big is probably extremely slow)
Version 20, February 2011
- fix Makefile.PL for perl 5.6.0
- tests avoid stringized "-0" from perl 5.6.x
Version 19, January 2011
- new PixelRings
Version 18, January 2011
- avoid some 5.12 warnings on infs
Version 17, January 2011
- avoid some inf loops and div by zeros for n=infinity or x,y=infinity
(handling of infinity is unspecified, but at least don't hang)
- PyramidRows, PyramidSides exact rect_to_n_range()
Version 16, January 2011
- new PeanoCurve, Staircase
Version 15, January 2011
- MultipleRings fix xy_to_n() and rect_to_n_range() at 0,0
- Corners,Diagonals,MultipleRings tighter rect_to_n_range()
Version 14, December 2010
- HilbertCurve exact rect_to_n_range()
Version 13, December 2010
- new HilbertCurve, ZOrderCurve
Version 12, October 2010
- oops, VogelFloret botched rect_to_n_range()
Version 11, October 2010
- VogelFloret new rotation and radius parameters
- SacksSpiral,VogelFloret tighter rect_to_n_range() when away from origin
Version 10, October 2010
- fix MultipleRings xy_to_n()
Version 9, September 2010
- HexSpiral and HexSpiralSkewed new "wider" parameter
Version 8, September 2010
- tests fix stray 5.010 should be just 5.004
Version 7, August 2010
- new MultipleRings
- VogelFloret xy_to_n() fix for positions away from exact N
- Rows, Columns rect_to_n_range() tighter
Version 6, August 2010
- new TheodorusSpiral
Version 5, July 2010
- SquareSpiral new "wider" parameter
Version 4, July 2010
- new PentSpiral, HeptSpiralSkewed
- PyramidRows "step" parameter
Version 3, July 2010
- new PyramidSpiral, TriangleSpiral, TriangleSpiralSkewed, PentSpiralSkewed
Version 2, July 2010
- in Diagonals don't negative sqrt() if n=0
Version 1, July 2010
- the first version
Math-PlanePath-122/xtools/ 0002755 0001750 0001750 00000000000 12641645163 013241 5 ustar gg gg Math-PlanePath-122/xtools/my-wunused.sh 0000755 0001750 0001750 00000003125 12606127271 015710 0 ustar gg gg #!/bin/sh
# my-wunused.sh -- run warnings::unused on dist files
# Copyright 2009, 2010, 2011, 2012, 2013, 2015 Kevin Ryde
# my-wunused.sh is shared by several distributions.
#
# my-wunused.sh is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# my-wunused.sh is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
set -e
set -x
EXE_FILES=`sed -n 's/^EXE_FILES = \(.*\)/\1/p' Makefile`
TO_INST_PM=`find lib -name \*.pm`
LINT_FILES="Makefile.PL $EXE_FILES $TO_INST_PM"
if test -e "t/*.t"; then
LINT_FILES="$LINT_FILES t/*.t"
fi
if test -e "xt/*.t"; then
LINT_FILES="$LINT_FILES xt/*.t"
fi
for i in t xt examples devel; do
if test -e "$i/*.pl"; then
LINT_FILES="$LINT_FILES $i/*.pl"
fi
if test -e "$i/*.pm"; then
LINT_FILES="$LINT_FILES $i/*.pm"
fi
done
echo "$LINT_FILES"
for i in $LINT_FILES; do
# warnings::unused broken by perl 5.14, so use 5.10 for checks
# perl-5.10.0 -I /usr/share/perl5 -Mwarnings::unused=-global -I lib -c $i
# full path name or else the "require" looks through @INC
echo "\"$i\""
perl -e 'use Test::More tests=>1; use Test::Vars; Test::Vars::vars_ok($ARGV[0])' "`pwd`/$i"
done
Math-PlanePath-122/xtools/my-diff-prev.sh 0000755 0001750 0001750 00000003006 11776230514 016100 0 ustar gg gg #!/bin/sh
# my-diff-prev.sh -- diff against previous version
# Copyright 2009, 2010, 2011, 2012 Kevin Ryde
# my-diff-prev.sh is shared by several distributions.
#
# my-diff-prev.sh is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# my-diff-prev.sh is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
set -e
set -x
DISTNAME=`sed -n 's/^DISTNAME = \(.*\)/\1/p' Makefile`
if test -z "$DISTNAME"; then
echo "DISTNAME not found"
exit 1
fi
VERSION=`sed -n 's/^VERSION = \(.*\)/\1/p' Makefile`
if test -z "$VERSION"; then
echo "VERSION not found"
exit 1
fi
case $VERSION in
3.*) PREV_VERSION=3.018000 ;;
1.*) PREV_VERSION=1.16 ;;
*) PREV_VERSION="`expr $VERSION - 1`" ;;
esac
if test -z "$VERSION"; then
echo "PREV_VERSION not established"
exit 1
fi
rm -rf diff.tmp
mkdir -p diff.tmp
(cd diff.tmp;
tar xfz ../$DISTNAME-$PREV_VERSION.tar.gz
tar xfz ../$DISTNAME-$VERSION.tar.gz
diff -ur $DISTNAME-$PREV_VERSION \
$DISTNAME-$VERSION \
>tree.diff || true
)
${PAGER:-more} diff.tmp/tree.diff || true
rm -rf diff.tmp
exit 0
Math-PlanePath-122/xtools/my-tags.sh 0000644 0001750 0001750 00000002003 11714065142 015140 0 ustar gg gg #!/bin/sh
# my-tags.sh -- make tags
# Copyright 2009, 2010, 2011, 2012 Kevin Ryde
# my-tags.sh is shared by several distributions.
#
# my-tags.sh is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# my-tags.sh is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
set -e
set -x
# in a hash-style multi-const this "use constant" pattern only picks up the
# first constant, unfortunately, but it's better than nothing
etags \
--regex='{perl}/use[ \t]+constant\(::defer\)?[ \t]+\({[ \t]*\)?\([A-Za-z_][^ \t=,;]+\)/\3/' \
`find lib -type f`
Math-PlanePath-122/xtools/my-check-spelling.sh 0000755 0001750 0001750 00000003206 12350135425 017102 0 ustar gg gg #!/bin/sh
# my-check-spelling.sh -- grep for spelling errors
# Copyright 2009, 2010, 2011, 2012, 2013, 2014 Kevin Ryde
# my-check-spelling.sh is shared by several distributions.
#
# my-check-spelling.sh is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# my-check-spelling.sh is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
set -e
# set -x
# | tee /dev/stdout
# -name samp -prune \
# -o -name formats -prune \
# -o -name "*~" -prune \
# -o -name "*.tar.gz" -prune \
# -o -name "*.deb" -prune \
# -o
# -o -name dist-deb -prune \
# | egrep -v '(Makefile|dist-deb)' \
if find . -name my-check-spelling.sh -prune \
-o -type f -print0 \
| xargs -0 egrep --color=always -nHi 'optino|recurrance|nineth|\bon on\b|\bto to\b|tranpose|adjustement|glpyh|rectanglar|availabe|grabing|cusor|refering|writeable|nineth|\bommitt?ed|omited|[$][rd]elf|requrie|noticable|continous|existant|explict|agument|destionation|\bthe the\b|\bfor for\b|\bare have\b|\bare are\b|\bwith with\b|\bin in\b|\b[tw]hen then\b|\bnote sure\b|\bnote yet\b|correspondance|sprial|wholely|satisif|\bteh\b|\btje\b'
then
# nothing found
exit 1
else
exit 0
fi
Math-PlanePath-122/xtools/gp-inline 0000755 0001750 0001750 00000073515 12637673012 015061 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014, 2015 Kevin Ryde
# This file is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# This file is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
use 5.006;
use strict;
use warnings;
use Carp 'croak';
use FindBin;
use File::Copy;
use File::Spec;
use File::Temp;
use Getopt::Long;
use List::Util 'max';
use IPC::Run;
# uncomment this to run the ### lines
# use Smart::Comments;
our $VERSION = 0;
my $action = 'run';
my $gp = 'gp';
my $verbose = 0;
my $stdin = 0;
my $stacksize;
my $exit = 0;
my $total_files = 0;
my $total_expressions = 0;
### $action
# in $str change any decimals 0.123 to fractions (123/1000)
sub decimals_to_fraction {
my ($str) = @_;
$str =~ s{(\d*)\.(\d*)}
{length($1) || length($2)
? "($1$2/1".('0' x length($2)).")"
: "$1.$2" # bare dot unchanged
}ge;
return $str;
}
my $comment_prefix_re
= qr{^\s*
([\#%*]+ # # Perl, % TeX, * C continuing
|//+ # // C++
|/\*+ # /* C
|=for\s # =for Perl POD
)? # or nothing
}x;
my $tex_measure_re = qr/[0-9.]*(em|ex|pt|mm|cm|in)/;
sub pos_linenum {
my ($str, $pos) = @_;
$pos //= pos($_[0]);
$str = substr($str, 0, $pos);
return 1 + scalar($str =~ tr/\n//);
}
sub parse_constants {
my ($str, %options) = @_;
my $type = $options{'type'};
### parse_constants() ...
### $type
my $bad = sub {
my ($message) = @_;
### pos: pos($str)
my $linenum = $options{'linenum'} + pos_linenum($str, pos($str));
print STDERR "$options{'filename'}:$linenum: $message\n";
$str =~ /\G\s*[^\n]{0,20}/s;
my $near = $&;
if ($near eq '') {
print STDERR " (at end)\n";
} else {
print STDERR " near $&\n";
}
$exit = 1;
};
my $value_maybe;
my $whitespace = sub {
# ignored stuff
$str =~ /\G(
\s+ # whitespace
|\\[,;] # \, \; TeX
|\\kern$tex_measure_re # \kern1.5em
|\\hspace\{$tex_measure_re} # \hspace{1.5em}
|\\(degree|dots[bc]?|q?quad) # \degree \dotsc \dotsb \quad \qquad
|\\phantom\{[^}]*\} # \phantom{...}
)*/gcsx;
};
my $fraction_maybe = sub {
$whitespace->();
### fraction_maybe(): substr($str, pos($str), 20)
if ($str =~ m/\G(\d+(\.\d*)?|\d*\.\d+)/gc) { # number 123.456
my $number = $1;
### $number
### to: substr($str, pos($str), 20)
return decimals_to_fraction($number);
}
if ($str =~ /\G\\[td]?frac(\d)(\d)/gc) { # TeX \frac34
return "$1/$2";
}
if ($str =~ /\G\\[td]?frac\{/gc) { # TeX \frac{123}{456}
my $num = $value_maybe->();
$whitespace->();
unless ($str =~ /\G\}\s*\{/sgc) { # }{
$bad->("unrecognised \\frac{}{}");
return undef;
}
my $den = $value_maybe->();
$whitespace->();
unless ($str =~ /\G\}/gc) { # }
$bad->("unclosed \\frac{}{}");
}
### end fraction: substr($str, pos($str), 20)
return "($num)/($den)";
}
return undef;
};
my $addend_maybe = sub {
### addend_maybe(): substr($str, pos($str), 20)
my $ret = $fraction_maybe->();
my $complex = 0;
$whitespace->();
### try complex: substr($str, pos($str), 20)
if ($str =~ m/\Gi/gc) {
if (defined $ret) {
$ret .= "*I"; # 123 i
} else {
$ret = "I"; # i alone
}
$complex = 1;
}
### $ret
### $complex
return ($ret, $complex);
};
my $sign_maybe = sub {
$whitespace->();
### sign_maybe(): substr($str, pos($str), 20)
if ($str =~ m{\G(([-+])|\{([-+])\})}gc) {
my $sign = $2 || $3;
### $sign
### leave: substr($str, pos($str), 20)
return $sign;
} else {
return undef;
}
};
$value_maybe = sub {
my $sign = $sign_maybe->();
my ($add,$complex1) = $addend_maybe->();
if (! defined $add) {
if (defined $sign) {
$bad->("unrecognised expression after $sign");
}
return undef;
}
my $ret = $sign || '';
$ret .= $add;
$sign = $sign_maybe->() || return $ret;
($add, my $complex2) = $addend_maybe->();
if (! defined $add) {
$bad->("unrecognised expression after $sign");
return $ret;
}
$ret .= $sign;
$ret .= $add;
if ($complex1 == $complex2) {
$bad->("no arithmetic expressions (only complex numbers)");
}
return $ret;
};
$whitespace->();
$str =~ /\G&?=/gc; # optional initial = or &=
# secret undocumented ...
$whitespace->();
$str =~ /\G[[(]/gcx; # optional initial [ or (
my $separator_maybe = sub {
my $comma;
my $semi;
for (;;) {
### separator_maybe(): substr($str, pos($str), 20)
$whitespace->();
if ($str =~ /\G([,&]|\{,\})/gc) { # & , {,} separator
$comma = ',';
} elsif ($str =~ /\G\\\\/gc) {
if ($type eq 'MATRIX') {
$semi = ';'; # \\ for matrix rows
} else {
$comma = ','; # \\ separator in vector or constant
}
} else {
last;
}
}
return $semi || $comma;
};
$separator_maybe->();
my $ret = $value_maybe->();
if (! defined $ret) {
$bad->("unrecognised expression");
return '';
}
for (;;) {
my $sep = $separator_maybe->() || last;
my $more = $value_maybe->();
if (! defined $more) { last; }
if ($type eq 'CONSTANT') {
$bad->("multiple values in CONSTANT");
last;
}
$ret .= $sep;
$ret .= $more;
}
### end of values: substr($str, pos($str), 20)
# secret undocumented ...
$whitespace->();
$str =~ /\G[])]/gcx; # optional initial ] or )
$whitespace->();
if (pos($str) != length($str)) {
$bad->("unrecognised expression");
}
return $ret;
}
sub test_fh {
my ($fh, $filename) = @_;
my $output_fh;
my $runner_tempfh;
if ($action eq 'run') {
$output_fh = File::Temp->new (TEMPLATE => 'gp-inline-XXXXXX',
SUFFIX => '.gp',
TMPDIR => 1);
} else {
$output_fh = \*STDOUT;
}
my $test_last_fh = File::Temp->new (TEMPLATE => 'gp-inline-XXXXXX',
SUFFIX => '.gp',
TMPDIR => 1);
my $test_last;
my $output = sub {
my $fh = ($test_last ? $test_last_fh : $output_fh);
print $fh @_
or die "Error writing: $!";
};
my $output_test = sub {
if ($action ne 'defines') {
$output->(@_);
}
};
$output->(<<'HERE');
/* gp-inline test boilerplate begin */
gp_inline__location = "";
gp_inline__bad_location = "";
gp_inline__notbool_location = "";
gp_inline__good = 0;
gp_inline__bad = 0;
gp_inline__check(location,bool) =
{
gp_inline__location = location;
check(bool);
}
check(bool) =
{
/* use "===" so that a vector like [1] is not reckoned as success */
if(bool===1, gp_inline__good++,
bool===0, gp_inline__bad++;
if(gp_inline_location!=gp_inline__bad_location,
print(gp_inline__location": gp-inline fail"),
gp_inline__bad_location=gp_inline_location),
gp_inline__bad++;
if(gp_inline_location!=gp_inline__notbool_location,
print(gp_inline__location": gp-inline expected result 0 or 1, got ",
bool);
gp_inline__notbool_location = gp_inline_location)
);
}
/* gp-inline test boilerplate end */
HERE
# Possible equality check instead of "=="
# gp_inline__equal(got,want) =
# {
# if(x==y,gp_inline__good++,
# gp_inline__bad++;
# print(gp_inline__location": gp-inline fail");
# print("got "got);
# print("want "want));
# print1();
# }
if ($verbose) {
$output->("\\e 1\n");
}
{
my $end = '';
my $within = '';
my $within_linenum;
my $within_str;
my $join = '';
my $linenum = 1;
my $prev_type = '';
while (defined (my $line = readline $fh)) {
$linenum = $.;
### $line
### $within
if ($line =~ s{(?$comment_prefix_re)\s*GP-(?[-A-Za-z0-9]+)(:|\s)}{}) {
my $type = $+{'type'};
if ($+{'prefix'} =~ m{/\*}) {
$line =~ s{\*+/\s*$}{}; # strip C comment close */
}
$line =~ s/\n$//;
$type = uc($type);
### $type
if ($type eq 'TEST-LAST') {
$test_last = 1;
$type = 'TEST';
} else {
$test_last = 0;
}
if ($type eq 'END') {
if (defined $end) {
$output->(parse_constants($within_str,
filename => $filename,
linenum => $within_linenum,
type => $within));
$output->($end);
undef $end;
} else {
print STDERR "$filename:$linenum: unexpected GP-END\n";
$exit = 1;
}
$within = '';
next;
}
if ($type eq 'TEST') {
if ($within ne 'TEST') {
if ($within ne '') {
print STDERR "$filename:$linenum: still within $within from line $within_linenum\n";
$exit = 1;
}
$within_linenum = $linenum;
$output_test->("gp_inline__test() = ");
}
if ($line =~ /\\$/) {
### test continues after this line ...
### $line
$within = 'TEST';
$output_test->("$line\n");
} else {
### test ends at this line ...
### $line
# no final : on the filename:linenum so it's disguised from Emacs
# compilation-mode
my $location = gp_quote("$filename:$within_linenum");
$output_test->("$line;\n",
"gp_inline__check($location, gp_inline__test())\n");
$within = '';
}
next;
}
if (! $within && $prev_type eq 'not-gp-inline') {
# location string creation obscured against Emacs compilation-mode
# taking it to be many locations to mark etc
$output->("\ngp_inline__location=",
gp_quote("$filename:$linenum"),
";\n");
}
if ($within) {
print STDERR "$filename:$linenum: still within $within from line $within_linenum\n";
$exit = 1;
}
if ($type eq 'DEFINE') {
$output->($line,"\n");
} elsif ($type eq 'INLINE') {
$output_test->($line,"\n");
} elsif ($type eq 'CONSTANT') {
if ($line =~ /^\s*$/) {
print STDERR "$filename:$linenum: missing name for CONSTANT\n";
$exit = 1;
}
$output->("$line = {");
$join = "\n";
$end = "};\n";
$within = 'CONSTANT';
$within_linenum = $linenum;
$within_str = '';
} elsif ($type eq 'VECTOR') {
if ($line =~ /^\s*$/) {
print STDERR "$filename:$linenum: missing name for VECTOR\n";
$exit = 1;
}
$output->("$line = {[");
$join = "\n";
$end = "]};\n";
$within = 'VECTOR';
$within_linenum = $linenum;
$within_str = '';
} elsif ($type eq 'MATRIX') {
if ($line =~ /^\s*$/) {
print STDERR "$filename:$linenum: missing name for MATRIX\n";
$exit = 1;
}
$output->("$line = {[");
$join = "\n";
$end = "]};\n";
$within = 'MATRIX';
$within_linenum = $linenum;
$within_str = '';
} else {
print STDERR "$filename:$linenum: ignoring unrecognised \"$type\"\n";
}
$prev_type = $type;
} elsif ($within eq 'CONSTANT'
|| $within eq 'VECTOR'
|| $within eq 'MATRIX') {
$within_str .= $line;
# $line =~ s/(^|[^\\])(\\\\)*%.*//; # % comments
# $line =~ s/\\[,;]/ /g; # ignore \, or \; spacing
# $line =~ s/\\(phantom|hspace){[^}]*}/ /g; # ignore TeX \phantom{...}
# $line =~ s/\\(kern)-?[0-9.]+[a-z]+/ /g; # ignore TeX \kern...
# $line =~ s/\{([+-])\}/$1/g; # {+} or {-}
# $line =~ s/&/,/g; # & as field separator
# $line =~ s|\\[td]?frac(\d)(\d)|($1)/($2)|g; # \frac23
# $line =~ s|\\[td]?frac\{([^}]*)}\{([^}]*)}|($1)/($2)|g; # \frac{}{}
# $line =~ s/\\(sqrt\d+)\s*(i?)/$1$2/g; # \sqrt2 or \sqrt3 i
# $line =~ s/([0-9.)]+)[ \t]*i/$1*I/g; # complex number 123 i
# $line =~ s/\bi[ \t]*([0-9.]+)/I*$1/g; # complex number i 123
# $line =~ s/([+-])[ \t]*(I)\b/$1$2/g; # complex number +- i 123
# $line =~ s/\bi\b/I/g; # complex number i -> I
# if ($within eq 'MATRIX') {
# $line =~ s/\\\\/;/g; # row separator \\
# } else {
# $line =~ s/;/,/g; # semi as separator
# }
# $line =~ s|[^-+*/^()0-9.I,; \t]||sg; # strip anything else
# $line =~ s/(^|;)(\s*,)+/$1/sg; # strip leading commas
# $line =~ s/,(\s*,)+/,/sg; # strip duplicated commas
# $line =~ s/,[ \t]*$//; # strip trailing commas
# # print "\\ ",$line,"\n";
# $line =~ s/[ \t]*$//; # strip trailing whitespace
# $line = decimals_to_fractions($line);
# if ($line ne '') {
# $output->($join,$line,"\n");
# $join = ($line =~ /;$/ ? "\n" : ",\n");
# }
next;
} else {
### non test line ...
$prev_type = 'not-gp-inline';
}
}
### EOF ...
if ($within) {
print STDERR "$filename:$linenum: end of file within \"$within\"\n";
$exit = 1;
}
}
$test_last = 0;
$output_fh->flush;
$test_last_fh->flush;
File::Copy::copy($test_last_fh->filename, $output_fh)
or die "Error copying Test-Last: $!";
$output_test->(<<'HERE');
print("Total ",(gp_inline__good+gp_inline__bad)," tests, "gp_inline__good" good, "gp_inline__bad" bad");
if(gp_inline__bad,quit(1))
HERE
if ($action eq 'run') {
$runner_tempfh = File::Temp->new (TEMPLATE => 'gp-inline-XXXXXX',
SUFFIX => '.gp',
TMPDIR => 1);
my $read_filename = gp_quote($output_fh->filename);
print $runner_tempfh <<"HERE";
{
read($read_filename);
}
HERE
# iferr(read($read_filename),err,
# print("rethrow");
# error(err), /* rethrow */
# 0);
# /* print(gp_inline__location,"error reading"); 0 */
$output_fh->flush;
my @command = ('gp',
'--quiet',
'-f', # "fast" do not read .gprc
(defined $stacksize ? ('-s', $stacksize) : ()),
'--default', 'recover=0',
# $runner_tempfh->filename,
$output_fh->filename);
if ($verbose) {
print join(' ',@command),"\n";
}
if (! IPC::Run::run(\@command, '<', File::Spec->devnull)) {
$exit = 1;
}
}
}
# Return $str as a string "$str" for use in a gp script.
# Any " quotes etc in $str are suitably escaped.
sub gp_quote {
my ($str) = @_;
$str =~ s/\"/\\"/g;
return '"'.$str.'"';
}
sub test_file {
my ($filename) = @_;
### test_file(): $filename
$total_files++;
open my $fh, '<', $filename
or die "Cannot open $filename: $!";
test_fh($fh, $filename);
close $fh
or die "Error closing $filename: $!";
}
sub test_files {
# ($filename, ...)
foreach my $filename (@_) {
test_file($filename);
}
}
#------------------------------------------------------------------------------
# mainline
{
my $help = sub {
print "gp-inline [--options] filename...\n";
my @opts =
(['-h, --help', 'Print this help'],
['-v, --version', 'Print program version'],
['--verbose', 'Print extra messages'],
['--run', 'Run the inline tests in each FILENAME'],
['--extract', 'Print the test code from each FILENAME'],
['--defines', 'Print just the definitions from each FILENAME'],
);
my $width = 2 + max (map { length ($_->[0]) } @opts);
foreach (@opts) {
printf "%-*s%s\n", $width, $_->[0], $_->[1];
}
print "\n";
exit 0;
};
GetOptions ('help|?' => $help,
version => sub {
print "$FindBin::Script version $VERSION\n";
exit 0;
},
run => sub { $action = 'run' },
defines => sub { $action = 'defines' },
extract => sub { $action = 'extract' },
'gp=s' => \$gp,
stdin => \$stdin,
verbose => \$verbose,
's=i' => \$stacksize,
)
or exit 1;
($stdin || @ARGV) or $help->();
}
if ($stdin) {
test_fh(\*STDIN, '(stdin)');
}
test_files(@ARGV);
exit $exit;
#------------------------------------------------------------------------------
__END__
# } elsif ($arg eq '-dist') {
# $exit = 1;
# require ExtUtils::Manifest;
# my $href = ExtUtils::Manifest::maniread();
# my @filenames = grep m{^lib/.*\.pm$|^[^/]\.pm$}, keys %$href;
# $good &= $class->test_files(@filenames);
# # if ($exit) {
# # $class->diag ("gp-inline total $total_expressions checks in $total_files files");
# # exit($good ? 0 : 1);
# # }
#
# sub diag {
# my $self = shift;
# if (eval { Test::More->can('diag') }) {
# Test::More::diag (@_);
# } else {
# my $msg = join('', map {defined($_)?$_:'[undef]'} @_)."\n";
# # $msg =~ s/^/# /mg;
# print STDERR $msg;
# }
# }
=for stopwords gp Ryde globals backslashing backtrace multi-file multi-line
=head1 NAME
gp-inline -- run Pari/GP code inline in a document
=head1 SYNOPSIS
gp-inline [--options] filename...
=head1 DESCRIPTION
C extracts and executes Pari/GP code from comments written inline
in a document such as TeX or POD, or even in some C code or similar. This
can be used to check calculations or formulas alongside their statement in a
document. For example in TeX
Blah blah and from which it is seen that $1+1 = 2$.
% GP-Test 1+1 == 2
which is checked by running
gp-inline foo.tex
GP is a mathematical system and these checks will usually be for
mathematical calculations and formulas, but can be useful even for just
basic arithmetic.
=head2 Test
A C line must evaluate to 0 or 1. The evaluation is inside a
function body so semicolons can separate multiple expressions and the last
is the result.
% GP-Test my(n=5); 2*n^2 + n == 55
Requiring a result 0 or 1 helps avoid mistakes like forgetting "== 123" etc.
The suggestion is not to end C with a semicolon so that it can be
pasted into GP to see the result when experimenting, but C works
with or without.
The suggestion is also to keep variables local with C to avoid one test
depending on another accidentally, but that's not enforced. See
L below for making global variables.
Multi-line tests can be written with GP style backslashing
% GP-Test some_thing() \
% GP-Test == 123
Comments can be included in a test in GP C* ... */> style. Don't use
C<\\> style as the expressions C constructs don't work properly
with that yet.
% GP-Test 105 == 3*5*7 /* its prime factors */
Tests are run with C so any F<~/.gprc> or C<$GPRC> file is not
evaluated. This is designed to give consistent test results without
personal preferences wanted for C interactively etc.
=head2 Prefix
The following prefixes are recognised for a C line (etc)
GP-Test 1+1==2
# GP-Test 1+1==2
% GP-Test 1+1==2
/* GP-Test 1+1==2 */
* GP-Test 1+1==2
// GP-Test 1+1==2
=for GP-Test 1+1==2
These are comments in Perl, TeX, C, C++, and Perl POD directive C<=for>. In
C style C*> an optional trailing C<*/> is stripped. Or its comment parts
can be on separate lines if desired
/*
GP-Test 1+1==2
*/
/*
* GP-Test 1+1==2
*/
A Perl POD C<=for> should be a single line and will usually want a blank
line before and after to be valid POD. Those blanks can be a tedious for
many tests and in that case the suggestion is to C<=cut> and write a block
of tests
=cut
# GP-Test 2+2==4
# GP-Test 4+4==8
=pod
The C<#> prefix here is not needed if already after an C<__END__> so not
evaluated by Perl, but it's a good way for human readers to distinguish
those lines from the POD text.
=head2 Definitions
Definition lines can create new GP functions or globals
% GP-DEFINE my_func(n) = 2*n + 3;
% GP-DEFINE my_vector = [ 1, 2, 3, 5 ];
These lines are arbitrary code passed directly to GP. Generally they should
end with a C<;> to suppress result printing in the usual way, but that's not
enforced. Multi-line functions or expressions can use either backslashing
or braces
% GP-DEFINE long_func(n) = \
% GP-DEFINE some + long \
% GP-DEFINE - expression;
% GP-DEFINE my_matrix = {[
% GP-DEFINE 1, 2;
% GP-DEFINE 2, 1
% GP-DEFINE ]};
Definition lines can also make initial settings. For example
C is a good way to guard against mistakes in function
arguments (assuming you're not deliberately lazy with such things)
% GP-DEFINE default(strictargs,1);
External GP code modules can be included with the usual C. Normally
this will be in a C.
% GP-DEFINE read("my-library.gp");
=head2 Test Last
C tests are run last, after the rest of the input file. This
lets a test precede a formula or data definition it depends on. This
doesn't happen often, usually only when some a document gives examples of a
formula before the full statement. If you keep the function definition with
the statement of the formula then C allows tests to be written
before.
We will want f(6)=10 and ...
% GP-Test-Last f(6) == 10
The unique function satisfying is then f(n) = 2n - 2.
% GP-DEFINE f(n) = 2*n - 2;
Care should be taken not to redefine globals which C tests
will use. But it's wise anyway not to change the meaning of globals through
a document so that rearranging sections etc doesn't upset the checks.
=head2 Errors
Syntax errors and type errors in tests and definitions are fatal. The
current implementation runs C so such problems cause
a non-zero exit code. A location string is included in the test expression
so the backtrace has something like
*** at top-level: ...inline("foo.tex:153",(()->bar())())
...
which means input file F line 153 was the offending C.
Errors in C statements don't have this location in the backtrace
(since they're a "top-level" evaluation). If the offending part is not
obvious then try C to see a C<\e> trace of each
expression. It includes some C<"foo.tex:150"> etc strings which are the
source locations.
(This locations printing is not very good. An equivalent of C<#line> would
help. Or is there a way to insert a print before an error backtrace? An
C trap loses the backtrace.)
=head2 Constants, Vectors and Matrices
Numbers in the document text can be extracted as GP definitions. For
example a constant C,
% GP-CONSTANT foo
123
% GP-END
Or a vector C,
% GP-VECTOR bar
1, 2, 3
% GP-END
Or a matrix C,
% GP-MATRIX quux
1 & 2 \\ 3 & 4
% GP-END
These GP definitions can be used in subsequent tests, and the numbers are
also document text or program code, etc. The number forms accepted are
123 integer
{-}1 signs, optionally with TeX {}
1.42 decimal fraction
\frac58 TeX \frac, \tfrac, \dfrac
\tfrac{12}{34}
-3-4i complex number, lower case i
\tfrac{5}{2+i} fractions with complex numbers
, & vector separator commas
\\ matrix row separator
Multiple commas etc are treated as just one. The matrix separator C<\\> is
treated as comma in a C. There should be just one value in a
C but leading or trailing commas are ignored.
Decimal fractions C<12.45> become rationals like C<1245/100> to preserve an
exact value. If it's some irrational which has been truncated then staying
it exact lets you make an exact check of all the decimals given.
The number syntax accepted is quite strict. This is designed to ensure
C doesn't quietly ignore something which it wasn't supposed to.
Various bits of TeX are ignored. These are things often wanted in a list of
numbers. However in general it's best to confine C etc to just
the numbers and keep TeX outside.
= initial = sign
&= initial TeX align and = sign
\, \; \quad \qquad various TeX spacing and macros
\kern1.5em measures em,ex,pt,mm,cm,in
\hspace{5pt}
\phantom{...}
\degree
\dotsc \dotsb
C<\kern> should be a single numbered measure C, C. Don't use a
comma for the decimal, and don't use C etc calculations.
C<\phantom{}> cannot contain nested C<{ }> braces (though it can contain
equivalent C<\begingroup> and C<\endgroup> if desired).
Comments, both TeX or other styles, cannot be in a list of numbers. Perhaps
this will change.
=head1 Other Notes
When including numbers in a document there's a bit of a choice between
writing them in the document and applying checks, versus generating the
numbers externally and C<#include> (or equivalent) to bring them in. The
latter has the disadvantage of several little files (probably), the former
is a little tedious to write manually but then isn't vulnerable to breakage
in a generator program.
Various arithmetic programs or computer algebra systems could be used in a
similar way to C. GP has the attraction of a compact syntax for
calculations and new functions, and having a range of arbitrary precision
basic types such as fractions, complex numbers, polynomials, even quads for
exact square roots, plus a lot of number theory things for higher
mathematics.
=head1 OPTIONS
The command line options are
=over 4
=item C<--run>
Run the inline tests in each given file. This is the default action.
=item C<--stdin>
Read a document from standard input (instead of named files).
=item C<--extract>
Extract the inline C code from each file and print to standard output.
This output is what C<--run> would run with C.
Usually C<--extract> should be used on just one input file, otherwise the
tests of each file are output one after the other and globals left by the
first might upset later tests.
=item C<--defines>
Extract just the definitions from the given files and print to standard
output.
This is good for extracting definitions so they can be used separately in
further calculations or experiments. It's also possible to go the other
way, have definitions in a separate file which the document loads with
C. Usually it avoids mistakes to keep a definition with the formula
etc in the document. But generic or very large code could be kept separate.
=item C<--help>
Print a brief help message.
=item C<--version>
Print the program version number and exit.
=back
=head1 EXIT CODE
C exits with 0 if all tests in all files are successful, or
non-zero if any problems.
=head1 BUGS
There's no support for a multi-file document where defines would be carried
over from one part to the next. The suggestion is either to C them
together and pass a single file, possibly to C; or use
C<--defines> to get the definitions from one file and do a C of them
in the next. The latter is good to get the defines out of a main document
which can then be read into a separate work-in-progress document which has
text and tests destined for the main, when ready.
The C and C number syntax is not enough for all
purposes. There will always be some layout which is too specific for
C to recognise. The suggestion in that case is to write
C beside the relevant values. The duplication is not nice, but
done once and with the define right beside the numbers it's not too bad.
Some sort of C to pick a polynomial out some TeX could be
good. It could include polynomial fractions (C) since they're a
native type in GP and suit generating functions.
=head1 SEE ALSO
L
=head1 HOME PAGE
L
=head1 LICENSE
Copyright 2015 Kevin Ryde
gp-inline is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
gp-inline is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along
with gp-inline. If not, see .
=cut
# Maybe:
# GP-Define foo(x) = x+1;
# GP-Test foo(2) == 3
# GP-Inline for(i=1,10, foo(i)==i+1
# GP-Vector
# GP-End
# GP-Constant
# GP-End
# GP-Matrix
# GP-End
#
# GP-Inline check(bool)
# ... names that won't clash
#
# GP-Define all defines at start then all GP-Inline and GP-Test ?
Math-PlanePath-122/xtools/my-kwalitee.sh 0000755 0001750 0001750 00000002146 11775434756 016044 0 ustar gg gg #!/bin/sh
# my-kwalitee.sh -- run cpants_lint kwalitee checker
# Copyright 2009, 2010, 2011, 2012 Kevin Ryde
# my-kwalitee.sh is shared by several distributions.
#
# my-kwalitee.sh is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# my-kwalitee.sh is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
# Module::CPANTS::Analyse
set -e
set -x
DISTVNAME=`sed -n 's/^DISTVNAME = \(.*\)/\1/p' Makefile`
if test -z "$DISTVNAME"; then
echo "DISTVNAME not found"
exit 1
fi
if [ -e ~/bin/my-gpg-agent-daemon ]; then
eval `my-gpg-agent-daemon`
echo "gpg-agent $GPG_AGENT_INFO"
fi
TGZ="$DISTVNAME.tar.gz"
make "$TGZ"
cpants_lint "$TGZ"
Math-PlanePath-122/xtools/my-pc.sh 0000755 0001750 0001750 00000003233 12206324154 014613 0 ustar gg gg #!/bin/sh
# my-pc.sh -- run cpants_lint kwalitee checker
# Copyright 2009, 2010, 2011, 2012, 2013 Kevin Ryde
# my-pc.sh is shared by several distributions.
#
# my-pc.sh is free software; you can redistribute it
# and/or modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 3, or (at your
# option) any later version.
#
# my-pc.sh is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
set -x
# PERLRUNINST=`sed -n 's/^PERLRUNINST = \(.*\)/\1/p' Makefile`
# if test -z "$PERLRUNINST"; then
# echo "PERLRUNINST not found"
# exit 1
# fi
EXE_FILES=`sed -n 's/^EXE_FILES = \(.*\)/\1/p' Makefile`
TO_INST_PM=`find lib -name \*.pm`
LINT_FILES="Makefile.PL $EXE_FILES $TO_INST_PM"
if test -e "t/*.t"; then
LINT_FILES="$LINT_FILES t/*.t"
fi
if test -e "xt/*.t"; then
LINT_FILES="$LINT_FILES xt/*.t"
fi
for i in t xt examples devel; do
if test -e "$i/*.pl"; then
LINT_FILES="$LINT_FILES $i/*.pl"
fi
if test -e "$i/*.pm"; then
LINT_FILES="$LINT_FILES $i/*.pm"
fi
done
perl -e 'use Test::Vars; all_vars_ok()'
# MyMakeMakerExtras_Pod_Coverage
perl -e 'use Pod::Coverage package => $class'
podlinkcheck -I lib `ls $LINT_FILES | grep -v '\.bash$$|\.desktop$$\.png$$|\.xpm$$'`
podchecker -nowarnings `ls $LINT_FILES | grep -v '\.bash$$|\.desktop$$\.png$$|\.xpm$$'`
perlcritic $LINT_FILES
Math-PlanePath-122/xtools/my-deb.sh 0000755 0001750 0001750 00000007206 12633077111 014751 0 ustar gg gg #!/bin/sh
# my-deb.sh -- make .deb
# Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# my-deb.sh is shared by several distributions.
#
# my-deb.sh is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# my-deb.sh is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
# warnings::unused broken by perl 5.14, so use 5.10 for checks
set -e
set -x
DISTNAME=`sed -n 's/^DISTNAME = \(.*\)/\1/p' Makefile`
if test -z "$DISTNAME"; then
echo "DISTNAME not found"
exit 1
fi
VERSION=`sed -n 's/^VERSION = \(.*\)/\1/p' Makefile`
if test -z "$VERSION"; then
echo "VERSION not found"
exit 1
fi
DISTVNAME=`sed -n 's/^DISTVNAME = \(.*\)/\1/p' Makefile`
if test -z "$DISTVNAME"; then
echo "DISTVNAME not found"
exit 1
fi
DISTVNAME=`echo "$DISTVNAME" | sed "s/[$][(]VERSION[)]/$VERSION/"`
XS_FILES=`sed -n 's/^XS_FILES = \(.*\)/\1/p' Makefile`
EXE_FILES=`sed -n 's/^EXE_FILES = \(.*\)/\1/p' Makefile`
if test -z "$XS_FILES"
then DPKG_ARCH=all
else DPKG_ARCH=`dpkg --print-architecture`
fi
# programs named after the dist, libraries named with "lib"
# gtk2-ex-splash and wx-perl-podbrowser programs are lib too though
DEBNAME=`echo $DISTNAME | tr A-Z a-z`
DEBNAME=`echo $DEBNAME | sed 's/app-//'`
case "$EXE_FILES" in
gtk2-ex-splash|wx-perl-podbrowser|'')
DEBNAME="lib${DEBNAME}-perl" ;;
esac
DEBVNAME="${DEBNAME}_$VERSION-0.1"
DEBFILE="${DEBVNAME}_$DPKG_ARCH.deb"
# ExtUtils::MakeMaker 6.42 of perl 5.10.0 makes "$(DISTVNAME).tar.gz" depend
# on "$(DISTVNAME)" distdir directory, which is always non-existent after a
# successful dist build, so the .tar.gz is always rebuilt.
#
# So although the .deb depends on the .tar.gz don't express that here or it
# rebuilds the .tar.gz every time.
#
# The right rule for the .tar.gz would be to depend on the files which go
# into it of course ...
#
# DISPLAY is unset for making a deb since under fakeroot gtk stuff may try
# to read config files like ~/.pangorc from root's home dir /root/.pangorc,
# and that dir will be unreadable by ordinary users (normally), provoking
# warnings and possible failures from nowarnings().
#
test -f $DISTVNAME.tar.gz || make $DISTVNAME.tar.gz
debver="`dpkg-parsechangelog -c1 | sed -n -r -e 's/^Version: (.*)-[0-9.]+$/\1/p'`"
echo "debver $debver", want $VERSION
test "$debver" = "$VERSION"
rm -rf $DISTVNAME
tar xfz $DISTVNAME.tar.gz
unset DISPLAY; export DISPLAY
cd $DISTVNAME
dpkg-checkbuilddeps debian/control
fakeroot debian/rules binary
cd ..
rm -rf $DISTVNAME
#------------------------------------------------------------------------------
# lintian .deb and source
lintian -I -i \
--suppress-tags new-package-should-close-itp-bug,desktop-entry-contains-encoding-key \
$DEBFILE
TEMP="/tmp/temp-lintian-$DISTVNAME"
rm -rf $TEMP
mkdir $TEMP
cp $DISTVNAME.tar.gz $TEMP/${DEBNAME}_$VERSION.orig.tar.gz
cd $TEMP
tar xfz ${DEBNAME}_$VERSION.orig.tar.gz
if test "$DISTVNAME" != "$DEBNAME-$VERSION"; then
mv -T $DISTVNAME $DEBNAME-$VERSION
fi
dpkg-source -b $DEBNAME-$VERSION \
${DEBNAME}_$VERSION.orig.tar.gz; \
lintian -I -i \
--suppress-tags maintainer-upload-has-incorrect-version-number,changelog-should-mention-nmu,empty-debian-diff,debian-rules-uses-deprecated-makefile *.dsc
cd /
rm -rf $TEMP
exit 0
Math-PlanePath-122/xtools/my-manifest.sh 0000755 0001750 0001750 00000001652 11764227757 016045 0 ustar gg gg #!/bin/sh
# my-manifest.sh -- update MANIFEST file
# Copyright 2009, 2010, 2011, 2012 Kevin Ryde
# my-manifest.sh is shared by several distributions.
#
# my-manifest.sh is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# my-manifest.sh is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
set -e
if [ -e MANIFEST ]; then
mv MANIFEST MANIFEST.old || true
fi
touch SIGNATURE
(
make manifest 2>&1;
diff -u MANIFEST.old MANIFEST
) | ${PAGER:-more}
Math-PlanePath-122/xtools/my-check-copyright-years.sh 0000755 0001750 0001750 00000004650 12635703146 020431 0 ustar gg gg #!/bin/sh
# my-check-copyright-years.sh -- check copyright years in dist
# Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# my-check-copyright-years.sh is shared by several distributions.
#
# my-check-copyright-years.sh is free software; you can redistribute it
# and/or modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 3, or (at your
# option) any later version.
#
# my-check-copyright-years.sh is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
set -e # die on error
set -x # echo
# find files in the dist with mod times this year, but without this year in
# the copyright line
if test -z "$DISTVNAME"; then
DISTVNAME=`sed -n 's/^DISTVNAME = \(.*\)/\1/p' Makefile`
fi
case $DISTVNAME in
*\$*) DISTVNAME=`make echo-DISTVNAME` ;;
esac
if test -z "$DISTVNAME"; then
echo "DISTVNAME not set and not in Makefile"
exit 1
fi
TARGZ="$DISTVNAME.tar.gz"
if test -e "$TARGZ"; then :;
else
pwd
echo "TARGZ $TARGZ not found"
exit 1
fi
MY_HIDE=
year=`date +%Y`
result=0
# files with dates $year
tar tvfz $TARGZ \
| egrep "$year-|debian/copyright" \
| sed "s:^.*$DISTVNAME/::" \
| {
while read i
do
# echo "consider $i"
GREP=grep
case $i in \
'' | */ \
| ppport.h \
| debian/changelog | debian/doc-base \
| debian/compat | debian/emacsen-compat | debian/source/format \
| debian/patches/*.diff \
| COPYING | MANIFEST* | SIGNATURE | META.yml | META.json \
| version.texi | */version.texi \
| *utf16* | examples/rs''s2lea''fnode.conf \
| */MathI''mage/ln2.gz | */MathI''mage/pi.gz \
| *.mo | *.locatedb* | t/samp.* \
| t/empty.dat | t/*.xpm | t/*.xbm | t/*.jpg | t/*.gif \
| t/*.g${MY_HIDE}d \
| tools/*-oeis-samples.gp \
| tools/configurations-gfs-generated.gp \
| devel/configurations-t-generated.gp \
| */_whizzy*)
continue ;;
*.gz)
GREP=zgrep
esac; \
if test -e "$srcdir/$i"
then f="$srcdir/$i"
else f="$i"
fi
if $GREP -q -e "Copyright.*$year" $f
then :;
else
echo "$i:1: this file"
grep Copyright $f
result=1
fi
done
}
exit $result
Math-PlanePath-122/xt/ 0002755 0001750 0001750 00000000000 12641645163 012344 5 ustar gg gg Math-PlanePath-122/xt/0-Test-ConsistentVersion.t 0000644 0001750 0001750 00000002253 11655356324 017304 0 ustar gg gg #!/usr/bin/perl -w
# 0-Test-ConsistentVersion.t -- run Test::ConsistentVersion if available
# Copyright 2011 Kevin Ryde
# 0-Test-ConsistentVersion.t is shared by several distributions.
#
# 0-Test-ConsistentVersion.t is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# 0-Test-ConsistentVersion.t is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
use 5.004;
use strict;
use Test::More;
eval { require Test::ConsistentVersion }
or plan skip_all => "due to Test::ConsistentVersion not available -- $@";
Test::ConsistentVersion::check_consistent_versions
(no_readme => 1, # no version number in my READMEs
no_pod => 1, # no version number in my docs, at the moment
);
# ! -e 'README');
exit 0;
Math-PlanePath-122/xt/0-Test-Synopsis.t 0000755 0001750 0001750 00000001764 11655356314 015444 0 ustar gg gg #!/usr/bin/perl -w
# 0-Test-Synopsis.t -- run Test::Synopsis if available
# Copyright 2009, 2010, 2011 Kevin Ryde
# 0-Test-Synopsis.t is shared by several distributions.
#
# 0-Test-Synopsis.t is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# 0-Test-Synopsis.t is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
use 5.004;
use strict;
use Test::More;
eval 'use Test::Synopsis; 1'
or plan skip_all => "due to Test::Synopsis not available -- $@";
## no critic (ProhibitCallsToUndeclaredSubs)
all_synopsis_ok();
exit 0;
Math-PlanePath-122/xt/oeis-duplicate.t 0000644 0001750 0001750 00000003171 12136177165 015441 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Check that OEIS A-number sequences implemented by PlanePath modules aren't
# already supplied by the core NumSeq.
#
use 5.004;
use strict;
use Test;
plan tests => 1;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# uncomment this to run the ### lines
#use Devel::Comments '###';
use Math::NumSeq::OEIS::Catalogue::Plugin::BuiltinTable;
use Math::NumSeq::OEIS::Catalogue::Plugin::PlanePath;
my %builtin_anums;
foreach my $info (@{Math::NumSeq::OEIS::Catalogue::Plugin::BuiltinTable::info_arrayref()}) {
$builtin_anums{$info->{'anum'}} = $info;
}
my $good = 1;
my $count = 0;
foreach my $info (@{Math::NumSeq::OEIS::Catalogue::Plugin::PlanePath::info_arrayref()}) {
my $anum = $info->{'anum'};
if ($builtin_anums{$anum}) {
MyTestHelpers::diag ("$anum already a NumSeq builtin");
$good = 0;
}
$count++;
}
ok ($good);
MyTestHelpers::diag ("total $count PlanePath A-numbers");
exit 0;
Math-PlanePath-122/xt/0-no-debug-left-on.t 0000755 0001750 0001750 00000006515 12044143060 015722 0 ustar gg gg #!/usr/bin/perl -w
# 0-no-debug-left-on.t -- check no Smart::Comments left on
# Copyright 2011, 2012 Kevin Ryde
# 0-no-debug-left-on.t is shared by several distributions.
#
# 0-no-debug-left-on.t is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# 0-no-debug-left-on.t is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
# cf Test::NoSmartComments which uses Module::ScanDeps.
require 5;
use strict;
Test::NoDebugLeftOn->Test_More(verbose => 0);
exit 0;
package Test::NoDebugLeftOn;
use strict;
use ExtUtils::Manifest;
sub Test_More {
my ($class, %options) = @_;
require Test::More;
Test::More::plan (tests => 1);
Test::More::ok ($class->check (diag => \&Test::More::diag,
%options));
1;
}
sub check {
my ($class, %options) = @_;
my $diag = $options{'diag'};
if (! -e 'Makefile.PL') {
&$diag ('skip, no Makefile.PL so not ExtUtils::MakeMaker');
return 1;
}
my $href = ExtUtils::Manifest::maniread();
my @files = keys %$href;
my $good = 1;
my @perl_files = grep {m{
^lib/
|^(lib|examples|x?t)/.*\.(p[lm]|t)$
|^Makefile.PL$
|^[^/]+$
}x
} @files;
my $filename;
foreach $filename (@perl_files) {
if ($options{'verbose'}) {
&$diag ("perl file ",$filename);
}
if (! open FH, "< $filename") {
&$diag ("Oops, cannot open $filename: $!");
$good = 0;
next;
}
while () {
if (/^__END__/) {
last;
}
# only a DEBUG=> non-zero number is bad, so an expression can copy a
# debug from another package
if (/(DEBUG\s*=>\s*[1-9][0-9]*)/
|| /^[ \t]*((use|no) (Smart|Devel)::Comments)/
|| /^[ \t]*(use lib\b.*devel.*)/
) {
print STDERR "\n$filename:$.: leftover: $_\n";
$good = 0;
}
}
if (! close FH) {
&$diag ("Oops, error closing $filename: $!");
$good = 0;
next;
}
}
my @C_files = grep {m{
# toplevel or lib .c and .xs files
^[^/]*\.([ch]|xs)$
|^(lib|examples|x?t)/.*\.([ch]|xs)$
}x
} @files;
foreach $filename (@C_files) {
if ($options{'verbose'}) {
&$diag ("C/XS file ",$filename);
}
if (! open FH, "< $filename") {
&$diag ("Oops, cannot open $filename: $!");
$good = 0;
next;
}
while () {
if (/^#\s*define\s+DEBUG\s+[1-9]/
) {
print STDERR "\n$filename:$.: leftover: $_\n";
$good = 0;
}
}
if (! close FH) {
&$diag ("Oops, error closing $filename: $!");
$good = 0;
next;
}
}
&$diag ("checked ",scalar(@perl_files)," perl files, ",
scalar(@C_files)," C/XS files\n");
return $good;
}
Math-PlanePath-122/xt/bigrat.t 0000644 0001750 0001750 00000053546 12563052643 014012 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Crib notes:
#
# In perl 5.8.4 "BigInt != BigRat" doesn't work, must have it other way
# around as "BigRat != BigInt". Symptom is "uninitialized" warnings.
#
use 5.004;
use strict;
use Test;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $test_count = (tests => 471)[1];
plan tests => $test_count;
if (! eval { require Math::BigRat; 1 }) {
MyTestHelpers::diag ('skip due to Math::BigRat not available -- ',$@);
foreach (1 .. $test_count) {
skip ('due to no Math::BigRat', 1, 1);
}
exit 0;
}
MyTestHelpers::diag ('Math::BigRat version ', Math::BigRat->VERSION);
if (! Math::BigRat->can('as_float')) {
MyTestHelpers::diag ('skip due to Math::BigRat->as_float method not available');
foreach (1 .. $test_count) {
skip ('due to no as_float()', 1, 1);
}
exit 0;
}
{
my $f = Math::BigRat->new('-1/2');
my $int = int($f);
if ($int == 0) {
MyTestHelpers::diag ('BigRat int(-1/2)==0, good');
} else {
MyTestHelpers::diag ("BigRat has int(-1/2) != 0 dodginess: value is '$int'");
}
}
require Math::BigInt;
MyTestHelpers::diag ('Math::BigInt version ', Math::BigInt->VERSION);
{
my $n = Math::BigInt->new(2) ** 256;
my $int = int($n);
if (! ref $int) {
MyTestHelpers::diag ('skip due to Math::BigInt no "int" operator');
foreach (1 .. $test_count) {
skip ('due to no Math::BigInt int() operator', 1, 1);
}
exit 0;
}
}
# doesn't help sqrt(), slows down blog()
#
# require Math::BigFloat;
# Math::BigFloat->precision(-2000); # digits right of decimal point
#------------------------------------------------------------------------------
# round_nearest()
use Math::PlanePath::Base::Generic
'round_nearest';
ok (round_nearest(Math::BigRat->new('-7/4')) == -2, 1);
ok (round_nearest(Math::BigRat->new('-3/2')) == -1, 1);
ok (round_nearest(Math::BigRat->new('-5/4')) == -1, 1);
ok (round_nearest(Math::BigRat->new('-3/4')) == -1, 1);
ok (round_nearest(Math::BigRat->new('-1/2')) == 0, 1);
ok (round_nearest(Math::BigRat->new('-1/4')) == 0, 1);
ok (round_nearest(Math::BigRat->new('1/4')) == 0, 1);
ok (round_nearest(Math::BigRat->new('5/4')) == 1, 1);
ok (round_nearest(Math::BigRat->new('3/2')) == 2, 1);
ok (round_nearest(Math::BigRat->new('7/4')) == 2, 1);
ok (round_nearest(Math::BigRat->new('2')) == 2, 1);
#------------------------------------------------------------------------------
# floor()
use Math::PlanePath::Base::Generic
'floor';
ok (floor(Math::BigRat->new('-7/4')) == -2, 1);
ok (floor(Math::BigRat->new('-3/2')) == -2, 1);
ok (floor(Math::BigRat->new('-5/4')) == -2, 1);
ok (floor(Math::BigRat->new('-3/4')) == -1, 1);
ok (floor(Math::BigRat->new('-1/2')) == -1, 1);
ok (floor(Math::BigRat->new('-1/4')) == -1, 1);
ok (floor(Math::BigRat->new('1/4')) == 0, 1);
ok (floor(Math::BigRat->new('3/4')) == 0, 1);
ok (floor(Math::BigRat->new('5/4')) == 1, 1);
ok (floor(Math::BigRat->new('3/2')) == 1, 1);
ok (floor(Math::BigRat->new('7/4')) == 1, 1);
ok (floor(Math::BigRat->new('2')) == 2, 1);
#------------------------------------------------------------------------------
# MultipleRings
{
require Math::PlanePath::MultipleRings;
my $width = 5;
my $path = Math::PlanePath::MultipleRings->new (step => 6);
{
my $n = Math::BigRat->new(23);
my ($got_x,$got_y) = $path->n_to_xy($n);
ok (!! (ref $got_x && $got_x->isa('Math::BigFloat')), 1);
ok ($got_x > 0 && $got_x < 1,
1,
"MultipleRings n_to_xy($n) got_x $got_x");
ok ($got_y > 2.5 && $got_y < 3.1,
1,
"MultipleRings n_to_xy($n) got_y $got_y");
}
}
#------------------------------------------------------------------------------
# CoprimeColumns
{
require Math::PlanePath::CoprimeColumns;
my $path = Math::PlanePath::CoprimeColumns->new;
{
my $n = Math::BigRat->new('-2/3');
my @ret = $path->n_to_xy($n);
ok (scalar(@ret), 0);
}
{
my $n = Math::BigRat->new(0);
my $want_x = 1;
my $want_y = 1;
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x == $want_x, 1, "got $got_x want $want_x");
ok ($got_y == $want_y);
my $got_n = $path->xy_to_n($want_x,$want_y);
ok ($got_n == 0, 1);
}
# pending int(-1/2)==0 dodginess
# {
# my $n = Math::BigRat->new('-1/3');
# my $want_x = 1;
# my $want_y = Math::BigRat->new('1/3');
#
# my ($got_x,$got_y) = $path->n_to_xy($n);
# ok ($got_x == $want_x, 1, "got $got_x want $want_x");
# ok ($got_y == $want_y);
#
# my $got_n = $path->xy_to_n($want_x,$want_y);
# ok ($got_n == 0, 1);
# }
{
my $n = Math::BigRat->new('1/2');
my $want_x = 2;
my $want_y = Math::BigRat->new('1/2');
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x == $want_x, 1, "got $got_x want $want_x");
ok ($got_y == $want_y);
my $got_n = $path->xy_to_n($want_x,$want_y);
ok ($got_n == 1, 1);
}
}
#------------------------------------------------------------------------------
# DiagonalRationals
{
require Math::PlanePath::DiagonalRationals;
my $path = Math::PlanePath::DiagonalRationals->new;
{
my $n = Math::BigRat->new('1/3');
my @ret = $path->n_to_xy($n);
ok (scalar(@ret), 0);
}
{
my $n = Math::BigRat->new('1/2');
my $want_x = Math::BigRat->new('1/2');
my $want_y = Math::BigRat->new('3/2');
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x == $want_x, 1,
"DiagonalRationals n_to_xy() n=$n, got X=$got_x want X=$want_x");
ok ($got_y == $want_y, 1,
"DiagonalRationals n_to_xy() n=$n, got Y=$got_y want Y=$want_y");
# my $got_n = $path->xy_to_n($want_x,$want_y);
# ok (defined $got_n && $got_n == 1, 1,
# 'DiagonalRationals xy_to_n($want_x,$want_y) from 1/2');
}
{
#
# | 1+1/2
# | \
# | \
# Y=1 | 1
# | \
# | 1+1/3
# | \
# | 1+1/2-eps
# |
# +---------------
# ^
# X=1
my $n = Math::BigRat->new('4/3');
my $want_x = Math::BigRat->new('4/3');
my $want_y = Math::BigRat->new('2/3');
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x == $want_x, 1,
"DiagonalRationals n_to_xy() from 4/3, X got $got_x want $want_x");
ok ($got_y == $want_y, 1,
"DiagonalRationals n_to_xy() from 4/3, Y got $got_y want $want_y");
my $got_n = $path->xy_to_n($want_x,$want_y);
ok ($got_n == 1, 1, 'DiagonalRationals xy_to_n($want_x,$want_y) from 4/3');
}
}
#------------------------------------------------------------------------------
# Rows
{
require Math::PlanePath::Rows;
my $width = 5;
my $path = Math::PlanePath::Rows->new (width => $width);
{
my $y = Math::BigRat->new(2) ** 128;
my $x = 4;
my $n = $y*$width + $x + 1;
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x == $x, 1, "got $got_x want $x");
ok ($got_y == $y);
my $got_n = $path->xy_to_n($x,$y);
ok ($got_n == $n, 1);
}
{
my $n = Math::BigRat->new('4/3');
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ("$got_x", '1/3');
ok ($got_y == 0, 1);
}
{
my $n = Math::BigRat->new('4/3') + 15;
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ("$got_x", '1/3');
ok ($got_y == 3, 1);
}
{
my $n = Math::BigRat->new('4/3') - 15;
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ("$got_x", '1/3');
ok ($got_y == -3, 1);
}
}
#------------------------------------------------------------------------------
# Diagonals
{
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::Diagonals->new;
{
my $x = Math::BigRat->new(2) ** 128 - 1;
my $n = ($x+1)*($x+2)/2; # triangular numbers on Y=0 horizontal
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x == $x, 1, "got x=$got_x want $x");
ok ($got_y == 0, 1, "got y=$got_y want 0");
my $got_n = $path->xy_to_n($x,0);
ok ($got_n == $n, 1);
}
{
my $x = Math::BigRat->new(2) ** 128 - 1;
my $n = ($x+1)*($x+2)/2; # Y=0 horizontal
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x == $x, 1);
ok ($got_y == 0, 1);
my $got_n = $path->xy_to_n($x,0);
ok ($got_n == $n, 1);
}
{
my $y = Math::BigRat->new(2) ** 128 - 1;
my $n = $y*($y+1)/2 + 1; # X=0 vertical
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x == 0, 1);
ok ($got_y == $y, 1);
my $got_n = $path->xy_to_n(0,$y);
ok ($got_n, $n);
}
{
my $n = Math::BigRat->new(-1);
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x, undef);
ok ($got_y, undef);
}
{
my $n = Math::BigRat->new(0.5);
my ($got_x,$got_y) = $path->n_to_xy($n);
ok (!! $got_x->isa('Math::BigRat'), 1);
ok (!! $got_y->isa('Math::BigRat'), 1);
ok ($got_x == -0.5, 1);
ok ($got_y == 0.5, 1);
}
}
#------------------------------------------------------------------------------
# PeanoCurve
require Math::PlanePath::PeanoCurve;
{
my $path = Math::PlanePath::PeanoCurve->new;
require Math::BigRat;
my $n = Math::BigRat->new(9) ** 128 + Math::BigRat->new('4/3');
my $want_x = Math::BigRat->new(3) ** 128 + Math::BigRat->new('4/3');
my $want_y = Math::BigRat->new(3) ** 128 - 1;
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x, $want_x);
ok ($got_y, $want_y);
}
#------------------------------------------------------------------------------
# ZOrderCurve
require Math::PlanePath::ZOrderCurve;
{
my $path = Math::PlanePath::ZOrderCurve->new;
require Math::BigRat;
my $n = Math::BigRat->new(4) ** 128 + Math::BigRat->new('1/3');
$n->isa('Math::BigRat') || die "Oops, n not a BigRat";
my $want_x = Math::BigRat->new(2) ** 128 + Math::BigRat->new('1/3');
my $want_y = 0;
my ($got_x,$got_y) = $path->n_to_xy($n);
ok ($got_x, $want_x);
ok ($got_y, $want_y);
}
#------------------------------------------------------------------------------
# round_down_pow()
use Math::PlanePath::Base::Digits 'round_down_pow';
{
my $orig = Math::BigRat->new(3) ** 128 + Math::BigRat->new('1/7');
my $n = Math::BigRat->new(3) ** 128 + Math::BigRat->new('1/7');
my ($pow,$exp) = round_down_pow($n,3);
ok ($n, $orig);
ok ($pow, Math::BigRat->new(3) ** 128);
ok ($exp, 128);
}
{
my $orig = Math::BigRat->new(3) ** 128;
my $n = Math::BigRat->new(3) ** 128;
my ($pow,$exp) = round_down_pow($n,3);
ok ($n, $orig);
ok ($pow, Math::BigRat->new(3) ** 128);
ok ($exp, 128);
}
#------------------------------------------------------------------------------
my @modules = (
'HilbertSides',
'HilbertCurve',
'HilbertSpiral',
'WythoffPreliminaryTriangle',
'WythoffArray',
'PowerArray',
'PowerArray,radix=3',
'PowerArray,radix=4',
'AztecDiamondRings', # but not across ring end
'PyramidSpiral',
'CfracDigits,radix=1',
'CfracDigits',
'CfracDigits,radix=3',
'CfracDigits,radix=4',
'CfracDigits,radix=10',
'CfracDigits,radix=37',
'ChanTree',
'ChanTree,k=2',
'ChanTree,k=4',
'ChanTree,k=5',
'ChanTree,k=7',
'ChanTree,reduced=1',
'ChanTree,reduced=1,k=2',
'ChanTree,reduced=1,k=4',
'ChanTree,reduced=1,k=5',
'ChanTree,reduced=1,k=7',
'RationalsTree',
'RationalsTree,tree_type=L',
'RationalsTree,tree_type=HCS',
'FractionsTree',
'DekkingCurve',
'DekkingCentres',
'QuintetCurve',
'QuintetCurve,arms=2',
'QuintetCurve,arms=3',
'QuintetCurve,arms=4',
'QuintetCentres',
'QuintetCentres,arms=2',
'QuintetCentres,arms=3',
'QuintetCentres,arms=4',
'PyramidRows',
'PyramidRows,step=0',
'PyramidRows,step=1',
'PyramidRows,step=3',
'PyramidRows,step=37',
'PyramidRows,align=right',
'PyramidRows,align=right,step=0',
'PyramidRows,align=right,step=1',
'PyramidRows,align=right,step=3',
'PyramidRows,align=right,step=37',
'PyramidRows,align=left',
'PyramidRows,align=left,step=0',
'PyramidRows,align=left,step=1',
'PyramidRows,align=left,step=3',
'PyramidRows,align=left,step=37',
'GreekKeySpiral',
'GreekKeySpiral,turns=0',
'GreekKeySpiral,turns=1',
'GreekKeySpiral,turns=3',
'GreekKeySpiral,turns=4',
'GreekKeySpiral,turns=5',
'GreekKeySpiral,turns=6',
'GreekKeySpiral,turns=7',
'GreekKeySpiral,turns=8',
'GreekKeySpiral,turns=37',
'AlternatePaperMidpoint',
'AlternatePaperMidpoint,arms=2',
'AlternatePaperMidpoint,arms=3',
'AlternatePaperMidpoint,arms=4',
'AlternatePaperMidpoint,arms=5',
'AlternatePaperMidpoint,arms=6',
'AlternatePaperMidpoint,arms=7',
'AlternatePaperMidpoint,arms=8',
'AlternatePaper',
'AlternatePaper,arms=2',
'AlternatePaper,arms=3',
'AlternatePaper,arms=4',
'AlternatePaper,arms=5',
'AlternatePaper,arms=6',
'AlternatePaper,arms=7',
'AlternatePaper,arms=8',
'Diagonals',
'Diagonals,direction=up',
'DiagonalsOctant',
'DiagonalsOctant,direction=up',
'DiagonalsAlternating',
'TerdragonMidpoint',
'TerdragonMidpoint,arms=1',
'TerdragonMidpoint,arms=2',
'TerdragonMidpoint,arms=6',
'TerdragonCurve',
'TerdragonCurve,arms=1',
'TerdragonCurve,arms=2',
'TerdragonCurve,arms=6',
'TerdragonRounded',
'TerdragonRounded,arms=1',
'TerdragonRounded,arms=2',
'TerdragonRounded,arms=6',
'CCurve',
'R5DragonMidpoint',
'R5DragonMidpoint,arms=2',
'R5DragonMidpoint,arms=3',
'R5DragonMidpoint,arms=4',
'R5DragonCurve',
'R5DragonCurve,arms=2',
'R5DragonCurve,arms=3',
'R5DragonCurve,arms=4',
'ImaginaryHalf',
'ImaginaryBase',
'CubicBase',
'GrayCode',
'WunderlichSerpentine',
'WunderlichSerpentine,serpentine_type=100_000_000',
'WunderlichSerpentine,serpentine_type=000_000_001',
'WunderlichSerpentine,radix=2',
'WunderlichSerpentine,radix=4',
'WunderlichSerpentine,radix=5,serpentine_type=coil',
'CretanLabyrinth',
'OctagramSpiral',
'AnvilSpiral',
'AnvilSpiral,wider=1',
'AnvilSpiral,wider=2',
'AnvilSpiral,wider=9',
'AnvilSpiral,wider=17',
'AR2W2Curve',
'AR2W2Curve,start_shape=D2',
'AR2W2Curve,start_shape=B2',
'AR2W2Curve,start_shape=B1rev',
'AR2W2Curve,start_shape=D1rev',
'AR2W2Curve,start_shape=A2rev',
'BetaOmega',
'KochelCurve',
'CincoCurve',
'LTiling',
'LTiling,L_fill=ends',
'LTiling,L_fill=all',
'MPeaks', # but not across gap
'WunderlichMeander',
'FibonacciWordFractal',
# 'CornerReplicate', # not defined yet
'DigitGroups',
'PeanoCurve',
'ZOrderCurve',
'HIndexing',
'SierpinskiCurve',
'SierpinskiCurveStair',
'DiamondArms',
'SquareArms',
'HexArms',
# 'UlamWarburton', # not really defined yet
# 'UlamWarburtonQuarter', # not really defined yet
'CellularRule54', # but not across gap
# 'CellularRule57', # but not across gap
# 'CellularRule57,mirror=1', # but not across gap
'CellularRule190', # but not across gap
'CellularRule190,mirror=1', # but not across gap
'Rows',
'Columns',
'SquareSpiral',
'DiamondSpiral',
'PentSpiral',
'PentSpiralSkewed',
'HexSpiral',
'HexSpiralSkewed',
'HeptSpiralSkewed',
'TriangleSpiral',
'TriangleSpiralSkewed',
'TriangleSpiralSkewed,skew=right',
'TriangleSpiralSkewed,skew=up',
'TriangleSpiralSkewed,skew=down',
# 'SacksSpiral', # sin/cos
# 'TheodorusSpiral', # counting by N
# 'ArchimedeanChords', # counting by N
# 'VogelFloret', # sin/cos
'KnightSpiral',
'SierpinskiArrowheadCentres',
'SierpinskiArrowheadCentres,align=right',
'SierpinskiArrowheadCentres,align=left',
'SierpinskiArrowheadCentres,align=diagonal',
'SierpinskiArrowhead',
'SierpinskiArrowhead,align=right',
'SierpinskiArrowhead,align=left',
'SierpinskiArrowhead,align=diagonal',
# 'SierpinskiTriangle', # fracs not really defined yet
'QuadricCurve',
'QuadricIslands',
'DragonRounded',
'DragonMidpoint',
'DragonCurve',
'KochSquareflakes',
'KochSnowflakes',
'KochCurve',
'KochPeaks',
'FlowsnakeCentres',
'GosperReplicate',
'GosperSide',
'GosperIslands',
'Flowsnake',
# 'DivisibleColumns', # counting by N
# 'DivisibleColumns,divisor_type=proper',
# 'CoprimeColumns', # counting by N
# 'DiagonalRationals',# counting by N
# 'GcdRationals', # counting by N
# 'GcdRationals,pairs_order=rows_reverse',
# 'GcdRationals,pairs_order=diagonals_down',
# 'GcdRationals,pairs_order=diagonals_up',
# 'FactorRationals', # counting by N
# 'TriangularHypot', # counting by N
# 'TriangularHypot,points=odd',
# 'TriangularHypot,points=all',
# 'TriangularHypot,points=hex',
# 'TriangularHypot,points=hex_rotated',
# 'TriangularHypot,points=hex_centred',
'PythagoreanTree',
# 'Hypot', # searching by N
# 'HypotOctant', # searching by N
# 'PixelRings', # searching by N
# 'FilledRings', # searching by N
# 'MultipleRings', # sin/cos, maybe
'QuintetReplicate',
'SquareReplicate',
'ComplexPlus',
'ComplexMinus',
'ComplexRevolving',
# 'File', # not applicable
'Corner',
'PyramidSides',
'Staircase',
'StaircaseAlternating',
'StaircaseAlternating,end_type=square',
);
my @classes = map {"Math::PlanePath::$_"} @modules;
sub module_parse {
my ($mod) = @_;
my ($class, @parameters) = split /,/, $mod;
return ("Math::PlanePath::$class",
map {/(.*?)=(.*)/ or die; ($1 => $2)} @parameters);
}
foreach my $module (@modules) {
### $module
my ($class, %parameters) = module_parse($module);
eval "require $class" or die;
my $path = $class->new (width => 23,
height => 17);
my $arms = $path->arms_count;
my $n = Math::BigRat->new(2) ** 256 + 3;
if ($path->isa('Math::PlanePath::CellularRule190')) {
$n += 1; # not across gap
}
my $frac = Math::BigRat->new('1/3');
my $n_frac = $frac + $n;
my $orig = $n_frac->copy;
my ($x1,$y1) = $path->n_to_xy($n);
### xy1: "$x1,$y1"
my ($x2,$y2) = $path->n_to_xy($n+$arms);
### xy2: "$x2,$y2"
my $dx = $x2 - $x1;
my $dy = $y2 - $y1;
### dxy: "$dx, $dy"
my $want_x = $frac * Math::BigRat->new ($dx) + $x1;
my $want_y = $frac * Math::BigRat->new ($dy) + $y1;
my ($x_frac,$y_frac) = $path->n_to_xy($n_frac);
### xy frac: "$x_frac, $y_frac"
ok ("$x_frac", "$want_x", "$module arms=$arms X frac=$frac dxdy=$dx,$dy arms=$arms");
ok ("$y_frac", "$want_y", "$module arms=$arms Y frac=$frac dxdy=$dx,$dy arms=$arms");
}
exit 0;
Math-PlanePath-122/xt/pod-lists.t 0000644 0001750 0001750 00000015557 12344544606 014462 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Check that the supported fields described in each pod matches what the
# code says.
use 5.005;
use strict;
use FindBin;
use ExtUtils::Manifest;
use List::Util 'max';
use File::Spec;
use Test::More;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# uncomment this to run the ### lines
#use Smart::Comments;
# new in 5.6, so unless got it separately with 5.005
eval { require Pod::Parser }
or plan skip_all => "Pod::Parser not available -- $@";
plan tests => 6;
my $toplevel_dir = File::Spec->catdir ($FindBin::Bin, File::Spec->updir);
my $manifest_file = File::Spec->catfile ($toplevel_dir, 'MANIFEST');
my $manifest = ExtUtils::Manifest::maniread ($manifest_file);
my @lib_modules
= map {m{^lib/Math/PlanePath/([^/]+)\.pm$} ? $1 : ()} keys %$manifest;
@lib_modules = sort @lib_modules;
diag "module count ",scalar(@lib_modules);
#------------------------------------------------------------------------------
{
open FH, 'lib/Math/PlanePath.pm' or die $!;
my $content = do { local $/; }; # slurp
close FH or die;
### $content
{
$content =~ /=for my_pod see_also begin(.*)=for my_pod see_also end/s
or die "see_also not matched";
my $see_also = $1;
my @see_also;
while ($see_also =~ /L]+)>/g) {
push @see_also, $1;
}
@see_also = sort @see_also;
my $s = join(', ',@see_also);
my $l = join(', ',@lib_modules);
is ($s, $l, 'PlanePath.pm pod SEE ALSO');
my $j = "$s\n$l";
$j =~ /^(.*)(.*)\n\1(.*)/ or die;
my $sd = $2;
my $ld = $3;
if ($sd) {
diag "see also: ",$sd;
diag "library: ",$ld;
}
}
{
$content =~ /=for my_pod list begin(.*)=for my_pod list end/s
or die "class list not matched";
my $list = $1;
my @list;
while ($list =~ /^ (\S+)/mg) {
push @list, $1;
}
@list = sort @list;
my $s = join(', ',@list);
my $l = join(', ',@lib_modules);
is ($s, $l, 'PlanePath.pm pod class list');
my $j = "$s\n$l";
$j =~ /^(.*)(.*)\n\1(.*)/ or die;
my $sd = $2;
my $ld = $3;
if ($sd) {
diag "list: ",$sd;
diag "library: ",$ld;
}
}
{
$content =~ /=for my_pod step begin(.*)=for my_pod step end/s
or die "base list not matched";
my $list = $1;
$content =~ /=for my_pod base begin(.*)=for my_pod base end/s
or die "step list not matched";
$list .= $1;
# initialized to exceptions, no "step" in the pod
my @list = ('File',
'Hypot', 'HypotOctant',
'TriangularHypot', 'VogelFloret',
'PythagoreanTree', 'RationalsTree', 'FractionsTree', 'ChanTree',
'FactorRationals', 'GcdRationals', 'CfracDigits',
'WythoffPreliminaryTriangle');
my %seen;
while ($list =~ /([A-Z]\S+)/g) {
my $elem = $1;
next if $elem eq 'Base';
next if $elem eq 'Path';
next if $elem eq 'Step';
next if $elem eq 'Fibonacci';
next if $elem eq 'ToothpickSpiral'; # separate Math-PlanePath-Toothpick
$elem =~ s/,//;
next if $seen{$elem}++;
push @list, $elem;
}
@list = sort @list;
my $s = join(', ',@list);
my $l = join(', ',@lib_modules);
is ($s, $l, 'PlanePath.pm step/base pod lists');
my $j = "$s\n$l";
$j =~ /^(.*)(.*)\n\1(.*)/ or die;
my $sd = $2;
my $ld = $3;
if ($sd) {
diag "list: ",$sd;
diag "library: ",$ld;
}
}
}
#------------------------------------------------------------------------------
foreach my $tfile ('xt/PlanePath-subclasses.t',
'xt/slow/NumSeq-PlanePathCoord.t',
) {
open FH, $tfile or die "$tfile: $!";
my $content = do { local $/; }; # slurp
close FH or die;
### $content
{
$content =~ /# module list begin(.*)module list end/s
or die "module list not matched";
my $list = $1;
my @list;
my %seen;
while ($list =~ /'([A-Z][^',]+)/ig) {
next if $seen{$1}++;
push @list, $1;
}
@list = sort @list;
my $s = join(', ',@list);
my $l = join(', ',@lib_modules);
is ($s, $l, $tfile);
my $j = "$s\n$l";
$j =~ /^(.*)(.*)\n\1(.*)/ or die;
my $sd = $2;
my $ld = $3;
if ($sd) {
diag "t list: ",$sd;
diag "library: ",$ld;
}
}
if ($tfile eq 't/PlanePath-subclasses.t') {
$content =~ /# rect_to_n_range exact begin(.*)# rect_to_n_range exact /s
or die "rect_to_n_range exact not matched";
my $list = $1;
my %exact;
while ($list =~ /^\s*'Math::PlanePath::([A-Z][^']+)/img) {
$exact{$1} = 1;
}
my $good = 1;
foreach my $module (@lib_modules) {
next if $module eq 'Flowsnake'; # inherited
next if $module eq 'QuintetCurve'; # inherited
my $file = module_exact($module);
my $t = $exact{$module} || 0;
if ($file != $t) {
diag "Math::PlanePath::$module file $file t $t";
$good = 0;
}
}
ok ($good,
"$tfile rect exact matches file comments");
sub module_exact {
my ($module) = @_;
my $filename = "lib/Math/PlanePath/$module.pm";
open FH, $filename or die $!;
my $content = do { local $/; }; # slurp
close FH or die;
### $content
$content =~ /^# (not )?exact\n(sub rect_to_n_range |\*rect_to_n_range =)/m
or die "$filename no exact comment";
return $1 ? 0 : 1;
}
}
}
#------------------------------------------------------------------------------
# numbers.pl
{
open FH, 'examples/numbers.pl' or die $!;
my $content = do { local $/; }; # slurp
close FH or die;
### $content
{
$content =~ /my \@all_classes = \((.*)# expand arg "all"/s
or die "module list not matched";
my $list = $1;
my @list = ('File');
my %seen;
while ($list =~ /'([A-Z][^',]+)/ig) {
next if $seen{$1}++;
push @list, $1;
}
@list = sort @list;
my $s = join(', ',@list);
my $l = join(', ',@lib_modules);
is ($s, $l, 'numbers.pl all_classes');
my $j = "$s\n$l";
$j =~ /^(.*)(.*)\n\1(.*)/ or die;
my $sd = $2;
my $ld = $3;
if ($sd) {
diag "numbers.pl list: ",$sd;
diag "library: ",$ld;
}
}
}
exit 0;
Math-PlanePath-122/xt/HIndexing-more.t 0000644 0001750 0001750 00000006021 12377314541 015342 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::HIndexing;
use Test;
plan tests => 35;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# area
sub points_to_area {
my ($points) = @_;
if (@$points < 3) {
return 0;
}
require Math::Geometry::Planar;
my $polygon = Math::Geometry::Planar->new;
$polygon->points($points);
return $polygon->area;
}
{
my $path = Math::PlanePath::HIndexing->new;
foreach my $level (0 .. 10) {
my $a = $path->_UNDOCUMENTED__level_to_area($level);
my $Y = $path->_UNDOCUMENTED__level_to_area_Y($level);
my $up = $path->_UNDOCUMENTED__level_to_area_up($level);
ok ($Y+$up, $a);
}
}
{
my $path = Math::PlanePath::HIndexing->new;
foreach my $level (0 .. 7) {
my $got_area = $path->_UNDOCUMENTED__level_to_area($level);
my @points;
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
my $y_max = 0;
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
push @points, [$x,$y];
if ($y > $y_max) { $y_max = $y; }
}
push @points, [0,$y_max];
my $want_area = points_to_area(\@points);
ok ($got_area, $want_area);
# print "$want_area, ";
}
}
{
my $path = Math::PlanePath::HIndexing->new;
foreach my $level (0 .. 7) {
my $got_area = $path->_UNDOCUMENTED__level_to_area_up($level);
my @points;
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
$n_lo = ($n_hi + 1)/2 - 1;
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
push @points, [$x,$y];
}
my $want_area = points_to_area(\@points);
ok ($got_area, $want_area);
}
}
{
my $path = Math::PlanePath::HIndexing->new;
foreach my $level (0 .. 7) {
my $got_area = $path->_UNDOCUMENTED__level_to_area_Y($level);
my @points;
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
$n_hi = ($n_hi + 1)/2 - 1;
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
push @points, [$x,$y];
}
my $want_area = points_to_area(\@points);
ok ($got_area, $want_area);
}
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/0-file-is-part-of.t 0000644 0001750 0001750 00000006222 12536755447 015576 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2015 Kevin Ryde
# 0-file-is-part-of.t is shared by several distributions.
#
# 0-file-is-part-of.t is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# 0-file-is-part-of.t is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
require 5;
use strict;
use Test::More tests => 1;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
ok (Test::FileIsPartOfDist->check(verbose=>1),
'Test::FileIsPartOfDist');
exit 0;
package Test::FileIsPartOfDist;
BEGIN { require 5 }
use strict;
use ExtUtils::Manifest;
use File::Slurp;
# uncomment this to run the ### lines
# use Smart::Comments;
sub import {
my $class = shift;
my $arg;
foreach $arg (@_) {
if ($arg eq '-test') {
require Test;
Test::plan(tests=>1);
is ($class->check, 1, 'Test::FileIsPartOfDist');
}
}
return 1;
}
sub new {
my $class = shift;
return bless { @_ }, $class;
}
sub check {
my $class = shift;
my $self = $class->new(@_);
my $manifest = ExtUtils::Manifest::maniread();
if (! $manifest) {
$self->diag("no MANIFEST perhaps");
return 0;
}
my @filenames = keys %$manifest;
my $distname = $self->makefile_distname;
if (! defined $distname) {
$self->diag("Oops, DISTNAME not found in Makefile");
return 0;
}
if ($self->{'verbose'}) {
$self->diag("DISTNAME $distname");
}
my $good = 1;
my $filename;
foreach $filename (@filenames) {
if (! $self->check_file_is_part_of($filename,$distname)) {
$good = 0;
}
}
return $good;
}
sub makefile_distname {
my ($self) = @_;
my $filename = "Makefile";
my $content = File::Slurp::read_file ($filename);
if (! defined $content) {
$self->diag("Cannot read $filename: $!");
return undef;
}
my $distname;
if ($content =~ /^DISTNAME\s*=\s*([^#\n]*)/m) {
$distname = $1;
$distname =~ s/\s+$//;
### $distname
if ($distname eq 'App-Chart') { $distname = 'Chart'; } # hack
}
return $distname;
}
sub check_file_is_part_of {
my ($self, $filename, $distname) = @_;
my $content = File::Slurp::read_file ($filename);
if (! defined $content) {
$self->diag("Cannot read $filename: $!");
return 0;
}
$content =~ /([T]his file is part of[^\n]*)/i
or return 1;
my $got = $1;
if ($got =~ /[T]his file is part of \Q$distname\E\b/i) {
return 1;
}
$self->diag("$filename: $got");
$self->diag("expected DISTNAME: $distname");
return 0;
}
sub diag {
my $self = shift;
my $func = $self->{'diag_func'}
|| eval { Test::More->can('diag') }
|| \&_diag;
&$func(@_);
}
sub _diag {
my $msg = join('', map {defined($_)?$_:'[undef]'} @_)."\n";
$msg =~ s/^/# /mg;
print STDERR $msg;
}
Math-PlanePath-122/xt/oeis/ 0002755 0001750 0001750 00000000000 12641645163 013303 5 ustar gg gg Math-PlanePath-122/xt/oeis/Corner-oeis.t 0000644 0001750 0001750 00000015250 12301301163 015634 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 7;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::Corner;
# uncomment this to run the ### lines
#use Smart::Comments;
#------------------------------------------------------------------------------
# A027709 -- unit squares figure boundary
MyOEIS::compare_values
(anum => 'A027709',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Corner->new;
my @got = (0);
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, $path->_NOTDOCUMENTED_n_to_figure_boundary($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A078633 -- grid sticks
{
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
sub path_n_to_dsticks {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy($n);
my $dsticks = 4;
foreach my $i (0 .. $#dir4_to_dx) {
my $an = $path->xy_to_n($x+$dir4_to_dx[$i], $y+$dir4_to_dy[$i]);
$dsticks -= (defined $an && $an < $n);
}
return $dsticks;
}
}
MyOEIS::compare_values
(anum => 'A078633',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Corner->new;
my @got;
my $boundary = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
$boundary += path_n_to_dsticks($path,$n);
push @got, $boundary;
}
return \@got;
});
#------------------------------------------------------------------------------
# A000290 -- N on X axis, perfect squares starting from 1
MyOEIS::compare_values
(anum => 'A000290',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::Corner->new;
for (my $x = 0; @got < $count; $x++) {
push @got, $path->xy_to_n ($x, 0);
}
return \@got;
});
#------------------------------------------------------------------------------
# A002061 -- N on X=Y diagonal, extra initial 1
MyOEIS::compare_values
(anum => 'A002061',
func => sub {
my ($count) = @_;
my @got = (1);
my $path = Math::PlanePath::Corner->new;
for (my $i = 0; @got < $count; $i++) {
push @got, $path->xy_to_n ($i, $i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A060736 -- permutation, N by diagonals down
MyOEIS::compare_values
(anum => 'A060736',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $corner = Math::PlanePath::Corner->new;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy($n);
push @got, $corner->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A064788 -- permutation, inverse of N by diagonals down
MyOEIS::compare_values
(anum => 'A064788',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $corner = Math::PlanePath::Corner->new;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $corner->n_start; @got < $count; $n++) {
my ($x, $y) = $corner->n_to_xy($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A060734 -- permutation, N by diagonals upwards
MyOEIS::compare_values
(anum => 'A060734',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $corner = Math::PlanePath::Corner->new;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy($n);
push @got, $corner->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A064790 -- permutation, inverse of N by diagonals upwards
MyOEIS::compare_values
(anum => 'A064790',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $corner = Math::PlanePath::Corner->new;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $corner->n_start; @got < $count; $n++) {
my ($x, $y) = $corner->n_to_xy($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A004201 -- N for which Y<=X, half below diagonal
MyOEIS::compare_values
(anum => 'A004201',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::Corner->new;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
if ($x >= $y) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A020703 -- permutation transpose Y,X
MyOEIS::compare_values
(anum => 'A020703',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::Corner->new;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A053188 -- abs(X-Y), distance to next higher pronic, wider=1, extra 0
MyOEIS::compare_values
(anum => 'A053188',
func => sub {
my ($count) = @_;
my @got = (0); # extra initial 0
my $path = Math::PlanePath::Corner->new (wider => 1);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, abs($x-$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/CornerReplicate-oeis.t 0000644 0001750 0001750 00000005417 12460527060 017505 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 3;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::CornerReplicate;
use Math::PlanePath::Base::Digits 'bit_split_lowtohigh';
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $crep = Math::PlanePath::CornerReplicate->new;
#------------------------------------------------------------------------------
# A139351 - HammingDist(X,Y) = count 1-bits at even bit positions in N
MyOEIS::compare_values
(name => 'HammingDist(X,Y)',
anum => 'A139351',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
my ($x, $y) = $crep->n_to_xy($n);
push @got, HammingDist($x,$y);
}
return \@got;
});
sub HammingDist {
my ($x,$y) = @_;
my @xbits = bit_split_lowtohigh($x);
my @ybits = bit_split_lowtohigh($y);
my $ret = 0;
while (@xbits || @ybits) {
$ret += (shift @xbits ? 1 : 0) ^ (shift @ybits ? 1 : 0);
}
return $ret;
}
#------------------------------------------------------------------------------
# A048647 -- permutation N at transpose Y,X
MyOEIS::compare_values
(anum => 'A048647',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $crep->n_start; @got < $count; $n++) {
my ($x, $y) = $crep->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $crep->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163241 -- flip base-4 digits 2,3 maps to ZOrderCurve
MyOEIS::compare_values
(anum => 'A163241',
func => sub {
my ($count) = @_;
require Math::PlanePath::ZOrderCurve;
my $zorder = Math::PlanePath::ZOrderCurve->new;
my @got;
for (my $n = $crep->n_start; @got < $count; $n++) {
my ($x, $y) = $crep->n_to_xy ($n);
my $n = $zorder->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/DigitGroups-oeis.t 0000644 0001750 0001750 00000005525 12141661307 016663 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 3;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::DigitGroups;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# parity_bitwise() vs path
# X is low 0111..11 then Y above that, so (X^Y)&1 is
# Parity = lowbit(N) ^ bit_above_lowest_zero(N)
{
my $path = Math::PlanePath::DigitGroups->new;
my $bad = 0;
foreach my $n (0 .. 0xFFFF) {
my ($x, $y) = $path->n_to_xy ($n);
my $path_value = ($x + $y) % 2;
my $a_value = parity_bitwise($n);
if ($path_value != $a_value) {
MyTestHelpers::diag ("diff n=$n path=$path_value acalc=$a_value");
MyTestHelpers::diag (" xy=$x,$y");
last if ++$bad > 10;
}
}
ok ($bad, 0, "parity_bitwise()");
}
sub parity_bitwise {
my ($n) = @_;
return ($n & 1) ^ bit_above_lowest_zero($n);
}
sub bit_above_lowest_zero {
my ($n) = @_;
for (;;) {
if (($n % 2) == 0) {
last;
}
$n = int($n/2);
}
$n = int($n/2);
return ($n % 2);
}
#------------------------------------------------------------------------------
# A084472 - X axis in binary, excluding 0
MyOEIS::compare_values
(anum => 'A084472',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DigitGroups->new;
for (my $x = 1; @got < $count; $x++) {
my $n = $path->xy_to_n ($x,0);
push @got, to_binary($n);
}
return \@got;
});
sub to_binary {
my ($n) = @_;
return ($n < 0 ? '-' : '') . sprintf('%b', abs($n));
}
#------------------------------------------------------------------------------
# A060142 - X axis sorted
MyOEIS::compare_values
(anum => 'A060142',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DigitGroups->new;
for (my $x = 0; @got < 16 * $count; $x++) {
push @got, $path->xy_to_n ($x,0);
}
@got = sort {$a<=>$b} @got;
$#got = $count-1;
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/ComplexMinus-oeis.t 0000644 0001750 0001750 00000007206 12240240414 017034 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 5;
use Math::BigInt try => 'GMP';
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
use Math::PlanePath::ComplexMinus;
my $path = Math::PlanePath::ComplexMinus->new;
#------------------------------------------------------------------------------
# A052537 length A,B or C
# A003476 total boundary length / 2
# A203175 boundary length
MyOEIS::compare_values
(anum => 'A203175',
name => 'boundary length',
func => sub {
my ($count) = @_;
my @got = (1,1,2);
my $a = Math::BigInt->new(2);
my $b = Math::BigInt->new(2);
my $c = Math::BigInt->new(0);
while (@got < $count) {
push @got, ($a+$b+$c);
($a,$b,$c) = abc_step($a,$b,$c);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A003476',
name => 'boundary length / 2',
func => sub {
my ($count) = @_;
my @got = (1);
my $a = Math::BigInt->new(2);
my $b = Math::BigInt->new(2);
my $c = Math::BigInt->new(0);
while (@got < $count) {
push @got, ($a+$b+$c)/2;
($a,$b,$c) = abc_step($a,$b,$c);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A052537',
func => sub {
my ($count) = @_;
my @got = (1,0);
for (my $i = 0; @got < $count; $i++) {
my ($a,$b,$c) = abc_by_pow($i);
push @got, $c;
}
return \@got;
});
sub abc_step {
my ($a,$b,$c) = @_;
return ($a + 2*$c,
$a,
$b);
}
sub abc_by_pow {
my ($k) = @_;
my $zero = $k*0;
my $r = 1;
my $a = $zero + 2*$r;
my $b = $zero + 2;
my $c = $zero + 2*(1-$r);
foreach (1 .. $k) {
($a,$b,$c) = ((2*$r-1)*$a + 0 + 2*$r*$c,
($r*$r-2*$r+2)*$a + 0 + ($r-1)*($r-1)*$c,
0 + $b);
}
return ($a,$b,$c);
}
#------------------------------------------------------------------------------
# A066322 - N on X axis, diffs at 16k+3,16k+4
MyOEIS::compare_values
(anum => 'A066322',
func => sub {
my ($count) = @_;
my @got;
for (my $i = 0; @got < $count; $i++) {
my $x = 16*$i+3;
my $x_next = 16*$i+4;
my $n = $path->xy_to_n ($x,0);
my $n_next = $path->xy_to_n ($x_next,0);
push @got, $n_next - $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A066323 - N on X axis, count 1 bits
MyOEIS::compare_values
(anum => 'A066323',
func => sub {
my ($count) = @_;
my @got = (0);
for (my $x = 1; @got < $count; $x++) {
my $n = $path->xy_to_n ($x,0);
push @got, count_1_bits($n);
}
return \@got;
});
sub count_1_bits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += ($n & 1);
$n >>= 1;
}
return $count;
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/WythoffPreliminaryTriangle-oeis.t 0000644 0001750 0001750 00000004773 12112610147 021751 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
use Test;
plan tests => 46;
use lib 't','xt';
use MyTestHelpers;
MyTestHelpers::nowarnings();
use MyOEIS;
use Math::PlanePath::WythoffPreliminaryTriangle;
#------------------------------------------------------------------------------
# A165359 column 1 of left justified Wythoff, gives preliminary triangle Y
MyOEIS::compare_values
(anum => 'A165359',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffPreliminaryTriangle->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A165360 column 2 of left justified Wythoff, gives preliminary triangle X
MyOEIS::compare_values
(anum => 'A165360',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffPreliminaryTriangle->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A166309 Preliminary Wythoff Triangle, N by rows
MyOEIS::compare_values
(anum => 'A166309',
func => sub {
my ($count) = @_;
require Math::PlanePath::PyramidRows;
my $path = Math::PlanePath::WythoffPreliminaryTriangle->new;
my $rows = Math::PlanePath::PyramidRows->new (step=>1);
my @got;
for (my $r = $rows->n_start; @got < $count; $r++) {
my ($x,$y) = $rows->n_to_xy($r); # by rows
$y += 1;
push @got, $path->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/UlamWarburtonQuarter-oeis.t 0000644 0001750 0001750 00000004050 12376763750 020600 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 6;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::UlamWarburtonQuarter;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A079318 - (3^(count 1-bits) + 1)/2, width of octant row
# extra initial 1 in A079318
foreach my $parts ('octant','octant_up') {
MyOEIS::compare_values
(anum => 'A079318',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::UlamWarburtonQuarter->new(parts=>$parts);
my @got = (1);
for (my $depth = 0; @got < $count; $depth++) {
push @got, $path->tree_depth_to_width($depth);
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A147610 - 3^(count 1-bits), width of parts=1 row
MyOEIS::compare_values
(anum => 'A147610',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::UlamWarburtonQuarter->new;
my @got;
for (my $depth = 0; @got < $count; $depth++) {
push @got, $path->tree_depth_to_width($depth);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/AlternatePaperMidpoint-oeis.t 0000644 0001750 0001750 00000003147 12563464110 021035 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::AlternatePaperMidpoint;
use Test;
plan tests => 11;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A016116 -- X/2 at N=2^k, starting k=1, being 2^floor(k/2)
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
MyOEIS::compare_values
(anum => 'A016116',
max_count => 1000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::AlternatePaperMidpoint->new;
my @got;
for (my $n = $bigclass->new(2); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $x/2;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/HilbertSides-oeis.t 0000644 0001750 0001750 00000003337 12562474627 017021 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Test;
plan tests => 47;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::HilbertSides;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $path = Math::PlanePath::HilbertSides->new;
#------------------------------------------------------------------------------
# A096268 - morphism turn 1=straight,0=not-straight
# but OFFSET=0 is turn at N=1, so "next turn"
MyOEIS::compare_values
(anum => 'A096268',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'HilbertSides',
turn_type => 'Straight');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/KochSnowflakes-oeis.t 0000644 0001750 0001750 00000005045 12253200234 017331 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 2;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::KochSnowflakes;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A178789 - num acute angle turns, 4^n + 2
# A002446 - num obtuse angle turns, 2*4^n - 2
MyOEIS::compare_values
(anum => 'A002446',
max_value => 100_000,
func => sub {
my ($count) = @_;
my @got;
for (my $level = 0; @got < $count; $level++) {
my ($acute, $obtuse) = count_angles_in_level($level);
push @got, $obtuse;
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A178789',
max_value => 100_000,
func => sub {
my ($count) = @_;
my @got;
for (my $level = 0; @got < $count; $level++) {
my ($acute, $obtuse) = count_angles_in_level($level);
push @got, $acute;
}
return \@got;
});
sub count_angles_in_level {
my ($level) = @_;
require Math::NumSeq::PlanePathTurn;
my $path = Math::PlanePath::KochSnowflakes->new;
my $n_level = 4**$level;
my $n_end = 4**($level+1) - 1;
my @x;
my @y;
foreach my $n ($n_level .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
push @x, $x;
push @y, $y;
}
my $acute = 0;
my $obtuse = 0;
foreach my $i (0 .. $#x) {
my $dx = $x[$i-1] - $x[$i-2];
my $dy = $y[$i-1] - $y[$i-2];
my $next_dx = $x[$i] - $x[$i-1];
my $next_dy = $y[$i] - $y[$i-1];
my $tturn6 = Math::NumSeq::PlanePathTurn::_turn_func_TTurn6($dx,$dy, $next_dx,$next_dy);
### $tturn6
if ($tturn6 == 2 || $tturn6 == 4) {
$acute++;
} else {
$obtuse++;
}
}
return ($acute, $obtuse);
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/UlamWarburton-oeis.t 0000644 0001750 0001750 00000012162 12563473016 017226 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 7;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Devel::Comments '###';
use Math::PlanePath::UlamWarburton;
my $path = Math::PlanePath::UlamWarburton->new;
#------------------------------------------------------------------------------
# my @grid;
# my $offset = 30;
# my @n_start;
#
# my $prev = 0;
# $grid[0+$offset][0+$offset] = 0;
# foreach my $n (1 .. 300) {
# my ($x,$y) = $path->n_to_xy($n);
# my $l = $grid[$x+$offset-1][$y+$offset]
# || $grid[$x+$offset+1][$y+$offset]
# || $grid[$x+$offset][$y+$offset-1]
# || $grid[$x+$offset][$y+$offset+1]
# || 0;
# if ($l != $prev) {
# push @n_start, $n;
# $prev = $l;
# }
# $grid[$x+$offset][$y+$offset] = $l+1;
# }
# ### @n_start
# my @n_end = map {$_-1} @n_start;
# ### @n_end
#
# my @levelcells = (1, map {$n_start[$_]-$n_start[$_-1]} 1 .. $#n_start);
# ### @levelcells
# foreach my $y (reverse -$offset .. $offset) {
# foreach my $x (-$offset .. $offset) {
# my $c = $grid[$x+$offset][$y+$offset];
# if (! defined $c) { $c = ' '; }
# print $c;
# }
# print "\n";
# }
#------------------------------------------------------------------------------
# A183060 - count total cells in half plane, including axes
MyOEIS::compare_values
(anum => 'A183060',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::UlamWarburton->new (parts => '2',
n_start => 0);
my @got;
for (my $depth = 0; @got < $count; $depth++) {
push @got, $path->tree_depth_to_n($depth);
}
return \@got;
});
# added
MyOEIS::compare_values
(anum => 'A183061',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::UlamWarburton->new (parts => '2');
my @got = (0);
for (my $depth = 0; @got < $count; $depth++) {
push @got, $path->tree_depth_to_width($depth);
}
return \@got;
});
#------------------------------------------------------------------------------
# A151922 - count total cells in first quadrant, incl X,Y axes
MyOEIS::compare_values
(anum => 'A151922',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::UlamWarburton->new (parts => '1');
my @got;
for (my $depth = 0; @got < $count; $depth++) {
push @got, $path->tree_depth_to_n_end($depth);
}
return \@got;
});
# added
MyOEIS::compare_values
(anum => 'A079314',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::UlamWarburton->new (parts => '1');
my @got;
for (my $depth = 0; @got < $count; $depth++) {
push @got, $path->tree_depth_to_width($depth);
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A151922},
func => sub {
my ($count) = @_;
my @got;
my $n = $path->n_start;
my $total = 0;
for (my $depth = 0; @got < $count; $depth++) {
my $n_end = $path->tree_depth_to_n_end($depth);
for ( ; $n <= $n_end; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($x >= 0 && $y >= 0) {
$total++;
}
}
push @got, $total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A079314 - count added cells in first quadrant, incl X,Y axes
# is added(depth)/4 + 1, the +1 being for two axes
#
MyOEIS::compare_values
(anum => 'A079314',
func => sub {
my ($count) = @_;
my @got;
my $n = $path->n_start;
for (my $depth = 0; @got < $count; $depth++) {
my $n_end = $path->tree_depth_to_n_end($depth);
my $added = 0;
for ( ; $n <= $n_end; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($x >= 0 && $y >= 0) {
$added++;
}
}
push @got, $added;
}
return \@got;
});
#------------------------------------------------------------------------------
# A147582 - count new cells in each level
MyOEIS::compare_values
(anum => 'A147582',
func => sub {
my ($count) = @_;
my @got;
my $prev = $path->tree_depth_to_n(0);
for (my $depth = 1; @got < $count; $depth++) {
my $n = $path->tree_depth_to_n($depth);
push @got, $n - $prev;
$prev = $n;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/KnightSpiral-oeis.t 0000644 0001750 0001750 00000007350 12136177300 017017 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 8;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
use Math::PlanePath::KnightSpiral;
use Math::PlanePath::SquareSpiral;
my $knight = Math::PlanePath::KnightSpiral->new;
my $square = Math::PlanePath::SquareSpiral->new;
#------------------------------------------------------------------------------
# A068608 - N values in square spiral order, same first step
MyOEIS::compare_values
(anum => 'A068608',
func => sub {
my ($count) = @_;
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $knight->n_to_xy ($n);
push @got, $square->xy_to_n ($x, $y);
}
return \@got;
});
# A068609 - rotate 90 degrees
MyOEIS::compare_values
(anum => 'A068609',
func => sub {
my ($count) = @_;
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $knight->n_to_xy ($n);
### knight: "$n $x,$y"
($x, $y) = (-$y, $x);
push @got, $square->xy_to_n ($x, $y);
### rotated: "$x,$y"
### is: "got[$#got] = $got[-1]"
}
return \@got;
});
# A068610 - rotate 180 degrees
MyOEIS::compare_values
(anum => 'A068610',
func => sub {
my ($count) = @_;
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $knight->n_to_xy ($n);
($x, $y) = (-$x, -$y);
push @got, $square->xy_to_n ($x, $y);
}
return \@got;
});
# A068611 - rotate 270 degrees
MyOEIS::compare_values
(anum => 'A068611',
func => sub {
my ($count) = @_;
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $knight->n_to_xy ($n);
($x, $y) = ($y, -$x);
push @got, $square->xy_to_n ($x, $y);
}
return \@got;
});
# A068612 - rotate 180 degrees, opp direction, being X negated
MyOEIS::compare_values
(anum => 'A068612',
func => sub {
my ($count) = @_;
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $knight->n_to_xy ($n);
$x = -$x;
push @got, $square->xy_to_n ($x, $y);
}
return \@got;
});
# A068613 -
MyOEIS::compare_values
(anum => 'A068613',
func => sub {
my ($count) = @_;
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $knight->n_to_xy ($n);
($x, $y) = (-$y, -$x);
push @got, $square->xy_to_n ($x, $y);
}
return \@got;
});
# A068614 - clockwise, Y negated
MyOEIS::compare_values
(anum => 'A068614',
func => sub {
my ($count) = @_;
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $knight->n_to_xy ($n);
$y = -$y;
push @got, $square->xy_to_n ($x, $y);
}
return \@got;
});
# A068615 - transpose
MyOEIS::compare_values
(anum => 'A068615',
func => sub {
my ($count) = @_;
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $knight->n_to_xy ($n);
($y, $x) = ($x, $y);
push @got, $square->xy_to_n ($x, $y);
}
return \@got;
});
exit 0;
Math-PlanePath-122/xt/oeis/DragonCurve-oeis.t 0000644 0001750 0001750 00000041746 12465550055 016655 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 23;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::DragonCurve;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $dragon = Math::PlanePath::DragonCurve->new;
#------------------------------------------------------------------------------
# A099545 -- relative direction 1=left, 3=right
MyOEIS::compare_values
(anum => 'A099545',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Right');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value ? 3 : 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A003476 Daykin and Tucker alpha[n]
# = squares on right boundary, OFFSET=1 values 1, 2, 3, 5
# = single points N=0 to N=2^(k-1) inclusive, with initial 1 for k=-1 one point
#
# *
# |
# *---* *---*
#
# k=0 k=1
# singles=2 singles=3
#
#
MyOEIS::compare_values
(anum => 'A003476',
max_value => 10000,
func => sub {
my ($count) = @_;
my @got = (1);
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_n_to_singles ($dragon, 2**$k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A121238 - -1 power something is 1=left,-1=right, extra initial 1
# A088585
# A088575
# A088567 a(0)=1, a(1)=1;
# for m >= 1, a(2m) = a(2m-1) + a(m) - 1,
# a(2m+1) = a(2m) + 1
# A090678 = A088567 mod 2.
MyOEIS::compare_values
(anum => 'A121238',
func => sub {
my ($count) = @_;
my @got = (1);
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value ? 1 : -1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A166242 - turn cumulative doubling/halving, is 2^(total turn)
MyOEIS::compare_values
(anum => 'A166242',
func => sub {
my ($count) = @_;
my @got = (1);
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
my $cumulative = 1;
while (@got < $count) {
my ($i, $value) = $seq->next;
if ($value) {
$cumulative *= 2;
} else {
$cumulative /= 2;
}
push @got, $cumulative;
}
return \@got;
});
#------------------------------------------------------------------------------
# A112347 - Kronecker -1/n is 1=left,-1=right, extra initial 0
MyOEIS::compare_values
(anum => 'A112347',
func => sub {
my ($count) = @_;
my @got = (0);
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value ? 1 : -1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A088748 - dragon cumulative turn +/-1
MyOEIS::compare_values
(anum => 'A088748',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
my $cumulative = 1;
while (@got < $count) {
push @got, $cumulative;
my ($i, $value) = $seq->next;
if ($value) {
$cumulative += 1; # left
} else {
$cumulative -= 1; # right
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A014710 -- relative direction 2=left, 1=right
MyOEIS::compare_values
(anum => 'A014710',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value+1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A014709 -- relative direction 1=left, 2=right
MyOEIS::compare_values
(anum => 'A014709',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Right');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value+1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A014577 -- relative direction 1=left, 0=right, starting from 1
#
# cf A059125 is almost but not quite the same, the 8,24,or some such entries
# differ
MyOEIS::compare_values
(anum => 'A014577',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A014707 -- relative direction 0=left, 1=right, starting from 1
MyOEIS::compare_values
(anum => 'A014707',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Right');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A088431 - dragon turns run lengths
MyOEIS::compare_values
(anum => 'A088431',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Right');
my ($i, $prev) = $seq->next;
my $run = 1; # count for initial $prev_turn
while (@got < $count) {
my ($i, $value) = $seq->next;
if ($value == $prev) {
$run++;
} else {
push @got, $run;
$run = 1; # count for new $turn value
}
$prev = $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A007400 - 2 * run lengths, extra initial 0,1
MyOEIS::compare_values
(anum => 'A007400',
func => sub {
my ($count) = @_;
my @got = (0,1);
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Right');
my ($i, $prev) = $seq->next;
my $run = 1; # count for initial $prev_turn
while (@got < $count) {
my ($i, $value) = $seq->next;
if ($value == $prev) {
$run++;
} else {
push @got, 2 * $run;
$run = 1; # count for new $turn value
}
$prev = $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A003460 -- turn 1=left,0=right packed as octal high to low, in 2^n levels
MyOEIS::compare_values
(anum => 'A003460',
func => sub {
my ($count) = @_;
my @got;
require Math::BigInt;
my $bits = Math::BigInt->new(0);
my $target_n_level = 2;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
for (my $n = 1; @got < $count; $n++) {
if ($n >= $target_n_level) { # not including n=2^level point itself
my $octal = $bits->as_oct; # new enough Math::BigInt
$octal =~ s/^0+//; # strip leading "0"
push @got, Math::BigInt->new("$octal");
$target_n_level *= 2;
}
my ($i, $value) = $seq->next;
$bits = 2*$bits + $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A082410 -- complement reversal, is turn 1=left, 0=right
MyOEIS::compare_values
(anum => 'A082410',
func => sub {
my ($count) = @_;
my @got = (0);
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value; # 1=left,0=right
}
return \@got;
});
#------------------------------------------------------------------------------
# A164910 - dragon cumulative turn +/-1, partial sums of that cumulative
MyOEIS::compare_values
(anum => 'A164910',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
my $cumulative = 1;
my $partial_sum = $cumulative;
while (@got < $count) {
push @got, $partial_sum;
my ($i, $value) = $seq->next;
if ($value) {
$cumulative += 1;
} else {
$cumulative -= 1;
}
$partial_sum += $cumulative;
}
return \@got;
});
#------------------------------------------------------------------------------
# A005811 -- total rotation, count runs of bits in binary
MyOEIS::compare_values
(anum => 'A005811',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
my $cumulative = 0;
while (@got < $count) {
push @got, $cumulative;
my ($i, $value) = $seq->next;
if ($value) {
$cumulative += 1;
} else {
$cumulative -= 1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A091072 -- N positions of left turns
MyOEIS::compare_values
(anum => 'A091072',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object=>$dragon,
turn_type => 'Left');
while (@got < $count) {
my ($i, $value) = $seq->next;
if ($value) {
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A126937 -- points numbered as SquareSpiral, starting N=0
MyOEIS::compare_values
(anum => 'A126937',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $square = Math::PlanePath::SquareSpiral->new (n_start => 0);
my @got;
for (my $n = $dragon->n_start; @got < $count; $n++) {
my ($x, $y) = $dragon->n_to_xy ($n);
my $square_n = $square->xy_to_n ($x, -$y);
push @got, $square_n;
}
return \@got;
});
#------------------------------------------------------------------------------
# Ba2 boundary of arms=2 around whole of level k
# *
# |
# 3 5---* 4 * *---*---*
# | | | | | | |
# o---2 o---* *---* o---*
# len=4 k=2 len=8 k=3 len=14
#
MyOEIS::compare_values
(anum => 'A052537',
max_value => 100,
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DragonCurve->new (arms => 2);
my $k = 0;
my $prev = MyOEIS::path_boundary_length ($path, 2*2**$k + 1);
for ($k++; @got < 5; $k++) {
my $len = MyOEIS::path_boundary_length ($path, 2*2**$k + 1);
my $diff = $len - $prev;
push @got, $prev;
$prev = $len;
}
return \@got;
});
#------------------------------------------------------------------------------
# A077949 join area increments, ie. first differences
MyOEIS::compare_values
(anum => 'A077949',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
my $prev = 0;
for (my $k = 3; @got < $count; $k++) {
my $join_area = $dragon->_UNDOCUMENTED_level_to_enclosed_area_join($k);
push @got, $join_area - $prev;
$prev = $join_area;
}
return \@got;
});
# A003479 join area
MyOEIS::compare_values
(anum => 'A003479',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 3; @got < $count; $k++) {
push @got, $dragon->_UNDOCUMENTED_level_to_enclosed_area_join($k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A003478 enclosed area increment, ie. first differences
MyOEIS::compare_values
(anum => 'A003478',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
my $prev_area = 0;
for (my $k = 4; @got < $count; $k++) {
my $area = MyOEIS::path_enclosed_area ($dragon, 2**$k);
push @got, $area - $prev_area;
$prev_area = $area;
}
return \@got;
});
#------------------------------------------------------------------------------
# A003230 enclosed area to N <= 2^k
MyOEIS::compare_values
(anum => 'A003230',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 4; @got < $count; $k++) {
push @got, MyOEIS::path_enclosed_area ($dragon, 2**$k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A164395 single points N=0 to N=2^k-1 inclusive, for k=4 up
# is count binary with no substrings equal to 0001 or 0101
MyOEIS::compare_values
(anum => 'A164395',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 4; @got < $count; $k++) {
push @got, MyOEIS::path_n_to_singles ($dragon, 2**$k - 1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A227036 boundary length N <= 2^k
MyOEIS::compare_values
(anum => 'A227036',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($dragon, 2**$k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A038189 -- bit above lowest 1, is 0=left,1=right
MyOEIS::compare_values
(anum => 'A038189',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'DragonCurve',
turn_type => 'Right');
my @got = (0); # extra initial 0
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
# A089013=A038189 but initial extra 1
MyOEIS::compare_values
(anum => 'A089013',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'DragonCurve',
turn_type => 'Right');
my @got = (1); # extra initial 1
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/CellularRule190-oeis.t 0000644 0001750 0001750 00000006172 12136177302 017250 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 4;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::CellularRule190;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A071039 - 0/1 by rows rule 190
MyOEIS::compare_values
(anum => 'A071039',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule190->new;
my @got;
my $x = 0;
my $y = 0;
while (@got < $count) {
push @got, ($path->xy_is_visited($x,$y) ? 1 : 0);
$x++;
if ($x > $y) {
$y++;
$x = -$y;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A118111 - 0/1 by rows rule 190 (duplicate)
MyOEIS::compare_values
(anum => 'A118111',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule190->new;
my @got;
my $x = 0;
my $y = 0;
while (@got < $count) {
push @got, ($path->xy_is_visited($x,$y) ? 1 : 0);
$x++;
if ($x > $y) {
$y++;
$x = -$y;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A037576 - rows as rule 190 binary bignums (base 4 periodic ...)
MyOEIS::compare_values
(anum => 'A037576',
func => sub {
my ($count) = @_;
require Math::BigInt;
my $path = Math::PlanePath::CellularRule190->new;
my @got;
my $y = 0;
while (@got < $count) {
my $b = 0;
foreach my $i (0 .. 2*$y+1) {
if ($path->xy_is_visited ($y-$i, $y)) {
$b += Math::BigInt->new(2) ** $i;
}
}
push @got, "$b";
$y++;
}
return \@got;
});
#------------------------------------------------------------------------------
# A071041 - 0/1 rule 246
MyOEIS::compare_values
(anum => 'A071041',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule190->new (mirror => 1);
my @got;
my $x = 0;
my $y = 0;
while (@got < $count) {
push @got, ($path->xy_is_visited($x,$y) ? 1 : 0);
$x++;
if ($x > $y) {
$y++;
$x = -$y;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/LTiling-oeis.t 0000644 0001750 0001750 00000005103 12563472057 015767 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 1;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::LTiling;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A112539 -- X+Y mod 2
MyOEIS::compare_values
(anum => 'A112539',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::LTiling->new (L_fill => 'left');
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, ($x+$y)%2;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A112539},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::LTiling->new (L_fill => 'upper');
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, ($x+$y)%2;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A112539},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::LTiling->new (L_fill => 'middle');
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, ($x+$y+1)%2;
}
return \@got;
});
#------------------------------------------------------------------------------
# A048647 -- N at transpose Y,X
MyOEIS::compare_values
(anum => 'A048647',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::LTiling->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/Flowsnake-oeis.t 0000644 0001750 0001750 00000004001 12561502027 016337 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 11;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::Flowsnake;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $path = Math::PlanePath::Flowsnake->new;
#------------------------------------------------------------------------------
# A229214 - direction 1,2,3,-1,-2,-3
#
# *---*---*
# \ \ /
# *---* *---*
# /
# *---*
# 1, 2, -1, 3, 1, 1
{
my %dxdy_to_dirpn3 = ('2,0' => 1, # 3 2
'1,1' => 2, # \ /
'-1,1' => 3, # -1 ---*--- 1
'-2,0' => -1, # / \
'-1,-1' => -2, # -2 -3
'1,-1' => -3);
MyOEIS::compare_values
(anum => 'A229214',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n);
my $dir = $dxdy_to_dirpn3{"$dx,$dy"};
die if ! defined $dir;
push @got, $dir;
}
return \@got;
});
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/NumSeq-PlanePath-oeis.t 0000644 0001750 0001750 00000027500 12564212205 017500 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Check PlanePathCoord etc sequences against OEIS data.
#
use 5.004;
use strict;
use Test;
plan tests => 1;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments '###';
sub want_anum {
my ($anum) = @_;
# return 0 unless $anum =~ /A246960/;
# return 0 unless $anum =~ /A151922|A183060/;
# return 0 unless $anum =~ /A177702|A102283|A131756/;
return 1;
}
sub want_planepath {
my ($planepath) = @_;
return 0 unless $planepath =~ /Gray/;
# return 0 unless $planepath =~ /Octag|Pent|Hept/;
# return 0 unless $planepath =~ /Divis|DiagonalRationals|CoprimeCol/;
# return 0 unless $planepath =~ /DiamondSpiral/;
# return 0 unless $planepath =~ /Coprime/;
# return 0 unless $planepath =~ /LCorn|RationalsTree/;
# return 0 unless $planepath =~ /^Corner$/i;
# return 0 unless $planepath =~ /SierpinskiArrowheadC/;
# return 0 unless $planepath =~ /TriangleSpiralSkewed/;
# return 0 unless $planepath =~ /^Rows/;
# return 0 unless $planepath =~ /DiagonalRationals/;
# return 0 unless $planepath =~ /Hilbert/;
return 1;
}
sub want_coordinate {
my ($type) = @_;
return 0 unless $type =~ /BitXor/;
# return 0 unless $type =~ /^Abs[XY]/;
# return 0 unless $type =~ /DiffYX/i;
# return 0 unless $type =~ /^Depth/;
# return 0 unless $type =~ /SLR|SRL|LSR/;
return 1;
}
#------------------------------------------------------------------------------
# use POSIX ();
# use constant DBL_INT_MAX => (POSIX::FLT_RADIX() ** POSIX::DBL_MANT_DIG());
# use constant MY_MAX => (POSIX::FLT_RADIX() ** (POSIX::DBL_MANT_DIG()-5));
sub _delete_duplicates {
my ($arrayref) = @_;
my %seen;
@seen{@$arrayref} = ();
@$arrayref = sort {$a<=>$b} keys %seen;
}
sub _min {
my $ret = shift;
while (@_) {
my $next = shift;
if ($ret > $next) {
$ret = $next;
}
}
return $ret;
}
sub _max {
my $ret = shift;
while (@_) {
my $next = shift;
if ($next > $ret) {
$ret = $next;
}
}
return $ret;
}
my %duplicate_anum = (A021015 => 'A010680',
A081274 => 'A038764',
);
#------------------------------------------------------------------------------
my $good = 1;
my $total_checks = 0;
sub check_class {
my ($anum, $class, $parameters) = @_;
### check_class() ...
### $class
### $parameters
my %parameters = @$parameters;
# return unless $class =~ /PlanePathTurn/;
# return unless $parameters{'planepath'} =~ /DiagonalRat/i;
# return unless $parameters{'planepath'} =~ /AlternateP/;
# return unless $parameters{'planepath'} =~ /Peano/;
# return unless $parameters{'planepath'} =~ /PyramidRows/;
# return unless $parameters{'planepath'} =~ /Fib/;
# return unless $parameters{'planepath'} =~ /TriangleSpiralSkewed/;
return unless want_anum($anum);
return unless want_planepath($parameters{'planepath'}
|| '');
return unless want_coordinate($parameters{'coordinate_type'}
|| $parameters{'delta_type'}
|| $parameters{'line_type'}
|| $parameters{'turn_type'}
|| '');
eval "require $class" or die;
my $name = join(',',
$class,
map {defined $_ ? $_ : '[undef]'} @$parameters);
my $max_count = undef;
if ($anum eq 'A038567'
|| $anum eq 'A038566'
|| $anum eq 'A020652'
|| $anum eq 'A020653') {
# CoprimeColumns, DiagonalRationals shortened for now
$max_count = 10000;
} elsif ($anum eq 'A051132') {
# Hypot
$max_count = 1000;
} elsif ($anum eq 'A173027') {
# WythoffPreiminaryTriangle
$max_count = 3000;
}
my ($want, $want_i_start) = MyOEIS::read_values ($anum,
max_count => $max_count)
or do {
MyTestHelpers::diag("skip $anum $name, no file data");
return;
};
### read_values len: scalar(@$want)
### $want_i_start
if ($anum eq 'A009003') {
# PythagoreanHypots slow, only first 250 values for now ...
splice @$want, 250;
} elsif ($anum eq 'A003434') {
# TotientSteps slow, only first 250 values for now ...
splice @$want, 250;
} elsif ($anum eq 'A005408') { # odd numbers
# shorten for CellularRule rule=84 etc
splice @$want, 500;
}
my $want_count = scalar(@$want);
MyTestHelpers::diag ("$anum $name ($want_count values to $want->[-1])");
my $hi = $want->[-1];
if ($hi < @$want) {
$hi = @$want;
}
### $hi
# hi => $hi
my $seq = $class->new (@$parameters);
### seq class: ref $seq
if ($seq->isa('Math::NumSeq::OEIS::File')) {
die "Oops, not meant to exercies $seq";
}
{
### $seq
my $got_anum = $seq->oeis_anum;
if (! defined $got_anum) {
$got_anum = 'undef';
}
my $want_anum = $duplicate_anum{$anum} || $anum;
if ($got_anum ne $want_anum) {
$good = 0;
MyTestHelpers::diag ("bad: $name");
MyTestHelpers::diag ("got anum $got_anum");
MyTestHelpers::diag ("want anum $want_anum");
MyTestHelpers::diag (ref $seq);
}
}
{
my $got_i_start = $seq->i_start;
if (! defined $want_i_start) {
MyTestHelpers::diag ("skip i_start check: \"stripped\" values only");
} elsif ($got_i_start != $want_i_start
&& $anum ne 'A000004' # offset=0, but allow other i_start here
&& $anum ne 'A000012' # offset=0, but allow other i_start here
) {
$good = 0;
MyTestHelpers::diag ("bad: $name");
MyTestHelpers::diag ("got i_start ",$got_i_start);
MyTestHelpers::diag ("want i_start ",$want_i_start);
}
}
{
### by next() ...
my @got;
my $got = \@got;
while (my ($i, $value) = $seq->next) {
push @got, $value;
if (@got >= @$want) {
last;
}
}
my $diff = MyOEIS::diff_nums($got, $want);
if (defined $diff) {
$good = 0;
MyTestHelpers::diag ("bad: $name by next() hi=$hi");
MyTestHelpers::diag ($diff);
MyTestHelpers::diag (ref $seq);
MyTestHelpers::diag ("got len ".scalar(@$got));
MyTestHelpers::diag ("want len ".scalar(@$want));
if ($#$got > 200) { $#$got = 200 }
if ($#$want > 200) { $#$want = 200 }
MyTestHelpers::diag ("got ". join(',', map {defined() ? $_ : 'undef'} @$got));
MyTestHelpers::diag ("want ". join(',', map {defined() ? $_ : 'undef'} @$want));
}
}
{
### by next() after rewind ...
$seq->rewind;
my @got;
my $got = \@got;
while (my ($i, $value) = $seq->next) {
# ### $i
# ### $value
push @got, $value;
if (@got >= @$want) {
last;
}
}
my $diff = MyOEIS::diff_nums($got, $want);
if (defined $diff) {
$good = 0;
MyTestHelpers::diag ("bad: $name by rewind next() hi=$hi");
MyTestHelpers::diag ($diff);
MyTestHelpers::diag (ref $seq);
MyTestHelpers::diag ("got len ".scalar(@$got));
MyTestHelpers::diag ("want len ".scalar(@$want));
if ($#$got > 200) { $#$got = 200 }
if ($#$want > 200) { $#$want = 200 }
MyTestHelpers::diag ("got ". join(',', map {defined() ? $_ : 'undef'} @$got));
MyTestHelpers::diag ("want ". join(',', map {defined() ? $_ : 'undef'} @$want));
}
}
{
### by pred() ...
$seq->can('pred')
or next;
if ($seq->characteristic('count')) {
### no pred on characteristic(count) ..
next;
}
if (! $seq->characteristic('increasing')) {
### no pred on not characteristic(increasing) ..
next;
}
if ($seq->characteristic('digits')) {
### no pred on characteristic(digits) ..
next;
}
if ($seq->characteristic('modulus')) {
### no pred on characteristic(modulus) ..
next;
}
if ($seq->characteristic('pn1')) {
### no pred on characteristic(pn1) ..
next;
}
$hi = 0;
foreach my $want (@$want) {
if ($want > $hi) { $hi = $want }
}
if ($hi > 1000) {
$hi = 1000;
$want = [ grep {$_<=$hi} @$want ];
}
_delete_duplicates($want);
#### $want
my @got;
foreach my $value (_min(@$want) .. $hi) {
#### $value
if ($seq->pred($value)) {
push @got, $value;
}
}
my $got = \@got;
my $diff = MyOEIS::diff_nums($got, $want);
if (defined $diff) {
$good = 0;
MyTestHelpers::diag ("bad: $name by pred() hi=$hi");
MyTestHelpers::diag ($diff);
MyTestHelpers::diag (ref $seq);
MyTestHelpers::diag ("got len ".scalar(@$got));
MyTestHelpers::diag ("want len ".scalar(@$want));
if ($#$got > 200) { $#$got = 200 }
if ($#$want > 200) { $#$want = 200 }
MyTestHelpers::diag ("got ". join(',', map {defined() ? $_ : 'undef'} @$got));
MyTestHelpers::diag ("want ". join(',', map {defined() ? $_ : 'undef'} @$want));
}
{
my $data_min = _min(@$want);
my $values_min = $seq->values_min;
if (defined $values_min && $values_min != $data_min) {
$good = 0;
MyTestHelpers::diag ("bad: $name values_min $values_min but data min $data_min");
}
}
{
my $data_max = _max(@$want);
my $values_max = $seq->values_max;
if (defined $values_max && $values_max != $data_max) {
$good = 0;
MyTestHelpers::diag ("bad: $name values_max $values_max not seen in data, only $data_max");
}
}
}
$total_checks++;
}
#------------------------------------------------------------------------------
# extras
# check_class ('A059906', # ZOrderCurve second bit
# 'Math::NumSeq::PlanePathCoord',
# [ planepath => 'CornerReplicate',
# coordinate_type => 'Y' ]);
# exit 0;
#------------------------------------------------------------------------------
# OEIS-Other vs files
MyTestHelpers::diag ("\"Other\" uncatalogued sequences:");
{
system("perl ../ns/tools/make-oeis-catalogue.pl --module=TempOther --other=only") == 0
or die;
require 'lib/Math/NumSeq/OEIS/Catalogue/Plugin/TempOther.pm';
unlink 'lib/Math/NumSeq/OEIS/Catalogue/Plugin/TempOther.pm' or die;
my $aref = Math::NumSeq::OEIS::Catalogue::Plugin::TempOther::info_arrayref();
foreach my $info (@$aref) {
### $info
check_class ($info->{'anum'},
$info->{'class'},
$info->{'parameters'});
}
MyTestHelpers::diag ("");
}
#------------------------------------------------------------------------------
# OEIS-Catalogue generated vs files
MyTestHelpers::diag ("Catalogue sequences:");
{
require Math::NumSeq::OEIS::Catalogue::Plugin::PlanePath;
my $aref = Math::NumSeq::OEIS::Catalogue::Plugin::PlanePath->info_arrayref();
{
require Math::NumSeq::OEIS::Catalogue::Plugin::PlanePathToothpick;
my $aref2 = Math::NumSeq::OEIS::Catalogue::Plugin::PlanePathToothpick->info_arrayref();
$aref = [ @$aref, @$aref2 ];
}
MyTestHelpers::diag ("total catalogue entries ",scalar(@$aref));
foreach my $info (@$aref) {
### $info
check_class ($info->{'anum'},
$info->{'class'},
$info->{'parameters'});
}
}
MyTestHelpers::diag ("total checks $total_checks");
ok ($good);
exit 0;
Math-PlanePath-122/xt/oeis/SierpinskiArrowhead-oeis.t 0000644 0001750 0001750 00000005771 12136177277 020417 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 14;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::SierpinskiCurve;
use Math::NumSeq::PlanePathTurn;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A189706 - turn sequence odd positions
MyOEIS::compare_values
(anum => 'A189706',
func => sub {
my ($count) = @_;
my $seq = Math::NumSeq::PlanePathTurn->new
(planepath => 'SierpinskiArrowhead',
turn_type => 'Right');
my @got;
for (my $i = 1; @got < $count; $i+=2) {
push @got, $seq->ith($i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A189707 - (N+1)/2 of positions of odd N left turns
MyOEIS::compare_values
(anum => 'A189707',
func => sub {
my ($count) = @_;
my $seq = Math::NumSeq::PlanePathTurn->new
(planepath => 'SierpinskiArrowhead',
turn_type => 'Left');
my @got;
for (my $i = 1; @got < $count; $i+=2) {
my $left = $seq->ith($i);
if ($left) {
push @got, ($i+1)/2;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A189708 - (N+1)/2 of positions of odd N right turns
MyOEIS::compare_values
(anum => 'A189708',
func => sub {
my ($count) = @_;
my $seq = Math::NumSeq::PlanePathTurn->new
(planepath => 'SierpinskiArrowhead',
turn_type => 'Right');
my @got;
for (my $i = 1; @got < $count; $i+=2) {
my $right = $seq->ith($i);
if ($right) {
push @got, ($i+1)/2;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A156595 - turn sequence even positions
MyOEIS::compare_values
(anum => 'A156595',
func => sub {
my ($count) = @_;
my $seq = Math::NumSeq::PlanePathTurn->new
(planepath => 'SierpinskiArrowhead',
turn_type => 'Right');
my @got;
for (my $i = 2; @got < $count; $i+=2) {
push @got, $seq->ith($i);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/DiagonalsAlternating-oeis.t 0000644 0001750 0001750 00000011242 12563466035 020517 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 8;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::DiagonalsAlternating;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A056011 -- permutation N at points by Diagonals,direction=up order
MyOEIS::compare_values
(anum => 'A056011',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DiagonalsAlternating->new;
my $diag = Math::PlanePath::Diagonals->new (direction => 'up');
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x, $y) = $diag->n_to_xy ($n);
push @got, $path->xy_to_n ($x,$y);
}
return \@got;
});
# is self-inverse
MyOEIS::compare_values
(anum => q{A056011},
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::Diagonals->new (direction => 'up');
my $diag = Math::PlanePath::DiagonalsAlternating->new;
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x, $y) = $diag->n_to_xy ($n);
push @got, $path->xy_to_n ($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A056023 -- permutation N at points by Diagonals,direction=up order
MyOEIS::compare_values
(anum => 'A056023',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DiagonalsAlternating->new;
my $diag = Math::PlanePath::Diagonals->new (direction => 'down');
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x, $y) = $diag->n_to_xy ($n);
push @got, $path->xy_to_n ($x,$y);
}
return \@got;
});
# is self-inverse
MyOEIS::compare_values
(anum => q{A056023},
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::Diagonals->new (direction => 'down');
my $diag = Math::PlanePath::DiagonalsAlternating->new;
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x, $y) = $diag->n_to_xy ($n);
push @got, $path->xy_to_n ($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A038722 -- permutation N at transpose Y,X n_start=1
MyOEIS::compare_values
(anum => 'A038722',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DiagonalsAlternating->new;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A061579 -- permutation N at transpose Y,X
MyOEIS::compare_values
(anum => 'A061579',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DiagonalsAlternating->new (n_start => 0);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A131179 -- X axis, extra 0
MyOEIS::compare_values
(anum => 'A131179',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::DiagonalsAlternating->new;
for (my $x = 0; @got < $count; $x++) {
push @got, $path->xy_to_n ($x, 0);
}
return \@got;
});
#------------------------------------------------------------------------------
# A128918 -- Y axis, extra 0
MyOEIS::compare_values
(anum => 'A128918',
func => sub {
my ($count) = @_;
my @got = (1);
my $path = Math::PlanePath::DiagonalsAlternating->new;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n (0, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/DiagonalsOctant-oeis.t 0000644 0001750 0001750 00000020421 12400213365 017460 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::BigInt;
use Math::PlanePath::DiagonalsOctant;
use Test;
plan tests => 12;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A079826 -- concat of rows numbers in diagonals octant order
# rows numbered alternately left and right
MyOEIS::compare_values
(anum => q{A079826}, # not xreffed
max_count => 10, # various dodginess from a(11)=785753403227
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::PyramidRows;
require Math::BigInt;
my $diag = Math::PlanePath::DiagonalsOctant->new;
my $rows = Math::PlanePath::PyramidRows->new(step=>1);
my $prev_d = 0;
my $str = '';
for (my $n = Math::BigInt->new($diag->n_start); @got < $count; $n++) {
my ($x,$y) = $diag->n_to_xy($n);
my $d = $x+$y;
if ($d != $prev_d) {
push @got, Math::BigInt->new($str);
$str = '';
$prev_d = $d;
}
if ($y % 2) {
$x = $y-$x;
}
my $rn = $rows->xy_to_n($x,$y);
if ($rn >= 73) { $rn -= 2; }
if ($rn >= 99) { $rn -= 2; }
if ($rn >= 129) { $rn -= 2; }
$str .= $rn;
}
return \@got;
});
# foreach my $y (0 .. 21) {
# foreach my $x (0 .. $y) {
# # if ($x+$y > 11) {
# # print "...";
# # last;
# # }
# my $n = $rows->xy_to_n(($y % 2 ? $y-$x : $x), $y);
# printf "%4d", $n;
# }
# print "\n";
# }
#------------------------------------------------------------------------------
# A014616 -- N in column X=1
MyOEIS::compare_values
(anum => 'A014616',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DiagonalsOctant->new (direction => 'up',
n_start => 0);
for (my $y = 1; @got < $count; $y++) {
push @got, $path->xy_to_n (1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A079823 -- concat of rows numbers in diagonals octant order
MyOEIS::compare_values
(anum => q{A079823}, # not xreffed
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::PyramidRows;
my $diag = Math::PlanePath::DiagonalsOctant->new;
my $rows = Math::PlanePath::PyramidRows->new(step=>1);
my $prev_d = 0;
my $str = '';
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x,$y) = $diag->n_to_xy($n);
my $d = $x+$y;
if ($d != $prev_d) {
push @got, $str;
$str = '';
$prev_d = $d;
}
$str .= $rows->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A091018 -- permutation diagonals octant -> rows, 0 based
MyOEIS::compare_values
(anum => 'A091018',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::PyramidRows;
my $diag = Math::PlanePath::DiagonalsOctant->new;
my $rows = Math::PlanePath::PyramidRows->new(step=>1);
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x,$y) = $diag->n_to_xy($n);
push @got, $rows->xy_to_n($x,$y) - 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A090894 -- permutation diagonals octant -> rows, 0 based, upwards
MyOEIS::compare_values
(anum => 'A090894',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::PyramidRows;
my $diag = Math::PlanePath::DiagonalsOctant->new(direction=>'up');
my $rows = Math::PlanePath::PyramidRows->new(step=>1);
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x,$y) = $diag->n_to_xy($n);
push @got, $rows->xy_to_n($x,$y) - 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A091995 -- permutation diagonals octant -> rows, 1 based, upwards
MyOEIS::compare_values
(anum => 'A091995',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::PyramidRows;
my $diag = Math::PlanePath::DiagonalsOctant->new(direction=>'up');
my $rows = Math::PlanePath::PyramidRows->new(step=>1);
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x,$y) = $diag->n_to_xy($n);
push @got, $rows->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A056536 -- permutation diagonals octant -> rows
MyOEIS::compare_values
(anum => 'A056536',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::PyramidRows;
my $diag = Math::PlanePath::DiagonalsOctant->new;
my $rows = Math::PlanePath::PyramidRows->new(step=>1);
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x,$y) = $diag->n_to_xy($n);
push @got, $rows->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A056537 -- permutation rows -> diagonals octant
MyOEIS::compare_values
(anum => 'A056537',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::PyramidRows;
my $diag = Math::PlanePath::DiagonalsOctant->new;
my $rows = Math::PlanePath::PyramidRows->new(step=>1);
for (my $n = $rows->n_start; @got < $count; $n++) {
my ($x,$y) = $rows->n_to_xy($n);
push @got, $diag->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A004652 -- N start,end of even diagonals
MyOEIS::compare_values
(anum => 'A004652',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::DiagonalsOctant->new;
for (my $y = 0; @got < $count; $y += 2) {
push @got, $path->xy_to_n (0,$y);
last unless @got < $count;
push @got, $path->xy_to_n ($y/2,$y/2);
}
return \@got;
});
#------------------------------------------------------------------------------
# A002620 -- N end each diagonal, extra initial 0s
MyOEIS::compare_values
(anum => 'A002620',
func => sub {
my ($count) = @_;
my @got = (0,0);
my $path = Math::PlanePath::DiagonalsOctant->new;
for (my $x = 0; @got < $count; $x++) {
push @got, $path->xy_to_n ($x,$x);
last unless @got < $count;
push @got, $path->xy_to_n ($x,$x+1);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A002620',
func => sub {
my ($count) = @_;
my @got = (0,0);
my $path = Math::PlanePath::DiagonalsOctant->new (direction => 'up');
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n (0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A092180 -- primes in rows, traversed by DiagonalOctant
MyOEIS::compare_values
(anum => q{A092180}, # not cross-reffed in docs
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::PyramidRows;
my $diag = Math::PlanePath::DiagonalsOctant->new(direction=>'up');
my $rows = Math::PlanePath::PyramidRows->new(step=>1);
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x,$y) = $diag->n_to_xy($n);
push @got, MyOEIS::ith_prime($rows->xy_to_n($x,$y));
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/ImaginaryBase-oeis.t 0000644 0001750 0001750 00000010105 12206030357 017121 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 4;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::ImaginaryBase;
use Math::PlanePath::Diagonals;
use Math::PlanePath::Base::Digits
'bit_split_lowtohigh';
# uncomment this to run the ### lines
# use Smart::Comments '###';
#------------------------------------------------------------------------------
# A057300 -- N at transpose Y,X, radix=2
MyOEIS::compare_values
(anum => 'A057300',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::ImaginaryBase->new;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163327 -- N at transpose Y,X, radix=3
MyOEIS::compare_values
(anum => 'A163327',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::ImaginaryBase->new (radix => 3);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A126006 -- N at transpose Y,X, radix=4
MyOEIS::compare_values
(anum => 'A126006',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::ImaginaryBase->new (radix => 4);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A217558 -- N at transpose Y,X, radix=16
MyOEIS::compare_values
(anum => 'A217558',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::ImaginaryBase->new (radix => 16);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A039724 -- negabinary positives -> index, written in binary
MyOEIS::compare_values
(anum => q{A039724},
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::ZOrderCurve;
my $path = Math::PlanePath::ImaginaryBase->new;
my $zorder = Math::PlanePath::ZOrderCurve->new;
for (my $nega = 0; @got < $count; $nega++) {
my $n = $path->xy_to_n ($nega,0);
$n = delete_odd_bits($n);
push @got, to_binary($n);
}
return \@got;
});
sub delete_odd_bits {
my ($n) = @_;
my @bits = bit_split_lowtohigh($n);
my $bit = 1;
my $ret = 0;
while (@bits) {
if (shift @bits) {
$ret |= $bit;
}
shift @bits;
$bit <<= 1;
}
return $ret;
}
# or by string ...
# if (length($str) & 1) { $str = "0$str" }
# $str =~ s/.(.)/$1/g;
sub to_binary {
my ($n) = @_;
return ($n < 0 ? '-' : '') . sprintf('%b', abs($n));
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/DiagonalRationals-oeis.t 0000644 0001750 0001750 00000010261 12136177302 020010 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 5;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::DiagonalRationals;
my $diagrat = Math::PlanePath::DiagonalRationals->new;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A038567 -- X+Y except no 0/1 in path
MyOEIS::compare_values
(anum => 'A038567',
max_count => 10000,
func => sub {
my ($count) = @_;
my @got = (1);
for (my $n = $diagrat->n_start; @got < $count; $n++) {
my ($x, $y) = $diagrat->n_to_xy ($n);
push @got, $x+$y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A054430 -- N at transpose Y,X
MyOEIS::compare_values
(anum => 'A054430',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $diagrat->n_start; @got < $count; $n++) {
my ($x, $y) = $diagrat->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $diagrat->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A054431 - by anti-diagonals 1 if coprime, 0 if not
MyOEIS::compare_values
(anum => 'A054431',
func => sub {
my ($count) = @_;
my @got;
my $prev_n = $diagrat->n_start - 1;
OUTER: for (my $y = 1; ; $y ++) {
foreach my $x (1 .. $y-1) {
my $n = $diagrat->xy_to_n($x,$y-$x);
if (defined $n) {
push @got, 1;
if ($n != $prev_n + 1) {
die "oops, not n+1";
}
$prev_n = $n;
} else {
push @got, 0;
}
last OUTER if @got >= $count;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A054424 - permutation diagonal N -> SB N
# A054426 - inverse SB N -> Cantor N
MyOEIS::compare_values
(anum => 'A054424',
func => sub {
my ($count) = @_;
require Math::PlanePath::RationalsTree;
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got;
foreach my $n (1 .. $count) {
my ($x,$y) = $diagrat->n_to_xy ($n);
push @got, $sb->xy_to_n($x,$y);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A054426',
func => sub {
my ($count) = @_;
require Math::PlanePath::RationalsTree;
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got;
foreach my $n (1 .. $count) {
my ($x,$y) = $sb->n_to_xy ($n);
push @got, $diagrat->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054425 - A054424 mapping expanded out to 0s at common-factor X,Y
MyOEIS::compare_values
(anum => 'A054425',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
require Math::PlanePath::RationalsTree;
my $diag = Math::PlanePath::Diagonals->new (x_start=>1, y_start=>1);
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got;
for (my $n = $diag->n_start; @got < $count; $n++) {
my ($x,$y) = $diag->n_to_xy($n);
### frac: "$x/$y"
my $cn = $diagrat->xy_to_n ($x,$y);
if (defined $cn) {
push @got, $sb->xy_to_n($x,$y);
} else {
push @got, 0;
}
}
return \@got;
});
exit 0;
Math-PlanePath-122/xt/oeis/TheodorusSpiral-oeis.t 0000644 0001750 0001750 00000006211 12136177277 017557 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 8;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::TheodorusSpiral;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A172164 -- differences of loop lengths
MyOEIS::compare_values
(anum => 'A172164',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TheodorusSpiral->new;
my $n = $path->n_start + 1;
my ($prev_x, $prev_y) = $path->n_to_xy ($n);
my $prev_n = 1;
my $prev_looplen = 0;
my $first = 1;
for ($n++; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
if ($y > 0 && $prev_y < 0) {
my $looplen = $n-$prev_n;
if ($first) {
$first = 0;
} else {
push @got, $looplen - $prev_looplen;
}
$prev_n = $n;
$prev_looplen = $looplen;
}
($prev_x, $prev_y) = ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A137515 -- right triangles in n turns
# 16, 53, 109, 185, 280, 395, 531, 685, 860, 1054, 1268, 1502, 1756,
MyOEIS::compare_values
(anum => 'A137515',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TheodorusSpiral->new;
my $n = $path->n_start + 1;
my ($prev_x, $prev_y) = $path->n_to_xy ($n);
for ($n++; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
if ($y > 0 && $prev_y < 0) {
push @got, $n-2;
}
($prev_x, $prev_y) = ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A072895 -- points to complete n revolutions
# 17, 54, 110, 186, 281, 396, 532, 686, 861, 1055, 1269, 1503, 1757,
MyOEIS::compare_values
(anum => 'A072895',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TheodorusSpiral->new;
my $n = $path->n_start + 2;
my ($prev_x, $prev_y) = $path->n_to_xy ($n);
for ($n++; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
if ($y >= 0 && $prev_y <= 0) {
push @got, $n-1;
}
($prev_x, $prev_y) = ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/CellularRule54-oeis.t 0000644 0001750 0001750 00000004061 12611251201 017147 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 2;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Devel::Comments '###';
use Math::PlanePath::CellularRule54;
my $path = Math::PlanePath::CellularRule54->new;
#------------------------------------------------------------------------------
# A118109 - 0/1 by rows
MyOEIS::compare_values
(anum => 'A118109',
func => sub {
my ($count) = @_;
my @got;
my $x = 0;
my $y = 0;
foreach my $n (1 .. $count) {
push @got, ($path->xy_is_visited($x,$y) ? 1 : 0);
$x++;
if ($x > $y) {
$y++;
$x = -$y;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A118108 - rows as bignum bits in decimal
MyOEIS::compare_values
(anum => 'A118108',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got;
my $y = 0;
foreach my $n (1 .. $count) {
my $b = 0;
foreach my $i (0 .. 2*$y+1) {
if ($path->xy_to_n ($y-$i, $y)) {
$b += Math::BigInt->new(2) ** $i;
}
}
push @got, "$b";
$y++;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/RationalsTree-oeis.t 0000644 0001750 0001750 00000074521 12337766115 017213 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# cf A152975/A152976 redundant Stern-Brocot
# inserting mediants to make ternary tree
use 5.004;
use strict;
use Test;
plan tests => 49;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::RationalsTree;
# uncomment this to run the ### lines
#use Smart::Comments '###';
sub gcd {
my ($x, $y) = @_;
#### _gcd(): "$x,$y"
if ($y > $x) {
$y %= $x;
}
for (;;) {
if ($y <= 1) {
return ($y == 0 ? $x : 1);
}
($x,$y) = ($y, $x % $y);
}
}
#------------------------------------------------------------------------------
# A044051 N+1 of those N where SB and CW gives same X,Y
# being binary palindromes below high 1-bit
MyOEIS::compare_values
(anum => 'A044051',
func => sub {
my ($count) = @_;
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my $cw = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got = (1);
for (my $n = $sb->n_start; @got < $count; $n++) {
my ($x1,$y1) = $sb->n_to_xy($n) or die;
my ($x2,$y2) = $cw->n_to_xy($n) or die;
if ($x1 == $x2 && $y1 == $y2) {
push @got, $n + 1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A008776 total X+Y across row, 2*3^depth
MyOEIS::compare_values
(anum => 'A008776',
max_count => 14,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new;
my @got;
require Math::BigInt;
for (my $depth = 0; @got < $count; $depth++) {
my ($n_lo, $n_hi) = $path->tree_depth_to_n_range($depth);
my $total = 0;
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy ($n);
$total += $x + $y;
}
push @got, $total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A000975 -- 010101 without consecutive equal bits, Bird tree X=1 column
MyOEIS::compare_values
(anum => 'A000975',
max_count => 100,
name => "Bird column X=1",
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'Bird');
my @got = (0); # extra initial 0 in A000975
require Math::BigInt;
for (my $y = Math::BigInt->new(1); @got < $count; $y++) {
push @got, $path->xy_to_n (1, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A061547 -- 010101 without consecutive equal bits, Drib tree X=1 column
# Y/1 in Drib, extra initial 0 in A061547
MyOEIS::compare_values
(anum => 'A061547',
max_count => 100,
name => "Drib column X=1",
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'Drib');
my @got = (0); # extra initial 0 in A061547
for (my $y = Math::BigInt->new(1); @got < $count; $y++) {
push @got, $path->xy_to_n (1, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A086893 -- Drib tree Y=1 row
MyOEIS::compare_values
(anum => 'A086893',
max_count => 100,
name => "Drib row Y=1",
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'Drib');
my @got;
require Math::BigInt;
for (my $x = Math::BigInt->new(1); @got < $count; $x++) {
push @got, $path->xy_to_n ($x, 1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A229742 -- HCS numerators
# 0, 1, 2, 1, 3, 3, 1, 2, 4, 5, 4, 5, 1, 2, 3, 3, 5, 7, 7, 8, 5, 7, 7, 8,
MyOEIS::compare_values
(anum => 'A229742',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my @got = (0); # extra initial 0/1
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A071766 -- HCS denominators
# 1, 1, 1, 2, 1, ...
MyOEIS::compare_values
(anum => 'A071766',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my @got = (1); # extra initial 1/1
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A071585 -- HCS num+den
# 1, 2, 3, 3, 4, ...
MyOEIS::compare_values
(anum => 'A071585',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my @got = (1); # extra initial 1/1 then Rat+1
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x+$y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A154435 -- permutation HCS->Bird, lamplighter
MyOEIS::compare_values
(anum => 'A154435',
func => sub {
my ($count) = @_;
my $hcs = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my $bird = Math::PlanePath::RationalsTree->new (tree_type => 'Bird');
my @got = (0); # initial 0
for (my $n = $hcs->n_start; @got < $count; $n++) {
my ($x, $y) = $hcs->n_to_xy($n);
push @got, $bird->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A154436 -- permutation Bird->HCS, lamplighter inverse
MyOEIS::compare_values
(anum => 'A154436',
func => sub {
my ($count) = @_;
my $hcs = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my $bird = Math::PlanePath::RationalsTree->new (tree_type => 'Bird');
my @got = (0); # initial 0
for (my $n = $bird->n_start; @got < $count; $n++) {
my ($x, $y) = $bird->n_to_xy($n);
push @got, $hcs->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A059893 -- bit-reversal permutation
# CW<->SB
MyOEIS::compare_values
(anum => 'A059893',
func => sub {
my ($count) = @_;
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my $cw = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got;
for (my $n = $cw->n_start; @got < $count; $n++) {
my ($x, $y) = $cw->n_to_xy($n);
push @got, $sb->xy_to_n($x,$y);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A059893',
func => sub {
my ($count) = @_;
my @got;
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my $cw = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
for (my $n = $sb->n_start; @got < $count; $n++) {
my ($x, $y) = $sb->n_to_xy($n);
push @got, $cw->xy_to_n($x,$y);
}
return \@got;
});
# Drib<->Bird
MyOEIS::compare_values
(anum => 'A059893',
func => sub {
my ($count) = @_;
my $bird = Math::PlanePath::RationalsTree->new (tree_type => 'Bird');
my $drib = Math::PlanePath::RationalsTree->new (tree_type => 'Drib');
my @got;
for (my $n = $drib->n_start; @got < $count; $n++) {
my ($x, $y) = $drib->n_to_xy($n);
push @got, $bird->xy_to_n($x,$y);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A059893',
func => sub {
my ($count) = @_;
my @got;
my $bird = Math::PlanePath::RationalsTree->new (tree_type => 'Bird');
my $drib = Math::PlanePath::RationalsTree->new (tree_type => 'Drib');
for (my $n = $bird->n_start; @got < $count; $n++) {
my ($x, $y) = $bird->n_to_xy($n);
push @got, $drib->xy_to_n($x,$y);
}
return \@got;
});
# AYT<->HCS
MyOEIS::compare_values
(anum => 'A059893',
func => sub {
my ($count) = @_;
my $hcs = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my $ayt = Math::PlanePath::RationalsTree->new (tree_type => 'AYT');
my @got;
for (my $n = $ayt->n_start; @got < $count; $n++) {
my ($x, $y) = $ayt->n_to_xy($n);
push @got, $hcs->xy_to_n($x,$y);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A059893',
func => sub {
my ($count) = @_;
my @got;
my $hcs = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my $ayt = Math::PlanePath::RationalsTree->new (tree_type => 'AYT');
for (my $n = $hcs->n_start; @got < $count; $n++) {
my ($x, $y) = $hcs->n_to_xy($n);
push @got, $ayt->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A047270 -- 3or5 mod 6, is CW positions of X>Y not both odd
MyOEIS::compare_values
(anum => 'A047270',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
if (xy_is_pythagorean($x,$y)) {
push @got, $n;
}
}
return \@got;
});
sub xy_is_pythagorean {
my ($x,$y) = @_;
return ($x>$y && ($x%2)!=($y%2));
}
#------------------------------------------------------------------------------
# A057431 -- SB num then den, initial 0/1, 1/0 too
MyOEIS::compare_values
(anum => 'A057431',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got = (0,1, 1,0);
for (my $n = $path->n_start; ; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
last if @got >= $count;
push @got, $x;
last if @got >= $count;
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A104106 AYT 2*N Left -- not quite
# a(1) = 1
# if A(k) = sequence of first 2^k -1 terms, then
# A(k+1) = A(k), 1, A(k) if a(k) = 0
# A(k+1) = A(k), 0, A(k) if a(k) = 1
# A104106 ,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,1,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,0,1,1,1,0,1,0,1,
# sub A104106_func {
# my ($n) = @_;
# my @array;
# $array[1] = 1;
# my $k = 1; # initially 2^1-1 = 2-1 = 1 term
# while ($#array < $n) {
# my $last = $#array;
# push @array,
# $array[$k] ? 0 : 1,
# @array[1 .. $last]; # array slice
# # print "\n$k array ",join(',',@array[1..$#array]),"\n";
# $k++;
# }
# return $array[$n];
# }
# print "A104106_func: ";
# foreach my $i (1 .. 20) {
# print A104106_func($i),",";
# }
# print "\n";
#
# {
# require Math::NumSeq::PlanePathTurn;
# my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'RationalsTree,tree_type=AYT',
# turn_type => 'Left');
# print "seq: ";
# foreach my $i (1 .. 20) {
# print $seq->ith(2*$i),",";
# }
# print "\n";
#
# foreach my $k (1 .. 100) {
# my $i = 2*$k;
# my $s = $seq->ith($i);
# my $a = A104106_func($k+10);
# my $diff = ($s != $a ? ' ***' : '');
# print "$i $s $a$diff\n";
# }
# }
#------------------------------------------------------------------------------
# HCS num=A071585 den=A071766
# A010060 is 1=right or straight, 0=left
# straight only at i=2 1,1, 2,1, 3,1
{
require Math::NumSeq::OEIS::File;
require Math::NumberCruncher;
require Math::BaseCnv;
my $num = Math::NumSeq::OEIS::File->new(anum=>'A071585'); # OFFSET=0
my $den = Math::NumSeq::OEIS::File->new(anum=>'A071766'); # OFFSET=0
my $seq_A010060 = Math::NumSeq::OEIS->new(anum=>'A010060');
(undef, my $n1) = $num->next;
(undef, my $n2) = $num->next;
(undef, my $d1) = $den->next;
(undef, my $d2) = $den->next;
# $n1 += $d1; $n2 += $d2;
my $count = 0;
for (;;) {
(my $i, my $n3) = $num->next or last;
(undef, my $d3) = $den->next;
# Clockwise() positive for clockwise=right, negative for anti=left
my $turn = Math::NumberCruncher::Clockwise($n1,$d1, $n2,$d2, $n3,$d3);
if ($turn > 0) { $turn = 1; } # 1=right
elsif ($turn < 0) { $turn = 0; } # 0=left, 1=right
else { $turn = 1;
MyTestHelpers::diag ("straight i=$i $n1,$d1, $n2,$d2, $n3,$d3");
}
# print "$turn,"; next;
my $turn_by_A010060 = $seq_A010060->ith($i); # n of third of triplet
if ($turn != $turn_by_A010060) {
die "oops, wrong at i=$i";
}
# if (is_pow2($i)) { print "\n"; }
# my $i2 = Math::BaseCnv::cnv($i,10,2);
# printf "%2s %5s %2s,%-2s %d %d\n", $i,$i2, $n3,$d3, $turn, $turn_by_A010060;
$n1 = $n2; $n2 = $n3;
$d1 = $d2; $d2 = $d3;
$count++;
}
MyTestHelpers::diag ("HCS OEIS vs A010060 count $count");
ok (1,1);
}
#------------------------------------------------------------------------------
# A010060 -- HCS turn right is (-1)^count1bits of N+1, Thue-Morse +/-1
# OFFSET=0, extra initial n=0,1,2 then n=3 is N=2
MyOEIS::compare_values
(anum => 'A010060',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'RationalsTree,tree_type=HCS',
turn_type => 'Right');
my @got = (0,1,1);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
# A106400 -- HCS left +/-1 thue-morse parity, OFFSET=0
MyOEIS::compare_values
(anum => 'A106400',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'RationalsTree,tree_type=HCS',
turn_type => 'Left');
my @got = (1,-1,-1);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, 2*$value-1;
}
return \@got;
});
# +/-1 OFFSET=1, extra initial n=1,n=2 then n=3 is N=2
MyOEIS::compare_values
(anum => 'A108784',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'RationalsTree,tree_type=HCS',
turn_type => 'Right');
my @got = (1,1);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, 2*$value-1;
}
return \@got;
});
# A010059 -- HCS Left, count0bits mod 2 of N+1
MyOEIS::compare_values
(anum => 'A010059',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'RationalsTree,tree_type=HCS',
turn_type => 'Left');
my @got = (1,0,0);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A070990 -- CW Y-X is Stern diatomic first diffs, starting from N=2
MyOEIS::compare_values
(anum => 'A070990',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got;
for (my $n = $path->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y - $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A007814 -- CW floor(X/Y) is count trailing 1-bits
# A007814 count trailing 0-bits is same, at N+1
MyOEIS::compare_values
(anum => 'A007814',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, int($x/$y);
}
return \@got;
});
# A007814 -- AYT floor(X/Y) is count trailing 0-bits,
# except at N=2^k where 1 fewer
MyOEIS::compare_values
(anum => 'A007814',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'AYT');
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
my $i = int($x/$y);
if (is_pow2($n)) {
$i--;
}
push @got, $i;
}
return \@got;
});
sub is_pow2 {
my ($n) = @_;
while ($n > 1) {
if ($n & 1) {
return 0;
}
$n >>= 1;
}
return ($n == 1);
}
#------------------------------------------------------------------------------
# A004442 -- AYT N at transpose Y,X, flip low bit
MyOEIS::compare_values
(anum => 'A004442',
func => sub {
my ($count) = @_;
my @got = (1,0);
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'AYT');
for (my $n = 2; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A063946 -- HCS N at transpose Y,X, flip second lowest bit
MyOEIS::compare_values
(anum => 'A063946',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054429 -- N at transpose Y,X, row right to left
foreach my $tree_type ('SB','CW','Bird','Drib') {
MyOEIS::compare_values
(anum => 'A054429',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::RationalsTree->new (tree_type => $tree_type);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A072030 - subtraction steps for gcd(x,y) by triangle rows
MyOEIS::compare_values
(anum => q{A072030},
func => sub {
my ($count) = @_;
require Math::PlanePath::PyramidRows;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my $triangle = Math::PlanePath::PyramidRows->new (step => 1);
my @got;
for (my $n = $triangle->n_start; @got < $count; $n++) {
my ($x,$y) = $triangle->n_to_xy ($n);
next unless $x < $y; # so skipping GCD(x,x)==x taking 0 steps
$x++;
$y++;
my $gcd = gcd($x,$y);
$x /= $gcd;
$y /= $gcd;
my $n = $path->xy_to_n($x,$y);
die unless defined $n;
my $depth = $path->tree_n_to_depth($n);
push @got, $depth;
}
return \@got;
});
#------------------------------------------------------------------------------
# A072031 - row sums of A072030 subtraction steps for gcd(x,y) by rows
MyOEIS::compare_values
(anum => q{A072031},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new(tree_type => 'SB');
my @got;
for (my $y = 2; @got < $count; $y++) {
my $total = -1; # gcd(1,Y) taking 0 steps, maybe
for (my $x = 1; $x < $y; $x++) {
my $gcd = gcd($x,$y);
my $n = $path->xy_to_n($x/$gcd,$y/$gcd);
die unless defined $n;
$total += $path->tree_n_to_depth($n);
}
push @got, $total+1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A003188 -- permutation SB->HCS, Gray code shift+xor
MyOEIS::compare_values
(anum => 'A003188',
func => sub {
my ($count) = @_;
my $hcs = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got = (0); # initial 0
for (my $n = $sb->n_start; @got < $count; $n++) {
my ($x, $y) = $sb->n_to_xy($n);
push @got, $hcs->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A006068 -- permutation HCS->SB, Gray code inverse
MyOEIS::compare_values
(anum => 'A006068',
func => sub {
my ($count) = @_;
my $hcs = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got = (0); # initial 0
for (my $n = $hcs->n_start; @got < $count; $n++) {
my ($x, $y) = $hcs->n_to_xy($n);
push @got, $sb->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# Stern diatomic A002487
# A002487 -- L denominators, L doesn't have initial 0,1 of diatomic
MyOEIS::compare_values
(anum => 'A002487',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'L');
my @got = (0,1);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y;
}
return \@got;
});
# A002487 -- CW numerators, is Stern diatomic
MyOEIS::compare_values
(anum => 'A002487',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got = (0);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x;
}
return \@got;
});
# A002487 -- CW denominators are Stern diatomic
MyOEIS::compare_values
(anum => 'A002487',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got = (0,1); # extra initial
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A153153 -- permutation CW->AYT
MyOEIS::compare_values
(anum => 'A153153',
func => sub {
my ($count) = @_;
my $ayt = Math::PlanePath::RationalsTree->new (tree_type => 'AYT');
my $cw = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got = (0); # initial 0
for (my $n = $cw->n_start; @got < $count; $n++) {
my ($x, $y) = $cw->n_to_xy($n);
push @got, $ayt->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A153154 -- permutation AYT->CW
MyOEIS::compare_values
(anum => 'A153154',
func => sub {
my ($count) = @_;
my $ayt = Math::PlanePath::RationalsTree->new (tree_type => 'AYT');
my $cw = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got = (0); # initial 0
for (my $n = $ayt->n_start; @got < $count; $n++) {
my ($x, $y) = $ayt->n_to_xy($n);
push @got, $cw->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A154437 -- permutation AYT->Drib
MyOEIS::compare_values
(anum => 'A154437',
func => sub {
my ($count) = @_;
my $drib = Math::PlanePath::RationalsTree->new (tree_type => 'Drib');
my $ayt = Math::PlanePath::RationalsTree->new (tree_type => 'AYT');
my @got = (0); # initial 0
for (my $n = $ayt->n_start; @got < $count; $n++) {
my ($x, $y) = $ayt->n_to_xy($n);
push @got, $drib->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A154438 -- permutation Drib->AYT
MyOEIS::compare_values
(anum => 'A154438',
func => sub {
my ($count) = @_;
my $ayt = Math::PlanePath::RationalsTree->new (tree_type => 'AYT');
my $drib = Math::PlanePath::RationalsTree->new (tree_type => 'Drib');
my @got = (0); # initial 0
for (my $n = $drib->n_start; @got < $count; $n++) {
my ($x, $y) = $drib->n_to_xy($n);
push @got, $ayt->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A061547 -- pos of frac F(n)/F(n+1) in Stern diatomic, is CW N
# F(n)/F(n+1) in CW, extra initial 0
MyOEIS::compare_values
(anum => 'A061547',
max_count => 100,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got = (0); # extra initial 0 in seq A061547
require Math::BigInt;
my $f1 = Math::BigInt->new(1);
my $f0 = Math::BigInt->new(1);
while (@got < $count) {
push @got, $path->xy_to_n ($f0, $f1);
($f1,$f0) = ($f1+$f0,$f1);
}
return \@got;
});
# #------------------------------------------------------------------------------
# # A113881
# # different as n=49
#
# {
# my $anum = 'A113881';
# my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
# my $skip;
# my @got;
# my $diff;
# if ($bvalues) {
# require Math::PlanePath::Diagonals;
# my $path = Math::PlanePath::RationalsTree->new(tree_type => 'SB');
# my $diag = Math::PlanePath::Diagonals->new;
# for (my $n = $diag->n_start; @got < $count; $n++) {
# my ($x,$y) = $diag->n_to_xy ($n);
# $x++;
# $y++;
# my $gcd = gcd($x,$y);
# $x /= $gcd;
# $y /= $gcd;
# my $n = $path->xy_to_n($x,$y);
# my $nbits = sprintf '%b', $n;
# push @got, length($nbits);
# }
# $diff = diff_nums(\@got, $bvalues);
# if ($diff) {
# MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..30]));
# MyTestHelpers::diag ("got: ",join(',',@got[0..30]));
# }
# }
# skip (! $bvalues,
# $diff, undef,
# "$anum");
# }
#------------------------------------------------------------------------------
# A088696 -- length of continued fraction of SB fractions
if (! eval { require Math::ContinuedFraction; 1 }) {
skip ("Math::ContinuedFraction not available",
0,0);
} else {
MyOEIS::compare_values
(anum => 'A088696',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::RationalsTree->new(tree_type => 'SB');
OUTER: for (my $k = 1; @got < $count; $k++) {
foreach my $n (2**$k .. 2**$k + 2**($k-1) - 1) {
my ($x,$y) = $path->n_to_xy ($n);
my $cf = Math::ContinuedFraction->from_ratio($x,$y);
my $cfaref = $cf->to_array;
my $cflen = scalar(@$cfaref);
push @got, $cflen-1; # -1 to skip initial 0 term in $cf
### cf: "n=$n xy=$x/$y cflen=$cflen ".$cf->to_ascii
last OUTER if @got >= $count;
}
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A086893 -- pos of frac F(n+1)/F(n) in Stern diatomic, is CW N
MyOEIS::compare_values
(anum => 'A086893',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
my @got;
my $f1 = 1;
my $f0 = 1;
while (@got < $count) {
push @got, $path->xy_to_n ($f1, $f0);
($f1,$f0) = ($f1+$f0,$f1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A007305 -- SB numerators
MyOEIS::compare_values
(anum => 'A007305',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got = (0,1); # extra initial
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A047679 -- SB denominators
MyOEIS::compare_values
(anum => 'A047679',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A007306 -- SB num+den
MyOEIS::compare_values
(anum => 'A007306',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my @got = (1,1); # extra initial
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x+$y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A162911 -- Drib tree numerators = Bird tree reverse N
MyOEIS::compare_values
(anum => q{A162911},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'Bird');
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $path->n_to_xy (bit_reverse ($n));
push @got, $x;
}
return \@got;
});
sub bit_reverse {
my ($n) = @_;
my $rev = 1;
while ($n > 1) {
$rev = 2*$rev + ($n % 2);
$n = int($n/2);
}
return $rev;
}
#------------------------------------------------------------------------------
# A162912 -- Drib tree denominators = Bird tree reverse
MyOEIS::compare_values
(anum => q{A162912},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::RationalsTree->new (tree_type => 'Bird');
my @got;
foreach my $n (1 .. $count) {
my ($x, $y) = $path->n_to_xy (bit_reverse ($n));
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/HeptSpiralSkewed-oeis.t 0000644 0001750 0001750 00000002736 12563467041 017651 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 4;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use List::Util 'min', 'max';
use Math::PlanePath::HeptSpiralSkewed;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A140065 - N on Y axis
MyOEIS::compare_values
(anum => 'A140065',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::HeptSpiralSkewed->new;
my @got;
for (my $y = 0; @got < $count; $y++) {
my $n = $path->xy_to_n(0,$y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/CfracDigits-oeis.t 0000644 0001750 0001750 00000006265 12136177302 016610 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 5;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::CfracDigits;
use Math::PlanePath::Base::Digits
'digit_join_lowtohigh';
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A071766 -- radix=1 X numerators, same as HCS denominators
# except at OFFSET=0 extra initial 1 from 0/1
MyOEIS::compare_values
(anum => 'A071766',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CfracDigits->new (radix => 1);
my @got = (1);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A032924 - N in X=1 column, ternary no digit 0
MyOEIS::compare_values
(anum => 'A032924',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CfracDigits->new;
my @got;
for (my $y = 3; @got < $count; $y++) {
push @got, $path->xy_to_n(1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A023705 - N in X=1 column, base4 no digit 0
MyOEIS::compare_values
(anum => 'A023705',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CfracDigits->new (radix => 3);
my @got;
for (my $y = 3; @got < $count; $y++) {
push @got, $path->xy_to_n(1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A023721 - N in X=1 column, base5 no digit 0
MyOEIS::compare_values
(anum => 'A023721',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CfracDigits->new (radix => 4);
my @got;
for (my $y = 3; @got < $count; $y++) {
push @got, $path->xy_to_n(1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A052382 - N in X=1 column, base5 no digit 0
MyOEIS::compare_values
(anum => 'A052382',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CfracDigits->new (radix => 9);
my @got;
for (my $y = 3; @got < $count; $y++) {
push @got, $path->xy_to_n(1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/OctagramSpiral-oeis.t 0000644 0001750 0001750 00000002672 12164405074 017335 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 7;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::OctagramSpiral;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A125201 -- N on X axis, from X=1 onwards, 18-gonals + 1
MyOEIS::compare_values
(anum => 'A125201',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::OctagramSpiral->new;
my @got;
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n($x,0);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/SquareSpiral-oeis.t 0000644 0001750 0001750 00000120056 12301301565 017026 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# A168022 Non-composite numbers in the eastern ray of the Ulam spiral as oriented on the March 1964 cover of Scientific American.
# A168023 Non-composite numbers in the northern ray of the Ulam spiral as oriented on the March 1964 cover of Scientific American.
# A168024 Non-composite numbers in the northwestern ray of the Ulam spiral as oriented on the March 1964 cover of Scientific American.
# A168025 Non-composite numbers in the western ray of the Ulam spiral as oriented on the March 1964 cover of Scientific American.
# A168026 Non-composite numbers in the southwestern ray of the Ulam spiral as oriented on the March 1964 cover of Scientific American.
# A168027 Non-composite numbers in the southern ray of the Ulam spiral as oriented on the March 1964 cover of Scientific American.
# A217014 Permutation of natural numbers arising from applying the walk of a square spiral (e.g. A214526) to the data of triangular horizontal-last spiral (defined in A214226).
# A217015 Permutation of natural numbers arising from applying the walk of a square spiral (e.g. A214526) to the data of rotated-square spiral (defined in A215468).
# A053823 Product of primes in n-th shell of prime spiral.
# A053997 Sum of primes in n-th shell of prime spiral.
# A053998 Smallest prime in n-th shell of prime spiral.
# A113688 Isolated semiprimes in the semiprime spiral.
# A113689 Number of semiprimes in clumps of size >1 through n^2 in the semiprime spiral.
# A114254 Sum of all terms on the two principal diagonals of a 2n+1 X 2n+1 square spiral.
use 5.004;
use strict;
use Test;
plan tests => 64;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use List::Util 'min','max','sum';
use Math::PlanePath::SquareSpiral;
# uncomment this to run the ### lines
# use Smart::Comments;
my $path = Math::PlanePath::SquareSpiral->new;
# return 1,2,3,4
sub path_n_dir4_1 {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy($n);
my ($next_x,$next_y) = $path->n_to_xy($n+1);
return dxdy_to_dir4_1 ($next_x - $x,
$next_y - $y);
}
# return 1,2,3,4, with Y reckoned increasing upwards
sub dxdy_to_dir4_1 {
my ($dx, $dy) = @_;
if ($dx > 0) { return 1; } # east
if ($dx < 0) { return 3; } # west
if ($dy > 0) { return 2; } # north
if ($dy < 0) { return 4; } # south
}
#------------------------------------------------------------------------------
# A059924 Write the numbers from 1 to n^2 in a spiraling square; a(n) is the
# total of the sums of the two diagonals.
MyOEIS::compare_values
(anum => 'A059924',
max_count => 1000,
func => sub {
my ($count) = @_;
my @got = (0);
for (my $n = 1; @got < $count; $n++) {
push @got, my_A059924($n);
}
return \@got;
});
BEGIN {
my $path = Math::PlanePath::SquareSpiral->new;
# A059924 spirals inwards, use $square+1 - $t to reverse the path numbering
sub my_A059924 {
my ($n) = @_;
### A059924(): $n
my $square = $n*$n;
### $square
my $total = 0;
my ($x,$y) = $path->n_to_xy($square);
my $dx = ($x <= 0 ? 1 : -1);
my $dy = ($y <= 0 ? 1 : -1);
### diagonal: "$x,$y dir $dx,$dy"
for (;;) {
my $t = $path->xy_to_n($x,$y);
### $t
last if $t > $square;
$total += $square+1 - $t;
$x += $dx;
$y += $dy;
}
$x -= $dx;
$y -= $dy * $n;
$dx = - $dx;
### diagonal: "$x,$y dir $dx,$dy"
for (;;) {
my $t = $path->xy_to_n($x,$y);
### $t
last if $t > $square;
$total += $square+1 - $t;
$x += $dx;
$y += $dy;
}
### $total
return $total;
}
}
#------------------------------------------------------------------------------
# A027709 -- unit squares figure boundary
MyOEIS::compare_values
(anum => 'A027709',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SquareSpiral->new;
my @got = (0);
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, $path->_NOTDOCUMENTED_n_to_figure_boundary($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A078633 -- grid sticks
{
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
sub path_n_to_dsticks {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy($n);
my $dsticks = 4;
foreach my $i (0 .. $#dir4_to_dx) {
my $an = $path->xy_to_n($x+$dir4_to_dx[$i], $y+$dir4_to_dy[$i]);
$dsticks -= (defined $an && $an < $n);
}
return $dsticks;
}
}
MyOEIS::compare_values
(anum => 'A078633',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SquareSpiral->new;
my @got;
my $boundary = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
$boundary += path_n_to_dsticks($path,$n);
push @got, $boundary;
}
return \@got;
});
#------------------------------------------------------------------------------
# A094768 -- cumulative spiro-fibonacci total of 4 neighbours
{
my @surround4_dx = (1, 0, -1, 0);
my @surround4_dy = (0, 1, 0, -1);
MyOEIS::compare_values
(anum => q{A094768},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SquareSpiral->new (n_start => 0);
require Math::BigInt;
my $total = Math::BigInt->new(1);
my @got = ($total);
for (my $n = $path->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n-1);
foreach my $i (0 .. $#surround4_dx) {
my $sn = $path->xy_to_n ($x+$surround4_dx[$i], $y+$surround4_dy[$i]);
if ($sn < $n) {
$total += $got[$sn];
}
}
$got[$n] = $total;
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A094767 -- cumulative spiro-fibonacci total of 8 neighbours
my @surround8_dx = (1, 1, 0, -1, -1, -1, 0, 1);
my @surround8_dy = (0, 1, 1, 1, 0, -1, -1, -1);
MyOEIS::compare_values
(anum => q{A094767},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SquareSpiral->new (n_start => 0);
require Math::BigInt;
my $total = Math::BigInt->new(1);
my @got = ($total);
for (my $n = $path->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n-1);
foreach my $i (0 .. $#surround8_dx) {
my $sn = $path->xy_to_n ($x+$surround8_dx[$i], $y+$surround8_dy[$i]);
if ($sn < $n) {
$total += $got[$sn];
}
}
$got[$n] = $total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A094769 -- cumulative spiro-fibonacci total of 8 neighbours starting 0,1
MyOEIS::compare_values
(anum => q{A094769},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SquareSpiral->new (n_start => 0);
require Math::BigInt;
my $total = Math::BigInt->new(1);
my @got = (0, $total);
for (my $n = $path->n_start + 2; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n-1);
foreach my $i (0 .. $#surround8_dx) {
my $sn = $path->xy_to_n ($x+$surround8_dx[$i], $y+$surround8_dy[$i]);
if ($sn < $n) {
$total += $got[$sn];
}
}
$got[$n] = $total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A136626 -- count surrounding primes
MyOEIS::compare_values
(anum => q{A136626},
fixup => sub {
my ($bvalues) = @_;
$bvalues->[31] = 3; # DODGY-DATA: 3 primes 13,31,59 surrounding 32
},
func => sub {
my ($count) = @_;
require Math::Prime::XS;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, ((!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y-1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y-1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y-1)))
);
}
return \@got;
});
# A136627 -- count self and surrounding primes
MyOEIS::compare_values
(anum => q{A136627},
fixup => sub {
my ($bvalues) = @_;
$bvalues->[31] = 3; # DODGY-DATA: 3 primes 13,31,59 surrounding 32
},
func => sub {
my ($count) = @_;
require Math::Prime::XS;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, (Math::Prime::XS::is_prime($n)
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y-1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y-1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y-1)))
);
}
return \@got;
});
#------------------------------------------------------------------------------
# A078784 -- primes on any axis positive or negative
MyOEIS::compare_values
(anum => 'A078784',
func => sub {
my ($count) = @_;
require Math::Prime::XS;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
if ($x == 0 || $y == 0) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A090925 -- permutation rotate +90
MyOEIS::compare_values
(anum => 'A090925',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x,$y) = (-$y,$x); # rotate +90
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
# A090928 -- permutation rotate +180
MyOEIS::compare_values
(anum => 'A090928',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x,$y) = (-$x,-$y); # rotate +180
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
# A090929 -- permutation rotate +270
MyOEIS::compare_values
(anum => 'A090929',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x,$y) = ($y,-$x); # rotate -90
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
# A090861 -- permutation rotate +180, opp direction
MyOEIS::compare_values
(anum => 'A090861',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
$y = -$y; # opp direction
($x,$y) = (-$x,-$y); # rotate 180
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
# A090915 -- permutation rotate +270, opp direction
MyOEIS::compare_values
(anum => 'A090915',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
$y = -$y; # opp direction
($x,$y) = ($y,-$x); # rotate -90
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
# A090930 -- permutation opp direction
MyOEIS::compare_values
(anum => 'A090930',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
$y = -$y; # opp direction
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
# A185413 -- rotate 180, offset X+1,Y
MyOEIS::compare_values
(anum => 'A185413',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
$x = 1 - $x;
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A078765 -- primes at integer radix sqrt(x^2+y^2), and not on axis
MyOEIS::compare_values
(anum => 'A078765',
func => sub {
my ($count) = @_;
require Math::Prime::XS;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
if ($x != 0 && $y != 0 && is_perfect_square($x*$x+$y*$y)) {
push @got, $n;
}
}
return \@got;
});
sub is_perfect_square {
my ($n) = @_;
my $sqrt = int(sqrt($n));
return ($sqrt*$sqrt == $n);
}
#------------------------------------------------------------------------------
# A200975 -- all four diagonals
MyOEIS::compare_values
(anum => 'A200975',
func => sub {
my ($count) = @_;
my @got = (1);
for (my $i = 1; @got < $count; $i++) {
push @got, $path->xy_to_n($i,$i);
last unless @got < $count;
push @got, $path->xy_to_n(-$i,$i);
last unless @got < $count;
push @got, $path->xy_to_n(-$i,-$i);
last unless @got < $count;
push @got, $path->xy_to_n($i,-$i);
last unless @got < $count;
}
return \@got;
});
# #------------------------------------------------------------------------------
# # A195060 -- N on axis or diagonal ???
# # vertices generalized pentagonal 0,1,2,5,7,12,15,22,...
# # union A001318, A032528, A045943
#
# MyOEIS::compare_values
# (anum => 'A195060',
# func => sub {
# my ($count) = @_;
# my @got = (0);
# for (my $n = $path->n_start; @got < $count; $n++) {
# my ($x,$y) = $path->n_to_xy ($n);
# if ($x == $y || $x == -$y || $x == 0 || $y == 0) {
# push @got, $n;
# }
# }
# return \@got;
# });
# #------------------------------------------------------------------------------
# # A137932 -- count points not on diagonals up to nxn
#
# MyOEIS::compare_values
# (anum => 'A137932',
# max_value => 1000,
# func => sub {
# my ($count) = @_;
# my @got;
# for (my $k = 0; @got < $count; $k++) {
# my $num = 0;
# my ($cx,$cy) = $path->n_to_xy ($k*$k);
# foreach my $n (1 .. $k*$k) {
# my ($x,$y) = $path->n_to_xy ($n);
# $num += (abs($x) != abs($y));
# }
# push @got, $num;
# }
# return \@got;
# });
#------------------------------------------------------------------------------
# A113688 -- isolated semi-primes
MyOEIS::compare_values
(anum => 'A113688',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::AlmostPrimes;
my $seq = Math::NumSeq::AlmostPrimes->new;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless $seq->pred($n);
my ($x,$y) = $path->n_to_xy ($n);
if (! $seq->pred ($path->xy_to_n($x+1,$y))
&& ! $seq->pred ($path->xy_to_n($x-1,$y))
&& ! $seq->pred ($path->xy_to_n($x,$y+1))
&& ! $seq->pred ($path->xy_to_n($x,$y-1))
&& ! $seq->pred ($path->xy_to_n($x+1,$y+1))
&& ! $seq->pred ($path->xy_to_n($x-1,$y-1))
&& ! $seq->pred ($path->xy_to_n($x-1,$y+1))
&& ! $seq->pred ($path->xy_to_n($x+1,$y-1))
) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A215470 -- primes with >=4 prime neighbours in 8 surround
MyOEIS::compare_values
(anum => 'A215470',
func => sub {
my ($count) = @_;
require Math::Prime::XS;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
my $num = ((!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y-1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y-1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y-1)))
);
if ($num >= 4) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A033638 -- N positions of the turns
MyOEIS::compare_values
(anum => 'A033638',
max_value => 100_000,
func => sub {
my ($count) = @_;
my @got;
push @got, 1,1;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'SquareSpiral',
turn_type => 'LSR');
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value != 0) {
push @got, $i;
}
}
return \@got;
});
# A172979 -- N positions of the turns which are also primes
MyOEIS::compare_values
(anum => 'A172979',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
require Math::Prime::XS;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'SquareSpiral',
turn_type => 'LSR');
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value != 0 && Math::Prime::XS::is_prime($i)) {
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A137930 sum leading and anti diagonal of nxn square
MyOEIS::compare_values
(anum => q{A137930},
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, diagonals_total($path,$k);
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A137931}, # 2n x 2n
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k+=2) {
push @got, diagonals_total($path,$k);
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A114254}, # 2n+1 x 2n+1
func => sub {
my ($count) = @_;
my @got;
for (my $k = 1; @got < $count; $k+=2) {
push @got, diagonals_total($path,$k);
}
return \@got;
});
sub diagonals_total {
my ($path, $k) = @_;
### diagonals_total(): $k
if ($k == 0) {
return 0;
}
my ($x,$y) = $path->n_to_xy ($k*$k); # corner
my $dx = ($x > 0 ? -1 : 1);
my $dy = ($y > 0 ? -1 : 1);
### corner: "$x,$y dx=$dx,dy=$dy"
my %n;
foreach my $i (0 .. $k-1) {
my $n = $path->xy_to_n($x,$y);
$n{$n} = 1;
$x += $dx;
$y += $dy;
}
$x -= $k*$dx;
$dy = -$dy;
$y += $dy;
### opposite: "$x,$y dx=$dx,dy=$dy"
foreach my $i (0 .. $k-1) {
my $n = $path->xy_to_n($x,$y);
$n{$n} = 1;
$x += $dx;
$y += $dy;
}
### n values: keys %n
return sum(keys %n);
}
#------------------------------------------------------------------------------
# A059428 -- Prime[N] for N=corner
MyOEIS::compare_values
(anum => q{A059428},
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my @got = (2);
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value) {
push @got, MyOEIS::ith_prime($i); # i=2 as first turn giving prime=3
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A123663 -- count total shared edges
MyOEIS::compare_values
(anum => q{A123663},
func => sub {
my ($count) = @_;
my @got;
my $edges = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
foreach my $sn ($path->xy_to_n($x+1,$y),
$path->xy_to_n($x-1,$y),
$path->xy_to_n($x,$y+1),
$path->xy_to_n($x,$y-1)) {
if ($sn < $n) {
$edges++;
}
}
push @got, $edges;
}
return \@got;
});
#------------------------------------------------------------------------------
# A141481 -- values as sum of eight surrounding
MyOEIS::compare_values
(anum => q{A141481},
func => sub {
my ($count) = @_;
require Math::BigInt;
my $path = Math::PlanePath::SquareSpiral->new (n_start => 0);
my @got = (1);
for (my $n = $path->n_start + 1; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
my $sum = Math::BigInt->new(0);
foreach my $sn ($path->xy_to_n($x+1,$y),
$path->xy_to_n($x-1,$y),
$path->xy_to_n($x,$y+1),
$path->xy_to_n($x,$y-1),
$path->xy_to_n($x+1,$y+1),
$path->xy_to_n($x-1,$y-1),
$path->xy_to_n($x-1,$y+1),
$path->xy_to_n($x+1,$y-1)) {
if ($sn < $n) {
$sum += $got[$sn]; # @got is 0-based
}
}
push @got, $sum;
}
return \@got;
});
#------------------------------------------------------------------------------
# A156859 Y axis positive and negative
MyOEIS::compare_values
(anum => 'A156859',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SquareSpiral->new (n_start => 0);
my @got = (0);
for (my $y = 1; @got < $count; $y++) {
push @got, $path->xy_to_n(0, $y);
last unless @got < $count;
push @got, $path->xy_to_n(0, -$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A172294 -- jewels, composite surrounded by 4 primes, starting N=0
MyOEIS::compare_values
(anum => 'A172294',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::SquareSpiral->new (n_start => 0);
require Math::Prime::XS;
for (my $n = $path->n_start; @got < $count; $n++) {
next if Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
if (Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y))
&& Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y))
&& Math::Prime::XS::is_prime ($path->xy_to_n($x,$y+1))
&& Math::Prime::XS::is_prime ($path->xy_to_n($x,$y-1))
) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A115258 -- isolated primes
MyOEIS::compare_values
(anum => 'A115258',
func => sub {
my ($count) = @_;
my @got;
require Math::Prime::XS;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
if (! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y))
&& ! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y))
&& ! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y+1))
&& ! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y-1))
&& ! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y+1))
&& ! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y-1))
&& ! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y+1))
&& ! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y-1))
) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A214177 -- sum of 4 neighbours
MyOEIS::compare_values
(anum => 'A214177',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, ($path->xy_to_n($x+1,$y)
+ $path->xy_to_n($x-1,$y)
+ $path->xy_to_n($x,$y+1)
+ $path->xy_to_n($x,$y-1)
);
}
return \@got;
});
#------------------------------------------------------------------------------
# A214176 -- sum of 8 neighbours
MyOEIS::compare_values
(anum => 'A214176',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, ($path->xy_to_n($x+1,$y)
+ $path->xy_to_n($x-1,$y)
+ $path->xy_to_n($x,$y+1)
+ $path->xy_to_n($x,$y-1)
+ $path->xy_to_n($x+1,$y+1)
+ $path->xy_to_n($x-1,$y-1)
+ $path->xy_to_n($x-1,$y+1)
+ $path->xy_to_n($x+1,$y-1)
);
}
return \@got;
});
#------------------------------------------------------------------------------
# A214664 -- X coord of prime N
MyOEIS::compare_values
(anum => 'A214664',
func => sub {
my ($count) = @_;
my @got;
require Math::Prime::XS;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
push @got, $x;
}
return \@got;
});
# A214665 -- Y coord of prime N
MyOEIS::compare_values
(anum => 'A214665',
func => sub {
my ($count) = @_;
my @got;
require Math::Prime::XS;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
push @got, $y;
}
return \@got;
});
# A214666 -- X coord of prime N, first to west
MyOEIS::compare_values
(anum => 'A214666',
func => sub {
my ($count) = @_;
my @got;
require Math::Prime::XS;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
push @got, -$x;
}
return \@got;
});
# A214667 -- Y coord of prime N, first to west
MyOEIS::compare_values
(anum => 'A214667',
func => sub {
my ($count) = @_;
my @got;
require Math::Prime::XS;
for (my $n = $path->n_start; @got < $count; $n++) {
next unless Math::Prime::XS::is_prime($n);
my ($x,$y) = $path->n_to_xy ($n);
push @got, -$y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A143856 -- N values ENE slope=2
MyOEIS::compare_values
(anum => 'A143856',
func => sub {
my ($count) = @_;
my @got;
for (my $i = 0; @got < $count; $i++) {
push @got, $path->xy_to_n (2*$i, $i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A143861 -- N values NNE slope=2
MyOEIS::compare_values
(anum => 'A143861',
func => sub {
my ($count) = @_;
my @got;
for (my $i = 0; @got < $count; $i++) {
push @got, $path->xy_to_n ($i, 2*$i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A063826 -- direction 1,2,3,4 = E,N,W,S
MyOEIS::compare_values
(anum => 'A063826',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, path_n_dir4_1($path,$n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A062410 -- a(n) is sum of existing numbers in row of a(n-1)
MyOEIS::compare_values
(anum => 'A062410',
func => sub {
my ($count) = @_;
my @got;
require Math::BigInt;
my %plotted;
$plotted{0,0} = Math::BigInt->new(1);
my $xmin = 0;
my $ymin = 0;
my $xmax = 0;
my $ymax = 0;
push @got, 1;
for (my $n = $path->n_start + 1; @got < $count; $n++) {
my ($prev_x, $prev_y) = $path->n_to_xy ($n-1);
my ($x, $y) = $path->n_to_xy ($n);
my $total = 0;
if ($y == $prev_y) {
### column: "$ymin .. $ymax at x=$prev_x"
foreach my $y ($ymin .. $ymax) {
$total += $plotted{$prev_x,$y} || 0;
}
} else {
### row: "$xmin .. $xmax at y=$prev_y"
foreach my $x ($xmin .. $xmax) {
$total += $plotted{$x,$prev_y} || 0;
}
}
### total: "$total"
$plotted{$x,$y} = $total;
$xmin = min($xmin,$x);
$xmax = max($xmax,$x);
$ymin = min($ymin,$y);
$ymax = max($ymax,$y);
push @got, $total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A141481 -- plot sum of existing eight surrounding values entered
MyOEIS::compare_values
(anum => q{A141481}, # not in POD
func => sub {
my ($count) = @_;
my @got;
require Math::BigInt;
my %plotted;
$plotted{0,0} = Math::BigInt->new(1);
push @got, 1;
for (my $n = $path->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
my $value = (
($plotted{$x+1,$y+1} || 0)
+ ($plotted{$x+1,$y} || 0)
+ ($plotted{$x+1,$y-1} || 0)
+ ($plotted{$x-1,$y-1} || 0)
+ ($plotted{$x-1,$y} || 0)
+ ($plotted{$x-1,$y+1} || 0)
+ ($plotted{$x,$y-1} || 0)
+ ($plotted{$x,$y+1} || 0)
);
$plotted{$x,$y} = $value;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A020703 -- permutation read clockwise, ie. transpose Y,X
# also permutation rotate +90, opp direction
MyOEIS::compare_values
(anum => 'A020703',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A121496 -- run lengths of consecutive N in A068225 N at X+1,Y
MyOEIS::compare_values
(anum => 'A121496',
func => sub {
my ($count) = @_;
my @got;
my $num = 0;
my $prev_right_n = A068225(1) - 1; # make first value look like a run
for (my $n = $path->n_start; @got < $count; $n++) {
my $right_n = A068225($n);
if ($right_n == $prev_right_n + 1) {
$num++;
} else {
push @got, $num;
$num = 1;
}
$prev_right_n = $right_n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A054551 -- plot Nth prime at each N, values are those primes on X axis
MyOEIS::compare_values
(anum => 'A054551',
func => sub {
my ($count) = @_;
my @got;
for (my $x = 0; @got < $count; $x++) {
my $n = $path->xy_to_n($x,0);
push @got, MyOEIS::ith_prime($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054553 -- plot Nth prime at each N, values are those primes on X=Y diagonal
MyOEIS::compare_values
(anum => 'A054553',
func => sub {
my ($count) = @_;
my @got;
for (my $x = 0; @got < $count; $x++) {
my $n = $path->xy_to_n($x,$x);
push @got, MyOEIS::ith_prime($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054555 -- plot Nth prime at each N, values are those primes on Y axis
MyOEIS::compare_values
(anum => 'A054555',
func => sub {
my ($count) = @_;
my @got;
for (my $y = 0; @got < $count; $y++) {
my $n = $path->xy_to_n(0,$y);
push @got, MyOEIS::ith_prime($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A053999 -- plot Nth prime at each N, values are those primes on South-East
MyOEIS::compare_values
(anum => 'A053999',
func => sub {
my ($count) = @_;
my @got;
for (my $x = 0; @got < $count; $x++) {
my $n = $path->xy_to_n($x,-$x);
push @got, MyOEIS::ith_prime($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054564 -- plot Nth prime at each N, values are those primes on North-West
MyOEIS::compare_values
(anum => 'A054564',
func => sub {
my ($count) = @_;
my @got;
for (my $x = 0; @got < $count; $x--) {
my $n = $path->xy_to_n($x,-$x);
push @got, MyOEIS::ith_prime($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054566 -- plot Nth prime at each N, values are those primes on negative X
MyOEIS::compare_values
(anum => 'A054566',
func => sub {
my ($count) = @_;
my @got;
for (my $x = 0; @got < $count; $x--) {
my $n = $path->xy_to_n($x,0);
push @got, MyOEIS::ith_prime($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A137928 -- N values on diagonal X=1-Y positive and negative
MyOEIS::compare_values
(anum => 'A137928',
func => sub {
my ($count) = @_;
my @got;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n(1-$y,$y);
last unless @got < $count;
if ($y != 0) {
push @got, $path->xy_to_n(1-(-$y),-$y);
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A002061 -- central polygonal numbers, N values on diagonal X=Y pos and neg
MyOEIS::compare_values
(anum => 'A002061',
func => sub {
my ($count) = @_;
my @got;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n($y,$y);
last unless @got < $count;
push @got, $path->xy_to_n(-$y,-$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A016814 -- N values (4n+1)^2 on SE diagonal every second square
MyOEIS::compare_values
(anum => 'A016814',
func => sub {
my ($count) = @_;
my @got;
for (my $i = 0; @got < $count; $i+=2) {
push @got, $path->xy_to_n($i,-$i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A033952 -- AllDigits on negative Y axis
MyOEIS::compare_values
(anum => 'A033952',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::AllDigits;
my $seq = Math::NumSeq::AllDigits->new;
for (my $y = 0; @got < $count; $y--) {
my $n = $path->xy_to_n (0, $y);
push @got, $seq->ith($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A033953 -- AllDigits starting 0, on negative Y axis
MyOEIS::compare_values
(anum => 'A033953',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::AllDigits;
my $seq = Math::NumSeq::AllDigits->new;
for (my $y = 0; @got < $count; $y--) {
my $n = $path->xy_to_n (0, $y);
push @got, $seq->ith($n-1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A033988 -- AllDigits starting 0, on negative X axis
MyOEIS::compare_values
(anum => 'A033988',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::AllDigits;
my $seq = Math::NumSeq::AllDigits->new;
for (my $x = 0; @got < $count; $x--) {
my $n = $path->xy_to_n ($x, 0);
push @got, $seq->ith($n-1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A033989 -- AllDigits starting 0, on positive Y axis
MyOEIS::compare_values
(anum => 'A033989',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::AllDigits;
my $seq = Math::NumSeq::AllDigits->new;
for (my $y = 0; @got < $count; $y++) {
my $n = $path->xy_to_n (0, $y);
push @got, $seq->ith($n-1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A033990 -- AllDigits starting 0, on positive X axis
MyOEIS::compare_values
(anum => 'A033990',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::AllDigits;
my $seq = Math::NumSeq::AllDigits->new;
for (my $x = 0; @got < $count; $x++) {
my $n = $path->xy_to_n ($x, 0);
push @got, $seq->ith($n-1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054556 -- N values on Y axis (but OFFSET=1)
MyOEIS::compare_values
(anum => 'A054556',
func => sub {
my ($count) = @_;
my @got;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054567 -- N values on negative X axis
MyOEIS::compare_values
(anum => 'A054567',
func => sub {
my ($count) = @_;
my @got;
for (my $x = 0; @got < $count; $x++) {
my $n = $path->xy_to_n (-$x, 0);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A054554 -- N values on X=Y diagonal
MyOEIS::compare_values
(anum => 'A054554',
func => sub {
my ($count) = @_;
my @got;
for (my $i = 0; @got < $count; $i++) {
push @got, $path->xy_to_n($i,$i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054569 -- N values on negative X=Y diagonal, but OFFSET=1
MyOEIS::compare_values
(anum => 'A054569',
func => sub {
my ($count) = @_;
my @got;
for (my $i = 0; @got < $count; $i++) {
push @got, $path->xy_to_n(-$i,-$i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A068225 -- permutation N at X+1,Y
MyOEIS::compare_values
(anum => 'A068225',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, A068225($n);
}
return \@got;
});
# starting n=1
sub A068225 {
my ($n) = @_;
my ($x, $y) = $path->n_to_xy ($n);
return $path->xy_to_n ($x+1,$y);
}
#------------------------------------------------------------------------------
# A068226 -- permutation N at X-1,Y
MyOEIS::compare_values
(anum => 'A068226',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($x-1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/PeanoCurve-oeis.t 0000644 0001750 0001750 00000027054 12563476437 016513 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 23;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::PeanoCurve;
use Math::PlanePath::Diagonals;
use Math::PlanePath::ZOrderCurve;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $peano = Math::PlanePath::PeanoCurve->new;
#------------------------------------------------------------------------------
# A163334 -- diagonals same axis
MyOEIS::compare_values
(anum => 'A163334',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up',
n_start => 0);
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $peano->xy_to_n ($x, $y);
}
return \@got;
});
# A163335 -- diagonals same axis, inverse
MyOEIS::compare_values
(anum => 'A163335',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up',
n_start => 0);
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($x, $y) = $peano->n_to_xy ($n);
push @got, $diagonal->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163336 -- diagonals opposite axis
MyOEIS::compare_values
(anum => 'A163336',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down',
n_start => 0);
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $peano->xy_to_n ($x, $y);
}
return \@got;
});
# A163337 -- diagonals opposite axis, inverse
MyOEIS::compare_values
(anum => 'A163337',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down',
n_start => 0);
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($x, $y) = $peano->n_to_xy ($n);
push @got, $diagonal->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163338 -- diagonals same axis, 1-based
MyOEIS::compare_values
(anum => 'A163338',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $peano->xy_to_n ($x, $y) + 1;
}
return \@got;
});
# A163339 -- diagonals same axis, 1-based, inverse
MyOEIS::compare_values
(anum => 'A163339',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($x, $y) = $peano->n_to_xy ($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163340 -- diagonals same axis, 1 based
MyOEIS::compare_values
(anum => 'A163340',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $peano->xy_to_n($x,$y) + 1;
}
return \@got;
});
# A163341 -- diagonals same axis, 1-based, inverse
MyOEIS::compare_values
(anum => 'A163341',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($x, $y) = $peano->n_to_xy ($n);
push @got, $diagonal->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163342 -- diagonal sums
# no b-file as of Jan 2011
MyOEIS::compare_values
(anum => 'A163342',
func => sub {
my ($count) = @_;
my @got;
for (my $d = 0; @got < $count; $d++) {
my $sum = 0;
foreach my $x (0 .. $d) {
my $y = $d - $x;
$sum += $peano->xy_to_n ($x, $y);
}
push @got, $sum;
}
return \@got;
});
# A163479 -- diagonal sums div 6
MyOEIS::compare_values
(anum => 'A163479',
func => sub {
my ($count) = @_;
my @got;
for (my $d = 0; @got < $count; $d++) {
my $sum = 0;
foreach my $x (0 .. $d) {
my $y = $d - $x;
$sum += $peano->xy_to_n ($x, $y);
}
push @got, int($sum/6);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163344 -- N/4 on X=Y diagonal
MyOEIS::compare_values
(anum => 'A163344',
func => sub {
my ($count) = @_;
my @got;
for (my $x = 0; @got < $count; $x++) {
push @got, int($peano->xy_to_n($x,$x) / 4);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163534 -- absolute direction 0=east, 1=south, 2=west, 3=north
# Y coordinates reckoned down the page, so south is Y increasing
MyOEIS::compare_values
(anum => 'A163534',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($dx,$dy) = $peano->n_to_dxdy ($n);
push @got, MyOEIS::dxdy_to_direction ($dx,$dy);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163535 -- absolute direction transpose 0=east, 1=south, 2=west, 3=north
MyOEIS::compare_values
(anum => 'A163535',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($dx,$dy) = $peano->n_to_dxdy ($n);
push @got, MyOEIS::dxdy_to_direction ($dy,$dx);
}
return \@got;
});
#------------------------------------------------------------------------------
# A145204 -- N+1 of positions of verticals
MyOEIS::compare_values
(anum => 'A145204',
func => sub {
my ($count) = @_;
my @got = (0);
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($dx,$dy) = $peano->n_to_dxdy($n);
if ($dx == 0) {
push @got, $n+1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A014578 -- abs(dX), 1=horizontal 0=vertical, extra initial 0
MyOEIS::compare_values
(anum => 'A014578',
func => sub {
my ($count) = @_;
my @got = (0);
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($dx,$dy) = $peano->n_to_dxdy($n);
push @got, abs($dx);
}
return \@got;
});
# A182581 -- abs(dY), but OFFSET=1
MyOEIS::compare_values
(anum => 'A182581',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($dx,$dy) = $peano->n_to_dxdy($n);
push @got, abs($dy);
}
return \@got;
});
#------------------------------------------------------------------------------
# A007417 -- N+1 positions of horizontal step, dY==0, abs(dX)=1
# N+1 has even num trailing ternary 0-digits
MyOEIS::compare_values
(anum => 'A007417',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($dx,$dy) = $peano->n_to_dxdy($n);
if ($dy == 0) {
push @got, $n+1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A163532 -- dX a(n)-a(n-1) so extra initial 0
MyOEIS::compare_values
(anum => 'A163532',
func => sub {
my ($count) = @_;
my @got = (0); # extra initial entry N=0 no change
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($dx,$dy) = $peano->n_to_dxdy($n);
push @got, $dx;
}
return \@got;
});
# A163533 -- dY a(n)-a(n-1)
MyOEIS::compare_values
(anum => 'A163533',
func => sub {
my ($count) = @_;
my @got = (0); # extra initial entry N=0 no change
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($dx,$dy) = $peano->n_to_dxdy($n);
push @got, $dy;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163333 -- Peano N <-> Z-Order radix=3, with digit swaps
MyOEIS::compare_values
(anum => 'A163333',
func => sub {
my ($count) = @_;
my $zorder = Math::PlanePath::ZOrderCurve->new (radix => 3);
my @got;
for (my $n = $zorder->n_start; @got < $count; $n++) {
my $nn = $n;
{
my ($x,$y) = $zorder->n_to_xy ($nn);
($x,$y) = ($y,$x);
$nn = $zorder->xy_to_n ($x,$y);
}
{
my ($x,$y) = $zorder->n_to_xy ($nn);
$nn = $peano->xy_to_n ($x, $y);
}
{
my ($x,$y) = $zorder->n_to_xy ($nn);
($x,$y) = ($y,$x);
$nn = $zorder->xy_to_n ($x,$y);
}
push @got, $nn;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A163333},
func => sub {
my ($count) = @_;
my $zorder = Math::PlanePath::ZOrderCurve->new (radix => 3);
my @got;
for (my $n = 0; @got < $count; $n++) {
my $nn = $n;
{
my ($x,$y) = $zorder->n_to_xy ($nn);
($x,$y) = ($y,$x);
$nn = $zorder->xy_to_n ($x,$y);
}
{
my ($x,$y) = $peano->n_to_xy ($nn); # other way around
$nn = $zorder->xy_to_n ($x, $y);
}
{
my ($x,$y) = $zorder->n_to_xy ($nn);
($x,$y) = ($y,$x);
$nn = $zorder->xy_to_n ($x,$y);
}
push @got, $nn;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163332 -- Peano N at points in Z-Order radix=3 sequence
MyOEIS::compare_values
(anum => 'A163332',
func => sub {
my ($count) = @_;
my $zorder = Math::PlanePath::ZOrderCurve->new (radix => 3);
my @got;
for (my $n = $zorder->n_start; @got < $count; $n++) {
my ($x,$y) = $zorder->n_to_xy ($n);
push @got, $peano->xy_to_n ($x,$y);
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A163332},
func => sub {
my ($count) = @_;
my $zorder = Math::PlanePath::ZOrderCurve->new (radix => 3);
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($x,$y) = $peano->n_to_xy ($n); # other way around
push @got, $zorder->xy_to_n ($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/HilbertCurve-oeis.t 0000644 0001750 0001750 00000062517 12563501553 017031 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Test;
plan tests => 46;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::HilbertCurve;
use Math::PlanePath::Diagonals;
use Math::PlanePath::ZOrderCurve;
use Math::PlanePath::Base::Digits
'bit_split_lowtohigh';
# uncomment this to run the ### lines
# use Smart::Comments '###';
my $hilbert = Math::PlanePath::HilbertCurve->new;
my $zorder = Math::PlanePath::ZOrderCurve->new;
#------------------------------------------------------------------------------
sub zorder_perm {
my ($n) = @_;
my ($x, $y) = $zorder->n_to_xy ($n);
return $hilbert->xy_to_n ($x, $y);
}
sub zorder_perm_inverse {
my ($n) = @_;
my ($x, $y) = $hilbert->n_to_xy ($n);
return $zorder->xy_to_n ($x, $y);
}
sub zorder_perm_rep {
my ($n, $reps) = @_;
foreach (1 .. $reps) {
my ($x, $y) = $zorder->n_to_xy ($n);
$n = $hilbert->xy_to_n ($x, $y);
}
return $n;
}
sub zorder_cycle_length {
my ($n) = @_;
my $count = 1;
my $p = $n;
for (;;) {
$p = zorder_perm($p);
if ($p == $n) {
last;
}
$count++;
}
return $count;
}
sub zorder_is_2cycle {
my ($n) = @_;
my $p1 = zorder_perm($n);
if ($p1 == $n) { return 0; }
my $p2 = zorder_perm($p1);
return ($p2 == $n);
}
sub zorder_is_3cycle {
my ($n) = @_;
my $p1 = zorder_perm($n);
if ($p1 == $n) { return 0; }
my $p2 = zorder_perm($p1);
if ($p2 == $n) { return 0; }
my $p3 = zorder_perm($p2);
return ($p3 == $n);
}
#------------------------------------------------------------------------------
# A147600 - num fixed points in 4^k blocks
MyOEIS::compare_values
(anum => 'A147600',
max_count => 9,
func => sub {
my ($bvalues_count) = @_;
my @got;
my $target = 4;
my $count = 0;
for (my $n = 1; @got < $bvalues_count; $n++) {
if ($n >= $target) {
push @got, $count;
$count = 0;
$target *= 4;
}
if ($n == zorder_perm($n)) {
$count++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A163894 - first i for which (perm^n)[i] != i
MyOEIS::compare_values
(anum => 'A163894',
max_count => 200,
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
push @got, A163894_perm_n_not($n);
}
return \@got;
});
sub A163894_perm_n_not {
my ($n) = @_;
if ($n == 0) {
return 0;
}
for (my $i = 0; ; $i++) {
my $p = zorder_perm_rep ($i, $n);
if ($p != $i) {
return $i;
}
}
}
#------------------------------------------------------------------------------
# A083885 etc counts of segments in direction
foreach my $elem ([0, 'A083885', 0],
# [1, '', 0],
# [2, '', 1],
# [3, '', 0]
) {
my ($dir, $anum, $initial_k) = @$elem;
MyOEIS::compare_values
(anum => $anum,
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
my $n = $hilbert->n_start;
my $total = 0;
my $k = $initial_k;
while (@got < $count) {
my $n_end = 4**$k;
for ( ; $n < $n_end; $n++) {
$total += (dxdy_to_dir4($hilbert->n_to_dxdy($n)) == $dir);
}
push @got, $total;
$k++;
}
return \@got;
});
}
# return 0,1,2,3, with Y reckoned increasing upwards
sub dxdy_to_dir4 {
my ($dx, $dy) = @_;
if ($dx > 0) { return 0; } # east
if ($dx < 0) { return 2; } # west
if ($dy > 0) { return 1; } # north
if ($dy < 0) { return 3; } # south
}
#------------------------------------------------------------------------------
# A163541 -- absolute direction transpose 0=east, 1=south, 2=west, 3=north
MyOEIS::compare_values
(anum => 'A163541',
name => 'absolute direction transpose',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($dx, $dy) = $hilbert->n_to_dxdy ($n);
($dx,$dy) = ($dy,$dx); # transpose
push @got, MyOEIS::dxdy_to_direction ($dx, $dy);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163895 - position where A163894 is a new high
MyOEIS::compare_values
(anum => 'A163895',
max_count => 8,
func => sub {
my ($count) = @_;
my @got;
my $high = -1;
for (my $n = 0; @got < $count; $n++) {
my $value = A163894_perm_n_not($n);
if ($value > $high) {
$high = $value;
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A139351 - HammingDist(X,Y) = count 1-bits at even bit positions in N
MyOEIS::compare_values
(name => 'HammingDist(X,Y)',
anum => 'A139351',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
my ($x, $y) = $hilbert->n_to_xy($n);
push @got, HammingDist($x,$y);
}
return \@got;
});
MyOEIS::compare_values
(name => 'count 1-bits at even bit positions',
anum => q{A139351},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
my @nbits = bit_split_lowtohigh($n);
my $count = 0;
for (my $i = 0; $i <= $#nbits; $i+=2) {
$count += $nbits[$i];
}
push @got, $count;
}
return \@got;
});
sub HammingDist {
my ($x,$y) = @_;
my @xbits = bit_split_lowtohigh($x);
my @ybits = bit_split_lowtohigh($y);
my $ret = 0;
while (@xbits || @ybits) {
$ret += (shift @xbits ? 1 : 0) ^ (shift @ybits ? 1 : 0);
}
return $ret;
}
#------------------------------------------------------------------------------
# A163893 - first diffs of positions where cycle length some new unseen value
MyOEIS::compare_values
(anum => 'A163893',
name => 'cycle length by N',
max_count => 20,
func => sub {
my ($count) = @_;
my @got;
my %seen = (1 => 1);
my $prev = 0;
for (my $n = 0; @got < $count; $n++) {
my $len = zorder_cycle_length($n);
if (! $seen{$len}) {
push @got, $n-$prev;
$prev = $n;
$seen{$len} = 1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A163896 - value where A163894 is a new high
MyOEIS::compare_values
(anum => 'A163896',
max_count => 8,
func => sub {
my ($count) = @_;
my @got;
my $high = -1;
for (my $n = 0; @got < $count; $n++) {
my $value = A163894_perm_n_not($n);
if ($value > $high) {
$high = $value;
push @got, $value;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A163900 - squared distance between Hilbert and Z order
MyOEIS::compare_values
(name => 'squared distance between Hilbert and ZOrder',
anum => 'A163900',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
my ($hx, $hy) = $hilbert->n_to_xy ($n);
my ($zx, $zy) = $zorder->n_to_xy ($n);
my $dx = $hx - $zx;
my $dy = $hy - $zy;
push @got, $dx**2 + $dy**2;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163891 - positions where cycle length some new previously unseen value
#
# len: 1, 1, 2, 2, 6, 3, 3, 6, 6, 6, 3, 3, 6, 3, 6, 3, 1, 3, 3, 3, 1, 1, 2, 2,
# ^
# 91: 0 2 4 5
MyOEIS::compare_values
(name => "cycle length by N",
anum => 'A163891',
max_count => 20,
func => sub {
my ($count) = @_;
my @got;
my %seen;
for (my $n = 0; @got < $count; $n++) {
my $len = zorder_cycle_length($n);
if (! $seen{$len}) {
push @got, $n;
$seen{$len} = 1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A165466 -- dx^2+dy^2 of Hilbert->Peano transposed
MyOEIS::compare_values
(anum => 'A165466',
func => sub {
my ($count) = @_;
require Math::PlanePath::PeanoCurve;
my $peano = Math::PlanePath::PeanoCurve->new;
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($hx,$hy) = $hilbert->n_to_xy($n);
my ($px,$py) = $peano->n_to_xy($n);
($px,$py) = ($py,$px);
push @got, ($px-$hx)**2 + ($py-$hy)**2;
}
return \@got;
});
# A165464 -- dx^2+dy^2 of Hilbert->Peano
MyOEIS::compare_values
(anum => 'A165464',
func => sub {
my ($count) = @_;
require Math::PlanePath::PeanoCurve;
my $peano = Math::PlanePath::PeanoCurve->new;
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($hx,$hy) = $hilbert->n_to_xy($n);
my ($px,$py) = $peano->n_to_xy($n);
push @got, ($px-$hx)**2 + ($py-$hy)**2;
}
return \@got;
});
#------------------------------------------------------------------------------
# A165467 -- N where Hilbert and Peano same X,Y
MyOEIS::compare_values
(anum => 'A165467',
max_value => 100000,
func => sub {
my ($count) = @_;
require Math::PlanePath::PeanoCurve;
my $peano = Math::PlanePath::PeanoCurve->new;
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($hx,$hy) = $hilbert->n_to_xy($n);
my ($px,$py) = $peano->n_to_xy($n);
if ($hx == $py && $hy == $px) {
push @got, $n;
}
}
return \@got;
});
# A165465 -- N where Hilbert and Peano same X,Y
MyOEIS::compare_values
(anum => 'A165465',
max_value => 100000,
func => sub {
my ($count) = @_;
require Math::PlanePath::PeanoCurve;
my $peano = Math::PlanePath::PeanoCurve->new;
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($hx,$hy) = $hilbert->n_to_xy($n);
my ($px,$py) = $peano->n_to_xy($n);
if ($hx == $px && $hy == $py) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A163538 -- dX
# extra first entry for N=0 no change
MyOEIS::compare_values
(anum => 'A163538',
func => sub {
my ($count) = @_;
my @got = (0);
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($dx, $dy) = $hilbert->n_to_dxdy ($n);
push @got, $dx;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163539 -- dY
# extra first entry for N=0 no change
MyOEIS::compare_values
(anum => 'A163539',
func => sub {
my ($count) = @_;
my @got = (0);
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($dx, $dy) = $hilbert->n_to_dxdy ($n);
push @got, $dy;
}
return \@got;
});
#------------------------------------------------------------------------------
# A166041 - N in Peano order
MyOEIS::compare_values
(anum => 'A166041',
func => sub {
my ($count) = @_;
require Math::PlanePath::PeanoCurve;
my $peano = Math::PlanePath::PeanoCurve->new;
my @got;
for (my $n = $peano->n_start; @got < $count; $n++) {
my ($x, $y) = $peano->n_to_xy($n);
push @got, $hilbert->xy_to_n ($x, $y);
}
return \@got;
});
# inverse Peano in Hilbert order
MyOEIS::compare_values
(anum => 'A166042',
func => sub {
my ($count) = @_;
require Math::PlanePath::PeanoCurve;
my $peano = Math::PlanePath::PeanoCurve->new;
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($x, $y) = $hilbert->n_to_xy($n);
push @got, $peano->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163540 -- absolute direction 0=east, 1=south, 2=west, 3=north
# Y coordinates reckoned down the page, so south is Y increasing
MyOEIS::compare_values
(anum => 'A163540',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($dx, $dy) = $hilbert->n_to_dxdy ($n);
push @got, MyOEIS::dxdy_to_direction ($dx, $dy);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163909 - num 3-cycles in 4^k blocks, even k only
MyOEIS::compare_values
(anum => 'A163909',
max_count => 5,
func => sub {
my ($bvalues_count) = @_;
my @got;
my $target = 1;
my $target_even = 1;
my $count = 0;
my @seen;
for (my $n = 0; @got < $bvalues_count; $n++) {
if ($n >= $target) {
if ($target_even) {
push @got, $count;
}
$target_even ^= 1;
$count = 0;
$target *= 4;
@seen = ();
$#seen = $target; # pre-extend
}
unless ($seen[$n]) {
my $p1 = zorder_perm($n);
next if $p1 == $n; # a fixed point
my $p2 = zorder_perm($p1);
next if $p2 == $n; # a 2-cycle
my $p3 = zorder_perm($p2);
next unless $p3 == $n; # not a 3-cycle
$count++;
$seen[$n] = 1;
$seen[$p1] = 1;
$seen[$p2] = 1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A163914 - num 3-cycles in 4^k blocks
MyOEIS::compare_values
(anum => 'A163914',
max_count => 8,
func => sub {
my ($bvalues_count) = @_;
my @got;
my $target = 1;
my $count = 0;
my @seen;
for (my $n = 0; @got < $bvalues_count; $n++) {
if ($n >= $target) {
push @got, $count;
$count = 0;
$target *= 4;
@seen = ();
$#seen = $target; # pre-extend
}
unless ($seen[$n]) {
my $p1 = zorder_perm($n);
next if $p1 == $n; # a fixed point
my $p2 = zorder_perm($p1);
next if $p2 == $n; # a 2-cycle
my $p3 = zorder_perm($p2);
next unless $p3 == $n; # not a 3-cycle
$count++;
$seen[$n] = 1;
$seen[$p1] = 1;
$seen[$p2] = 1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A163908 - perm twice, by diagonals, inverse
MyOEIS::compare_values
(anum => 'A163908',
func => sub {
my ($count) = @_;
my @got;
my $diagonal = Math::PlanePath::Diagonals->new
(direction => 'up'); # from same axis as Hilbert
for (my $n = 0; @got < $count; $n++) {
my $nn = zorder_perm_inverse(zorder_perm_inverse($n));
my ($x, $y) = $zorder->n_to_xy ($nn);
my $dn = $diagonal->xy_to_n ($x, $y);
push @got, $dn-1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163907 - perm twice, by diagonals
MyOEIS::compare_values
(anum => 'A163907',
func => sub {
my ($count) = @_;
my @got;
my $diagonal = Math::PlanePath::Diagonals->new
(direction => 'up'); # from same axis as Hilbert
for (my $dn = $diagonal->n_start; @got < $count; $dn++) {
my ($x, $y) = $diagonal->n_to_xy ($dn);
my $n = $zorder->xy_to_n ($x, $y);
push @got, zorder_perm(zorder_perm($n));
}
return \@got;
});
#------------------------------------------------------------------------------
# A163904 - cycle length by diagonals
MyOEIS::compare_values
(anum => 'A163904',
func => sub {
my ($count) = @_;
my @got;
my $diagonal = Math::PlanePath::Diagonals->new
(direction => 'up'); # from same axis as Hilbert
for (my $dn = $diagonal->n_start; @got < $count; $dn++) {
my ($x, $y) = $diagonal->n_to_xy ($dn);
my $hn = $hilbert->xy_to_n ($x, $y);
push @got, zorder_cycle_length($hn);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163890 - cycle length by N
MyOEIS::compare_values
(anum => 'A163890',
max_count => 10000,
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
push @got, zorder_cycle_length($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163912 - LCM of cycle lengths in 4^k blocks
MyOEIS::compare_values
(anum => 'A163912',
max_count => 6,
func => sub {
my ($count) = @_;
my @got;
my $target = 1;
my $max = 0;
my %lengths;
for (my $n = 0; @got < $count; $n++) {
if ($n >= $target) {
push @got, lcm(keys %lengths);
$target *= 4;
%lengths = ();
}
$lengths{zorder_cycle_length($n)} = 1;
}
return \@got;
});
use Math::PlanePath::GcdRationals;
sub lcm {
my $lcm = 1;
foreach my $n (@_) {
my $gcd = Math::PlanePath::GcdRationals::_gcd($lcm,$n);
$lcm = $lcm * $n / $gcd;
}
return $lcm;
}
#------------------------------------------------------------------------------
# A163911 - max cycle in 4^k blocks
MyOEIS::compare_values
(anum => 'A163911',
max_count => 7,
func => sub {
my ($count) = @_;
my @got;
my $target = 1;
my $max = 0;
for (my $n = 0; @got < $count; $n++) {
if ($n >= $target) {
push @got, $max;
$max = 0;
$target *= 4;
}
$max = max ($max, zorder_cycle_length($n));
}
return \@got;
});
#------------------------------------------------------------------------------
# A163910 - num cycles in 4^k blocks
MyOEIS::compare_values
(anum => 'A163910',
max_count => 9,
func => sub {
my ($bvalues_count) = @_;
my @got;
my $target = 1;
my $count = 0;
my @seen;
for (my $n = 0; @got < $bvalues_count; $n++) {
if ($n >= $target) {
push @got, $count;
$count = 0;
$target *= 4;
@seen = ();
$#seen = $target; # pre-extend
}
$count++;
my $p = $n;
for (;;) {
$p = zorder_perm($p);
if ($seen[$p]) {
$count--;
last;
}
$seen[$p] = 1;
last if $p == $n;
}
$seen[$n] = 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163355 - in Z order sequence
MyOEIS::compare_values
(anum => 'A163355',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
push @got, zorder_perm($n);
}
return \@got;
});
# A163356 - inverse
MyOEIS::compare_values
(anum => 'A163356',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
my ($x, $y) = $hilbert->n_to_xy ($n);
push @got, $zorder->xy_to_n ($x, $y);
}
return \@got;
});
# A163905 - applied twice
MyOEIS::compare_values
(anum => 'A163905',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
push @got, zorder_perm(zorder_perm($n));
}
return \@got;
});
# A163915 - applied three times
# A163905 - applied twice
MyOEIS::compare_values
(anum => 'A163915',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
push @got, zorder_perm(zorder_perm(zorder_perm($n)));
}
return \@got;
});
# A163901 - fixed-point N values
MyOEIS::compare_values
(anum => 'A163901',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
if (zorder_perm($n) == $n) {
push @got, $n;
}
}
return \@got;
});
# A163902 - 2-cycle N values
MyOEIS::compare_values
(anum => 'A163902',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
if (zorder_is_2cycle($n)) {
push @got, $n;
}
}
return \@got;
});
# A163903 - 3-cycle N values
MyOEIS::compare_values
(anum => 'A163903',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
if (zorder_is_3cycle($n)) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A163357 - in diagonal sequence
MyOEIS::compare_values
(anum => 'A163357',
func => sub {
my ($count) = @_;
my @got;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down',
n_start => 0);
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($y, $x) = $diagonal->n_to_xy ($n);
push @got, $hilbert->xy_to_n ($x, $y);
}
return \@got;
});
# A163358 - inverse
MyOEIS::compare_values
(anum => 'A163358',
func => sub {
my ($count) = @_;
my @got;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down',
n_start => 0);
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($y, $x) = $hilbert->n_to_xy ($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163359 - in diagonal sequence, opp sides
MyOEIS::compare_values
(anum => 'A163359',
func => sub {
my ($count) = @_;
my @got;
my $diagonal = Math::PlanePath::Diagonals->new
(direction => 'down'); # from opposite side
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $hilbert->xy_to_n ($x, $y);
}
return \@got;
});
# A163360 - inverse
MyOEIS::compare_values
(anum => 'A163360',
func => sub {
my ($count) = @_;
my @got;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down',
n_start => 0);
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($x, $y) = $hilbert->n_to_xy ($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163361 - diagonal sequence, one based, same side
MyOEIS::compare_values
(anum => 'A163361',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $hilbert->xy_to_n ($x, $y) + 1; # 1-based Hilbert
}
return \@got;
});
# A163362 - inverse
MyOEIS::compare_values
(anum => 'A163362',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($x, $y) = $hilbert->n_to_xy ($n);
push @got, $diagonal->xy_to_n ($x, $y); # 1-based Hilbert
}
return \@got;
});
#------------------------------------------------------------------------------
# A163363 - diagonal sequence, one based, opp sides
MyOEIS::compare_values
(anum => 'A163363',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $hilbert->xy_to_n ($x, $y) + 1;
}
return \@got;
});
# A163364 - inverse
MyOEIS::compare_values
(anum => 'A163364',
func => sub {
my ($count) = @_;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $hilbert->n_start; @got < $count; $n++) {
my ($x, $y) = $hilbert->n_to_xy ($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163365 - diagonal sums
MyOEIS::compare_values
(anum => 'A163365',
func => sub {
my ($count) = @_;
my @got;
for (my $d = 0; @got < $count; $d++) {
my $sum = 0;
foreach my $x (0 .. $d) {
my $y = $d - $x;
$sum += $hilbert->xy_to_n ($x, $y);
}
push @got, $sum;
}
return \@got;
});
# A163477 - diagonal sums divided by 4
MyOEIS::compare_values
(anum => 'A163477',
func => sub {
my ($count) = @_;
my @got;
for (my $d = 0; @got < $count; $d++) {
my $sum = 0;
foreach my $x (0 .. $d) {
my $y = $d - $x;
$sum += $hilbert->xy_to_n ($x, $y);
}
push @got, int($sum/4);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/DragonMidpoint-oeis.t 0000644 0001750 0001750 00000013570 12563463163 017350 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 26;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::DragonMidpoint;
# uncomment this to run the ### lines
# use Smart::Comments '###';
#------------------------------------------------------------------------------
# A090678 turn=1 straight=0, except A090678 has extra initial 1,1
MyOEIS::compare_values
(anum => 'A090678',
func => sub {
my ($count) = @_;
my @got = (1,1);
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath=>'DragonMidpoint',
turn_type => 'LSR');
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, abs($value);
}
return \@got;
});
#------------------------------------------------------------------------------
# A203175 figure boundary length to N=2^k-1
MyOEIS::compare_values
(anum => 'A203175',
name => 'boundary length',
max_value => 10_000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::DragonMidpoint->new;
my @got = (1,1,2);
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_n_to_figure_boundary($path, 2**$k-1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A077860 -- Y at N=2^k, starting k=1 N=2
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
# Re -(i+1)^k + i-1
{
require Math::Complex;
my $path = Math::PlanePath::DragonMidpoint->new;
my $b = Math::Complex->make(1,1);
foreach my $k (1 .. 10) {
my $n = 2**$k;
my ($x,$y) = $path->n_to_xy($n);
my $c = $b; foreach (1 .. $k) { $c *= $b; }
$c *= Math::Complex->make(0,-1);
$c += Math::Complex->make(-1,1);
ok ($c->Re, $x);
ok ($c->Im, $y);
# print $x,",";
# print $c->Re,",";
# print $c->Im,",";
}
}
MyOEIS::compare_values
(anum => 'A077860',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::DragonMidpoint->new;
my @got;
for (my $n = $bigclass->new(2); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A073089 -- abs(dY), so 1 if step vertical, 0 if horizontal
# with extra leading 0
MyOEIS::compare_values
(anum => 'A073089',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::DragonMidpoint->new;
my @got = (0);
my ($prev_x, $prev_y) = $path->n_to_xy (0);
for (my $n = $path->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
if ($x == $prev_x) {
push @got, 1; # vertical
} else {
push @got, 0; # horizontal
}
($prev_x,$prev_y) = ($x,$y);
}
return \@got;
});
# A073089_func vs b-file
MyOEIS::compare_values
(anum => q{A073089},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 1; @got < $count; $n++) {
push @got, A073089_func($n);
}
return \@got;
});
# A073089_func vs path
{
my $path = Math::PlanePath::DragonMidpoint->new;
my ($prev_x, $prev_y) = $path->n_to_xy (0);
my $bad = 0;
foreach my $n (0 .. 0x2FFF) {
my ($x, $y) = $path->n_to_xy ($n);
my ($nx, $ny) = $path->n_to_xy ($n+1);
my $path_value = ($x == $nx
? 1 # vertical
: 0); # horizontal
my $a_value = A073089_func($n+2);
if ($path_value != $a_value) {
MyTestHelpers::diag ("diff n=$n path=$path_value acalc=$a_value");
MyTestHelpers::diag (" xy=$x,$y nxy=$nx,$ny");
last if ++$bad > 10;
}
}
ok ($bad, 0, "A073089_func()");
}
sub A073089_func {
my ($n) = @_;
### A073089_func: $n
for (;;) {
if ($n <= 1) { return 0; }
if (($n % 4) == 2) { return 0; }
if (($n % 8) == 7) { return 0; }
if (($n % 16) == 13) { return 0; }
if (($n % 4) == 0) { return 1; }
if (($n % 8) == 3) { return 1; }
if (($n % 16) == 5) { return 1; }
if (($n % 8) == 1) {
$n = ($n-1)/2+1; # 8n+1 -> 4n+1
next;
}
die "oops";
}
}
# absdy_bitwise() vs path
{
my $path = Math::PlanePath::DragonMidpoint->new;
my ($prev_x, $prev_y) = $path->n_to_xy (0);
my $bad = 0;
foreach my $n (0 .. 0x2FFF) {
my ($x, $y) = $path->n_to_xy ($n);
my ($nx, $ny) = $path->n_to_xy ($n+1);
my $path_value = ($x == $nx
? 1 # vertical
: 0); # horizontal
my $a_value = absdy_bitwise($n);
if ($path_value != $a_value) {
MyTestHelpers::diag ("diff n=$n path=$path_value acalc=$a_value");
MyTestHelpers::diag (" xy=$x,$y nxy=$nx,$ny");
last if ++$bad > 10;
}
}
ok ($bad, 0, "absdy_bitwise()");
}
sub absdy_bitwise {
my ($n) = @_;
return ($n & 1) ^ bit_above_lowest_zero($n);
}
sub bit_above_lowest_zero {
my ($n) = @_;
for (;;) {
if (($n % 2) == 0) {
last;
}
$n = int($n/2);
}
$n = int($n/2);
return ($n % 2);
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/FractionsTree-oeis.t 0000644 0001750 0001750 00000006442 12563466242 017203 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 2;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::FractionsTree;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A093873 -- Kepler numerators
# {
# my $path = Math::PlanePath::FractionsTree->new (tree_type => 'Kepler');
# my $anum = 'A093873';
# my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
# my @got;
# if ($bvalues) {
# foreach my $n (1 .. @$bvalues) {
# my ($x, $y) = $path->n_to_xy (int(($n+1)/2));
# push @got, $x;
# }
# }
# skip (! $bvalues,
# numeq_array(\@got, $bvalues),
# 1, "$anum -- Kepler tree numerators");
# }
#
# sub sans_high_bit {
# my ($n) = @_;
# return $n ^ high_bit($n);
# }
# sub high_bit {
# my ($n) = @_;
# my $bit;
# for ($bit = 1; $bit <= $n; $bit <<= 1) {
# $bit <<= 1;
# }
# return $bit >> 1;
# }
#------------------------------------------------------------------------------
# A093875 -- Kepler denominators
# {
# my $path = Math::PlanePath::FractionsTree->new (tree_type => 'Kepler');
# my $anum = 'A093875';
# my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
# my @got;
# if ($bvalues) {
# foreach my $n (2 .. @$bvalues) {
# my ($x, $y) = $path->n_to_xy (int($n/2));
# push @got, $y;
# }
# }
# skip (! $bvalues,
# numeq_array(\@got, $bvalues),
# 1, "$anum -- Kepler tree denominators");
# }
#------------------------------------------------------------------------------
# A086593 -- Kepler half-tree denominators, every second value
MyOEIS::compare_values
(anum => 'A086593',
name => 'Kepler half-tree denominators every second value',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::FractionsTree->new (tree_type => 'Kepler');
for (my $n = $path->n_start; @got < $count; $n += 2) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y;
}
return \@got;
});
# is also the sum X+Y, skipping initial 2
MyOEIS::compare_values
(anum => q{A086593},
name => 'as sum X+Y',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::FractionsTree->new (tree_type => 'Kepler');
my @got = (2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x+$y;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/CoprimeColumns-oeis.t 0000644 0001750 0001750 00000017241 12136177302 017361 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 10;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::CoprimeColumns;
# uncomment this to run the ### lines
# use Smart::Comments '###';
my $path = Math::PlanePath::CoprimeColumns->new;
#------------------------------------------------------------------------------
# A127368 - Y coordinate of coprimes, 0 for non-coprimes
{
my $anum = 'A127368';
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my $good = 1;
my $count = 0;
if ($bvalues) {
my $x = 1;
my $y = 1;
for (my $i = 0; $i < @$bvalues; $i++) {
my $want = $bvalues->[$i];
my $got = (Math::PlanePath::CoprimeColumns::_coprime($x,$y)
? $y : 0);
if ($got != $want) {
MyTestHelpers::diag ("wrong _coprime($x,$y)=$got want=$want at i=$i of $filename");
$good = 0;
}
$y++;
if ($y > $x) {
$x++;
$y = 1;
}
$count++;
}
}
ok ($good, 1, "$anum count $count");
}
MyOEIS::compare_values
(anum => q{A127368},
func => sub {
my ($count) = @_;
my @got;
OUTER: for (my $x = 1; ; $x++) {
foreach my $y (1 .. $x) {
if ($path->xy_is_visited($x,$y)) {
push @got, $y;
} else {
push @got, 0;
}
last OUTER if @got >= $count;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A179594 - column of nxn unvisited block
# is X here but Y in A179594 since it goes as rows of coprimes rather than
# columns
MyOEIS::compare_values
(anum => 'A179594',
max_count => 3,
func => sub {
my ($count) = @_;
my @got;
my $x = 1;
for (my $size = 1; @got < $count; $size++) {
for ( ; ! have_unvisited_square($x,$size); $x++) {
}
push @got, $x;
}
return \@got;
});
# return true if there's a $size by $size unvisited square somewhere in
# column $x
sub have_unvisited_square {
my ($x, $size) = @_;
### have_unvisited_square(): $x,$size
my $count = 0;
foreach my $y (2 .. $x) {
if (have_unvisited_line($x,$y,$size)) {
$count++;
if ($count >= $size) {
### found at: "x=$x, y=$y count=$count"
return 1;
}
} else {
$count = 0;
}
}
return 0;
}
# return true if $x,$y is the start (the leftmost point) of a $size length
# line of unvisited points
sub have_unvisited_line {
my ($x,$y, $size) = @_;
foreach my $i (0 .. $size-1) {
if ($path->xy_is_visited($x,$y)) {
return 0;
}
$x++;
}
return 1;
}
#------------------------------------------------------------------------------
# A002088 - totient sum along X axis, or diagonal of n_start=1
MyOEIS::compare_values
(anum => 'A002088',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CoprimeColumns->new (n_start => 1);
my @got = (0, 1);
for (my $x = 2; @got < $count; $x++) {
push @got, $path->xy_to_n($x,$x-1);
}
return \@got;
});
MyOEIS::compare_values
(anum => qq{A002088},
func => sub {
my ($count) = @_;
my @got;
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n($x,1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054428 - inverse, permutation SB N -> coprime columns N
MyOEIS::compare_values
(anum => 'A054428',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::RationalsTree;
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
for (my $n = 0; @got < $count; $n++) {
my $sn = insert_second_highest_bit_one($n);
my ($x,$y) = $sb->n_to_xy ($sn);
### sb: "$x/$y"
my $cn = $path->xy_to_n($x,$y);
if (! defined $cn) {
die "oops, SB $x,$y";
}
push @got, $cn+1;
}
return \@got;
});
sub insert_second_highest_bit_one {
my ($n) = @_;
my $str = sprintf ('%b', $n);
substr($str,1,0) = '1';
return oct("0b$str");
}
# # ### assert: delete_second_highest_bit(1) == 1
# # ### assert: delete_second_highest_bit(2) == 1
# ### assert: delete_second_highest_bit(4) == 2
# ### assert: delete_second_highest_bit(5) == 3
#------------------------------------------------------------------------------
# A054427 - permutation coprime columns N -> SB N
MyOEIS::compare_values
(anum => 'A054427',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::RationalsTree;
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'SB');
my $n = 0;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy ($n++);
### frac: "$x/$y"
my $sn = $sb->xy_to_n($x,$y);
push @got, delete_second_highest_bit($sn) + 1;
}
return \@got;
});
sub delete_second_highest_bit {
my ($n) = @_;
my $bit = 1;
my $ret = 0;
while ($bit <= $n) {
$ret |= ($n & $bit);
$bit <<= 1;
}
$bit >>= 1;
$ret &= ~$bit;
$bit >>= 1;
$ret |= $bit;
# ### $ret
# ### $bit
return $ret;
}
# ### assert: delete_second_highest_bit(1) == 1
# ### assert: delete_second_highest_bit(2) == 1
### assert: delete_second_highest_bit(4) == 2
### assert: delete_second_highest_bit(5) == 3
#------------------------------------------------------------------------------
# A121998 - list of <=k with a common factor
MyOEIS::compare_values
(anum => 'A121998',
func => sub {
my ($count) = @_;
my @got;
OUTER: for (my $x = 2; ; $x++) {
for (my $y = 1; $y <= $x; $y++) {
if (! $path->xy_is_visited($x,$y)) {
push @got, $y;
last OUTER unless @got < $count;
}
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A054521 - by columns 1 if coprimes, 0 if not
{
my $anum = 'A054521';
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
{
my $good = 1;
my $count = 0;
if ($bvalues) {
my $x = 1;
my $y = 1;
for (my $i = 0; $i < @$bvalues; $i++) {
my $want = $bvalues->[$i];
my $got = (Math::PlanePath::CoprimeColumns::_coprime($x,$y)
? 1 : 0);
if ($got != $want) {
MyTestHelpers::diag ("wrong _coprime($x,$y)=$got want=$want at i=$i of $filename");
$good = 0;
}
$y++;
if ($y > $x) {
$x++;
$y = 1;
}
$count++;
}
}
ok ($good, 1, "$anum count $count");
}
}
MyOEIS::compare_values
(anum => q{A054521},
func => sub {
my ($count) = @_;
my @got;
OUTER: for (my $x = 1; ; $x++) {
foreach my $y (1 .. $x) {
if ($path->xy_is_visited($x,$y)) {
push @got, 1;
} else {
push @got, 0;
}
last OUTER if @got >= $count;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/FactorRationals-oeis.t 0000644 0001750 0001750 00000015352 12264602510 017512 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 14;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::FactorRationals;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $path = Math::PlanePath::FactorRationals->new;
#------------------------------------------------------------------------------
# A053985 - negabinary pos->pn
MyOEIS::compare_values
(anum => 'A053985',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::FactorRationals;
for (my $i = 0; @got < $count; $i++) {
push @got, Math::PlanePath::FactorRationals::_pos_to_pn__negabinary($i);
}
return \@got;
});
# A005351 pn(+ve) -> pos
MyOEIS::compare_values
(anum => 'A005351',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::FactorRationals;
for (my $i = 0; @got < $count; $i++) {
push @got, Math::PlanePath::FactorRationals::_pn_to_pos__negabinary($i);
}
return \@got;
});
# A039724 pn(+ve) -> pos, in binary
MyOEIS::compare_values
(anum => 'A039724',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::FactorRationals;
for (my $i = 0; @got < $count; $i++) {
push @got, sprintf('%b', Math::PlanePath::FactorRationals::_pn_to_pos__negabinary($i));
}
return \@got;
});
# A005352 pn(-ve) -> pos
MyOEIS::compare_values
(anum => 'A005352',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::FactorRationals;
for (my $i = -1; @got < $count; $i--) {
push @got, Math::PlanePath::FactorRationals::_pn_to_pos__negabinary($i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A065620 - revbinary pos->pn
MyOEIS::compare_values
(anum => 'A065620',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::FactorRationals;
for (my $i = 1; @got < $count; $i++) {
push @got, Math::PlanePath::FactorRationals::_pos_to_pn__revbinary($i);
}
return \@got;
});
# A065621 pn(+ve) -> pos
MyOEIS::compare_values
(anum => 'A065621',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::FactorRationals;
for (my $i = 1; @got < $count; $i++) {
push @got, Math::PlanePath::FactorRationals::_pn_to_pos__revbinary($i);
}
return \@got;
});
# A048724 pn(-ve) -> pos n XOR 2n
MyOEIS::compare_values
(anum => 'A048724',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::FactorRationals;
for (my $i = 0; @got < $count; $i--) {
push @got, Math::PlanePath::FactorRationals::_pn_to_pos__revbinary($i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A072345 -- X or Y at N=2^k, being alternately 1 and 2^k
MyOEIS::compare_values
(anum => 'A072345',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 2; @got < $count; $n *= 2) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x;
# last unless @got < $count;
# push @got, $y;
}
return\@got;
});
MyOEIS::compare_values
(anum => q{A072345},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 1; @got < $count; $n *= 2) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y;
}
return\@got;
});
#------------------------------------------------------------------------------
# A011262 -- N at transpose Y/X, incr odd powers, decr even powers
# cf A011264 prime factorization decr odd powers, incr even powers
MyOEIS::compare_values
(anum => 'A011262',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return\@got;
});
sub calc_A011262 {
my ($n) = @_;
my $ret = 1;
for (my $p = 2; $p <= $n; $p++) {
if (($n % $p) == 0) {
my $count = 0;
while (($n % $p) == 0) {
$n /= $p;
$count++;
}
$count = ($count & 1 ? $count+1 : $count-1);
# $count++;
# $count ^= 1;
# $count--;
$ret *= $p ** $count;
}
}
return $ret;
}
MyOEIS::compare_values
(anum => 'A011262',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, calc_A011262($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A102631 - n^2/squarefreekernel(n), is column at X=1
MyOEIS::compare_values
(anum => 'A102631',
func => sub {
my ($count) = @_;
my @got;
for (my $y = 1; @got < $count; $y++) {
push @got, $path->xy_to_n (1, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A060837 - permutation DiagonalRationals N -> FactorRationals N
MyOEIS::compare_values
(anum => 'A060837',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::DiagonalRationals;
my $columns = Math::PlanePath::DiagonalRationals->new;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $columns->n_to_xy ($n);
push @got, $path->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A071970 - permutation Stern a[i]/[ai+1] which is Calkin-Wilf N -> power N
MyOEIS::compare_values
(anum => 'A071970',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::RationalsTree;
my $sb = Math::PlanePath::RationalsTree->new (tree_type => 'CW');
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $sb->n_to_xy ($n);
push @got, $path->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/PentSpiral-oeis.t 0000644 0001750 0001750 00000003433 12563472235 016510 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 2;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::PentSpiral;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A140066 - N on Y axis
MyOEIS::compare_values
(anum => 'A140066',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PentSpiral->new;
my @got;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A134238 - N on South-West diagonal
MyOEIS::compare_values
(anum => 'A134238',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PentSpiral->new;
my @got;
for (my $i = 0; @got < $count; $i++) {
push @got, $path->xy_to_n(-$i,-$i);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/CCurve-oeis.t 0000644 0001750 0001750 00000022234 12563464775 015630 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 7;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::CCurve;
# uncomment this to run the ### lines
# use Smart::Comments '###';
my $path = Math::PlanePath::CCurve->new;
# return 0,1,2,3 turn
sub path_n_turn {
my ($path, $n) = @_;
my $prev_dir = path_n_dir ($path, $n-1);
my $dir = path_n_dir ($path, $n);
return ($dir - $prev_dir) % 4;
}
# return 0,1,2,3
sub path_n_dir {
my ($path, $n) = @_;
my ($dx,$dy) = $path->n_to_dxdy($n) or die "Oops, no point at ",$n;
return dxdy_to_dir4 ($dx, $dy);
}
# return 0,1,2,3, with Y reckoned increasing upwards
sub dxdy_to_dir4 {
my ($dx, $dy) = @_;
if ($dx > 0) { return 0; } # east
if ($dx < 0) { return 2; } # west
if ($dy > 0) { return 1; } # north
if ($dy < 0) { return 3; } # south
}
sub right_boundary {
my ($n_end) = @_;
return MyOEIS::path_boundary_length ($path, $n_end, side => 'right');
}
use Memoize;
Memoize::memoize('right_boundary');
#------------------------------------------------------------------------------
# A096268 - morphism turn 1=straight,0=not-straight
# but OFFSET=0 is turn at N=1, so "next turn"
MyOEIS::compare_values
(anum => 'A096268',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'CCurve',
turn_type => 'Straight');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A096268},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
push @got, count_low_1_bits($n) % 2;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A096268},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 0; @got < $count; $n++) {
push @got, count_low_0_bits($n+1) % 2;
}
return \@got;
});
sub count_low_1_bits {
my ($n) = @_;
my $count = 0;
while ($n % 2) {
$count++;
$n = int($n/2);
}
return $count;
}
sub count_low_0_bits {
my ($n) = @_;
if ($n == 0) { die; }
my $count = 0;
until ($n % 2) {
$count++;
$n /= 2;
}
return $count;
}
#------------------------------------------------------------------------------
# A038503 etc counts of segments in direction
foreach my $elem ([0, 'A038503', 0],
[1, 'A038504', 0],
[2, 'A038505', 1],
[3, 'A000749', 0]) {
my ($dir, $anum, $initial_k) = @$elem;
MyOEIS::compare_values
(anum => $anum,
max_value => 100_000,
func => sub {
my ($count) = @_;
my @got;
my $n = $path->n_start;
my $total = 0;
my $k = $initial_k;
while (@got < $count) {
my $n_end = 2**$k;
for ( ; $n < $n_end; $n++) {
$total += (dxdy_to_dir4($path->n_to_dxdy($n)) == $dir);
}
push @got, $total;
$k++;
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A007814 - count low 0s, is turn right - 1
MyOEIS::compare_values
(anum => 'A007814',
fixup => sub {
my ($bvalues) = @_;
@$bvalues = map {$_ % 4} @$bvalues;
},
func => sub {
my ($count) = @_;
my @got;
my $total_turn = 0;
for (my $n = $path->n_start + 1; @got < $count; $n++) {
push @got, (1 - path_n_turn($path,$n)) % 4; # negate to right
}
return \@got;
});
#------------------------------------------------------------------------------
# A003159 - positions ending even 0 bits is where turn either left or right
MyOEIS::compare_values
(anum => 'A003159',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my @got;
while (@got < $count) {
my ($i, $lsr) = $seq->next;
if ($lsr) { # left or right
push @got, $i;
}
}
return \@got;
});
# A036554 - positions ending odd 0 bits is where turn straight or reverse
MyOEIS::compare_values
(anum => 'A036554',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my @got;
while (@got < $count) {
my ($i, $lsr) = $seq->next;
if ($lsr == 0) { # straight
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A027383 right boundary differences
# cf
# CCurve right boundary diffs even terms
# 6,14,30,62,126
# A000918 2^n - 2.
# CCurve right boundary diffs odd terms
# 10,22,46,94,190
# A033484 3*2^n - 2.
MyOEIS::compare_values
(anum => 'A027383',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got = (1);
for (my $k = 1; @got < $count; $k++) {
my $b1 = right_boundary(2**$k);
my $b2 = right_boundary(2**($k+1));
push @got, $b2 - $b1;
}
return \@got;
});
# A131064 right boundary odd powers, extra initial 1
MyOEIS::compare_values
(anum => 'A131064',
max_value => 50_000,
func => sub {
my ($count) = @_;
my @got = (1);
for (my $k = 1; @got < $count; $k++) {
my $boundary = right_boundary(2**(2*$k-1)); # 1,3,5,..
push @got, $boundary;
### at: "k=$k $boundary"
}
return \@got;
});
#------------------------------------------------------------------------------
# A035263 - morphism turn 0=straight, 1=not-straight
MyOEIS::compare_values
(anum => 'A035263',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'CCurve',
turn_type => 'LSR');
my @got;
for (my $n = 1; @got < $count; $n++) {
my ($i,$value) = $seq->next;
push @got, $value == 0 ? 0 : 1;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A035263},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 1; @got < $count; $n++) {
push @got, (count_low_0_bits($n) + 1) % 2;
}
return \@got;
});
#------------------------------------------------------------------------------
# A104488 -- num Hamiltonian groups
# No, different at n=67 and more
#
# MyOEIS::compare_values
# (anum => 'A104488',
# func => sub {
# my ($count) = @_;
# require Math::NumSeq::PlanePathTurn;
# my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'CCurve',
# turn_type => 'Right');
# my @got = (0,0,0,0);;
# while (@got < $count) {
# my ($i,$value) = $seq->next;
# push @got, $value;
# }
# return \@got;
# });
#------------------------------------------------------------------------------
# A146559 - (i+1)^k is X+iY at N=2^k
# A009545 - Im
# A146559 X at N=2^k, being Re((i+1)^k)
# A009545 Y at N=2^k, being Im((i+1)^k)
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
MyOEIS::compare_values
(anum => 'A146559',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $bigclass->new(1); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $x;
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A009545',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $bigclass->new(1); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A000120 - count 1 bits total turn
MyOEIS::compare_values
(anum => 'A000120',
fixup => sub {
my ($bvalues) = @_;
@$bvalues = map {$_ % 4} @$bvalues;
},
func => sub {
my ($count) = @_;
my @got = (0);
my $total_turn = 0;
for (my $n = $path->n_start + 1; @got < $count; $n++) {
$total_turn += path_n_turn($path,$n);
push @got, $total_turn % 4;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/PyramidSpiral-oeis.t 0000644 0001750 0001750 00000007657 12136177277 017227 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# A217295 Permutation of natural numbers arising from applying the walk of triangular horizontal-last spiral (defined in A214226) to the data of square spiral (e.g. A214526).
# A214227 -- sum of 4 neighbours horizontal-last
use 5.004;
use strict;
use Test;
plan tests => 4;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::PyramidSpiral;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A217013 - inverse permutation, SquareSpiral -> PyramidSpiral
# X,Y in SquareSpiral order, N of PyramidSpiral
MyOEIS::compare_values
(anum => 'A217013',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $pyramid = Math::PlanePath::PyramidSpiral->new;
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $square->n_start; @got < $count; $n++) {
my ($x, $y) = $square->n_to_xy($n);
($x,$y) = (-$y,$x); # rotate +90
push @got, $pyramid->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A217294 - permutation PyramidSpiral -> SquareSpiral
# X,Y in PyramidSpiral order, N of SquareSpiral
# but A217294 conceived by square spiral going up and clockwise
# and pyramid spiral going left and clockwise
# which means rotate -90 here
MyOEIS::compare_values
(anum => 'A217294',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $pyramid = Math::PlanePath::PyramidSpiral->new;
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $pyramid->n_start; @got < $count; $n++) {
my ($x, $y) = $pyramid->n_to_xy($n);
($x,$y) = ($y,-$x); # rotate -90
push @got, $square->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A053615 -- distance to pronic is abs(X)
MyOEIS::compare_values
(anum => 'A053615',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PyramidSpiral->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, abs($x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A214250 -- sum of 8 neighbours N
MyOEIS::compare_values
(anum => 'A214250',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PyramidSpiral->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, ($path->xy_to_n($x+1,$y)
+ $path->xy_to_n($x-1,$y)
+ $path->xy_to_n($x,$y+1)
+ $path->xy_to_n($x,$y-1)
+ $path->xy_to_n($x+1,$y+1)
+ $path->xy_to_n($x-1,$y-1)
+ $path->xy_to_n($x-1,$y+1)
+ $path->xy_to_n($x+1,$y-1)
);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/MultipleRings-oeis.t 0000644 0001750 0001750 00000003671 12167160676 017234 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::MultipleRings;
use Test;
plan tests => 11;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments '###';
#------------------------------------------------------------------------------
# A090915 -- permutation X,-Y mirror across X axis
MyOEIS::compare_values
(anum => 'A090915',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::MultipleRings->new(step=>8);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x,$y) = ($x,-$y);
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A002024 - n repeated n times, is step=1 Radius+1
MyOEIS::compare_values
(anum => 'A002024',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::MultipleRings->new(step=>1);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, $path->n_to_radius($n) + 1;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/TriangularHypot-oeis.t 0000644 0001750 0001750 00000060055 12136177277 017572 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Maybe?
# A033686 One ninth of theta series of A2[hole]^2.
use 5.004;
use strict;
use Test;
plan tests => 22;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use List::Util 'min', 'max';
use Math::PlanePath::TriangularHypot;
# uncomment this to run the ### lines
# use Smart::Comments '###';
#------------------------------------------------------------------------------
# A005881 - theta of A2 centred on edge
# theta = num points of norm==n
# 4---------4 3,-1 = 3*3+3 = 12
# / \ / \ -3,-1 = 12
# / \ / \ 0, 2 = 0+3*2*2 = 12
# / \ / \
# / \ / \ 4,2 = 6*6+3*2*2 = 48
# 3---------2---------3 -4,2 = 48
# / \ / \ / \ 0,-4 = 0+3*4*4 = 48
# / \ / \ / \
# / \ / \ / \
# / \ / \ / \
# 3---------1----*----1---------3
# \ / \ / \ /
# \ / \ / \ /
# \ / \ / \ /
# \ / \ / \ /
# 3---------2---------3
# . . . . . . 5
#
# . . . . . 4
#
# . 4 . 4 . . 3
#
# . . . . . . . 2
#
# . 3 . 2 . 3 . . 1
#
# . . . . . . . . . <- Y=0
#
# . . . 1 o 1 . . . 3 -1
#
# . . . . . . . . . -2
#
# . . 3 . 2 . 3. . . . -3
#
# . . . . . . . . . -4
#
# . . 4 . 4 . . . -5
#
# . . . . - . . . . -6
#
# X=0 1 2 3 4 5 6 7
sub xy_is_tedge {
my ($x, $y) = @_;
return ($y % 2 == 0 && ($x+$y) % 4 == 2);
}
MyOEIS::compare_values
(anum => q{A005881},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 4;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
if (! xy_is_tedge($x,$y)) {
$n++;
next;
}
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 8;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A004016 - count of points at distance n
MyOEIS::compare_values
(anum => 'A004016',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new;
my @got;
my $prev_h = 0;
my $num = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
my $h = ($x*$x + 3*$y*$y) / 4;
# Same when rotate -45 as per POD notes.
# ($x,$y) = (($x+$y)/2,
# ($y-$x)/2);
# $h = $x*$x + $x*$y + $y*$y;
if ($h == $prev_h) {
$num++;
} else {
$got[$prev_h] = $num;
$num = 1;
$prev_h = $h;
}
}
$#got = $count-1; # trim
foreach my $got (@got) { $got ||= 0 } # pad, mutate array
return \@got;
});
# A002324 num points of norm n, which is X^2+3*Y^2=4n with "even" points here
# divide by 6 for 1/6 wedge
# cf A004016 = 6*A002324 except for A004016(0)=1 skipped
# cf A033687 = A002324(3n+1)
MyOEIS::compare_values
(anum => q{A002324},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got;
my $n = $path->n_start + 1; # excluding N=0
my $num = 0;
my $want_norm = 4;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num/6;
$want_norm += 4;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A005929 - theta series hexagons midpoint of edge
# 2,0,0,0,0,0,4,0,0,0,0,0,4,0,0,0,0,0,4,0,0,0,0,0,2,0,0,0,0,0,4,0,
# . . . . . . 5
#
# . 3 . 3 . 4
#
# . . . . . . 3
#
# . 2 . . . 2 . 2
#
# . . . . . . . . 1
#
# . . . 1 o 1 . . . <- Y=0
#
# . . . . . . . . . . -1
#
# . . 2 . . . 2 . . -2
#
# . . . . . . . . . . -3
#
# . . . 3 . 3 . . . -4
#
# . . . . . . . . -5
#
# . . . . - . . . . -6
#
# 2 = 4*4+3*2*2 = 28
# 3 = 2*2+3*4*4 = 52
sub xy_is_hexedge {
my ($x, $y) = @_;
my $k = $x + 3*$y;
return ($y % 2 == 0 && ($k % 12 == 2 || $k % 12 == 10));
}
# foreach my $y (0 .. 20) {
# foreach my $x (0 .. 60) {
# print xy_is_hexedge($x,$y) ? '*' : ' ';
# }
# print "\n";
# }
MyOEIS::compare_values
(anum => q{A005929},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got = (0);
my $n = $path->n_start;
my $num = 0;
my $want_norm = 4;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
if (! xy_is_hexedge($x,$y)) {
$n++;
next;
}
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 4;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
# A045839 = A005929/2.
MyOEIS::compare_values
(anum => q{A045839},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got = (0);
my $n = $path->n_start;
my $num = 0;
my $want_norm = 4;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
if (! xy_is_hexedge($x,$y)) {
$n++;
next;
}
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num/2;
$want_norm += 4;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A038588 - clusters A2 centred deep hole
# 3, 6, 12, 18, 21, 27 ...
# unique values from A038587 = 3,6,12,12,18,21,27,27,30,
# which is partial sums A005882 theta relative hole,
# = 3,3,6,0,6,3,6,0,3,6,6,0,6,0,6,0,9,6,0,0,6
# theta = num points of norm==n
# 3---------3 3,-1 = 3*3+3 = 12
# / \ / \ -3,-1 = 12
# / \ / \ 0, 2 = 0+3*2*2 = 12
# / \ / \
# / \ / \ 4,2 = 6*6+3*2*2 = 48
# 2---------1---------2 -4,2 = 48
# / \ / \ / \ 0,-4 = 0+3*4*4 = 48
# / \ / \ / \
# / \ / * \ / \
# / \ / \ / \
# 3---------1---------1---------3
# \ / \ / \ /
# \ / \ / \ /
# \ / \ / \ /
# \ / \ / \ /
# 3---------2---------3
# . 3 . . 3 . 5
#
# . . . . . 4
#
# . . . . . . 3
#
# 2 . . 1 . . 2 2
#
# . . . . . . . . 1
#
# . . . . o . . . . <- Y=0
#
# 3 . . 1 . . 1 . . 3 -1
#
# . . . . . . . . . -2
#
# . . . . . . . . . . -3
#
# . 3 . . 2 . . 3 . -4
#
# . . . . . . . . -5
#
# . . . . - . . . . -6
# X=0 1 2 3 4 5 6 7
#
# X+Y=6k+2
# Y=3z+2
#
# block X mod 6, Y mod 6 only X=0,Y=2 and X=3,Y=5
# X+6Y mod 36 = 2*6=12 or 3+6*5=33 cf -3+6*-1=-9=
# shift down X=0,Y=0 X=3,Y=3 only
# X+6Y mod 36 = 0 or 3+6*3=21
#
# X=6k
# also rotate +120 -(X+3Y)/2 = 6k is X+3Y = 12k
# also rotate -120 (3Y-X)/2 = 6k is X-3Y = 12k
sub xy_is_tcentred {
my ($x, $y) = @_;
return ($y % 3 == 2 &&($x+$y) % 6 == 2);
# Wrong:
# my $k = ($x + 6*$y) % 36;
# return ($k == 0+6*2 || $k == 3+6*5);
}
# A033687 with zeros, full steps of norm, divide by 3
# cf A033687 = A002324(3n+1)
# A033687 = A005882 / 3
# A033687 = A033685(3n+1)
MyOEIS::compare_values
(anum => q{A033687},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 12;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
if (! xy_is_tcentred($x,$y)) {
$n++;
next;
}
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num/3;
$want_norm += 36;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
# 0, 3, 0, 0, 3, 0, 0, 6, 0, 0, 0, 0, 0, 6, 0, 0, 3, 0, 0, 6, 0, 0, 0, 0,
# 1, 1, 2, 0, 2, 1, 2, 0, 1, 2, 2, 0, 2, 0, 2, 0, 3, 2, 0, 0, 2, 1, 2, 0,
# A033687 Theta series of hexagonal lattice A_2 with respect to deep hole.
MyOEIS::compare_values
(anum => q{A038588}, # no duplicates
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 12;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
my $norm = $x*$x + 3*$y*$y;
if (! xy_is_tcentred($x,$y)) {
### sk: "$n at $x,$y norm=$norm"
$n++;
next;
}
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm = $norm;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$num++;
$n++;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A038587}, # with duplicates
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 12;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
if (! xy_is_tcentred($x,$y)) {
$n++;
next;
}
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 36;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$num++;
$n++;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A005882}, # with zeros
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 12;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
if (! xy_is_tcentred($x,$y)) {
$n++;
next;
}
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 36;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A033685}, # with zeros, 1/3 steps of norm
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got = (0);
my $n = $path->n_start;
my $num = 0;
my $want_norm = 12;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
if (! xy_is_tcentred($x,$y)) {
$n++;
next;
}
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 12;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A217219 - theta of honeycomb at centre hole
# count of how many at norm=4*k, possibly zero
MyOEIS::compare_values
(anum => 'A217219',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new(points=>'hex_centred');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 0;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 4;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A113062 - theta of honeycomb at node,
# count of how many at norm=4*k, possibly zero
MyOEIS::compare_values
(anum => 'A113062',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'hex');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 0;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 4;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A113063', # divided by 3
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'hex');
my @got;
my $n = $path->n_start + 1; # excluding origin X=0,Y=0
my $num = 0;
my $want_norm = 4;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
my $norm = $x*$x + 3*$y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num/3;
$want_norm += 4;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A014201 - number of solutions x^2+xy+y^2 <= n excluding 0,0
#
# norm = x^2+x*y+y^2 <= n
# = (X^2 + 3*Y^2) / 4 <= n
# = X^2 + 3*Y^2 <= 4*n
MyOEIS::compare_values
(anum => 'A014201',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got;
my $num = 0;
my $want_norm = 0;
my $n = $path->n_start + 1; # skip X=0,Y=0 at N=Nstart
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
($x,$y) = (($y-$x)/2, ($x+$y)/2);
my $norm = $x*$x + $x*$y + $y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm++;
} else {
$num++;
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A038589 - number of solutions x^2+xy+y^2 <= n including 0,0
# - sizes successive clusters A2 centred at lattice point
MyOEIS::compare_values
(anum => 'A038589',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'even');
my @got;
my $num = 0;
my $want_norm = 0;
my $n = $path->n_start;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
($x,$y) = (($y-$x)/2, ($x+$y)/2);
my $norm = $x*$x + $x*$y + $y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm++;
} else {
$num++;
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A092572 - all X^2+3Y^2 values which occur, points="all" X>0,Y>0
MyOEIS::compare_values
(anum => 'A092572',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'all');
my @got;
my $prev_h = -1;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
next unless ($x > 0 && $y > 0);
my $h = $x*$x + 3*$y*$y;
if ($h != $prev_h) {
push @got, $h;
$prev_h = $h;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A158937 - all X^2+3Y^2 values which occur, points="all" X>0,Y>0, with repeats
MyOEIS::compare_values
(anum => 'A158937',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'all');
my @got;
my $prev_h = -1;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
next unless ($x > 0 && $y > 0);
my $h = $x*$x + 3*$y*$y;
push @got, $h;
}
return \@got;
});
#------------------------------------------------------------------------------
# A092573 - count of points at distance n, points="all" X>0,Y>0
MyOEIS::compare_values
(anum => 'A092573',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'all');
my @got;
my $prev_h = 0;
my $num = 0;
for (my $n = $path->n_start; @got+1 < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
next unless ($x > 0 && $y > 0);
my $h = $x*$x + 3*$y*$y;
if ($h == $prev_h) {
$num++;
} else {
$got[$prev_h] = $num;
$num = 1;
$prev_h = $h;
}
}
shift @got; # drop n=0, start from n=1
$#got = $count-1; # trim
foreach my $got (@got) { $got ||= 0 } # pad, mutate array
return \@got;
});
#------------------------------------------------------------------------------
# A092574 - all X^2+3Y^2 values which occur, points="all" X>0,Y>0 gcd(X,Y)=1
MyOEIS::compare_values
(anum => 'A092574',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'all');
my @got;
my $prev_h = -1;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
next unless ($x > 0 && $y > 0);
next unless gcd($x,$y) == 1;
my $h = $x*$x + 3*$y*$y;
if ($h != $prev_h) {
push @got, $h;
$prev_h = $h;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A092575 - count of points at distance n, points="all" X>0,Y>0 gcd(X,Y)=1
MyOEIS::compare_values
(anum => 'A092575',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new (points => 'all');
my @got;
my $prev_h = 0;
my $num = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
next unless ($x > 0 && $y > 0);
next unless gcd($x,$y) == 1;
my $h = $x*$x + 3*$y*$y;
if ($h == $prev_h) {
$num++;
} else {
$got[$prev_h] = $num;
$num = 1;
$prev_h = $h;
}
}
shift @got; # drop n=0, start from n=1
$#got = $count-1; # trim
foreach my $got (@got) { $got ||= 0 } # pad, mutate array
return \@got;
});
sub gcd {
my ($x, $y) = @_;
#### _gcd(): "$x,$y"
if ($y > $x) {
$y %= $x;
}
for (;;) {
if ($y <= 1) {
return ($y == 0 ? $x : 1);
}
($x,$y) = ($y, $x % $y);
}
}
#------------------------------------------------------------------------------
# A088534 - count of points 0<=x<=y, points="even"
MyOEIS::compare_values
(anum => 'A088534',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new;
my @got = (0) x scalar($count);
my $prev_h = 0;
my $num = 0;
for (my $n = $path->n_start; ; $n++) {
my ($x,$y) = $path->n_to_xy($n);
# next unless 0 <= $x && $x <= $y;
next unless 0 <= $y && $y <= $x/3;
my $h = ($x*$x + 3*$y*$y) / 4;
# Same when rotate -45 as per POD notes.
# ($x,$y) = (($x+$y)/2,
# ($y-$x)/2);
# $h = $x*$x + $x*$y + $y*$y;
if ($h == $prev_h) {
$num++;
} else {
last if $prev_h >= $count;
$got[$prev_h] = $num;
$num = 1;
$prev_h = $h;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A003136 - Loeschian numbers, norms of A2 lattice
MyOEIS::compare_values
(anum => 'A003136',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new;
my @got;
my $prev_h = -1;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
my $h = ($x*$x + 3*$y*$y) / 4;
if ($h != $prev_h) {
push @got, $h;
$prev_h = $h;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A035019 - count of each hypot distance
MyOEIS::compare_values
(anum => 'A035019',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangularHypot->new;
my @got;
my $prev_h = 0;
my $num = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
my $h = $x*$x + 3*$y*$y;
if ($h == $prev_h) {
$num++;
} else {
push @got, $num;
$num = 1;
$prev_h = $h;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/GosperSide-oeis.t 0000644 0001750 0001750 00000021736 12563466277 016512 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 11;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::GosperSide;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $path = Math::PlanePath::GosperSide->new;
{
my %dxdy_to_dir6 = ('2,0' => 0,
'1,1' => 1,
'-1,1' => 2,
'-2,0' => 3,
'-1,-1' => 4,
'1,-1' => 5);
# return 0 if X,Y's are straight, 2 if left, 1 if right
sub xy_turn_6 {
my ($prev_x,$prev_y, $x,$y, $next_x,$next_y) = @_;
my $prev_dx = $x - $prev_x;
my $prev_dy = $y - $prev_y;
my $dx = $next_x - $x;
my $dy = $next_y - $y;
my $prev_dir = $dxdy_to_dir6{"$prev_dx,$prev_dy"};
if (! defined $prev_dir) { die "oops, unrecognised $prev_dx,$prev_dy"; }
my $dir = $dxdy_to_dir6{"$dx,$dy"};
if (! defined $dir) { die "oops, unrecognised $dx,$dy"; }
return ($dir - $prev_dir) % 6;
}
}
#------------------------------------------------------------------------------
# A229215 - direction 1,2,3,-1,-2,-3
{
my %dxdy_to_dirpn3 = ('2,0' => 1, # -2 -3
'1,-1' => 2, # \ /
'-1,-1' => 3, # -1 ---*--- 1
'-2,0' => -1, # / \
'-1,1' => -2, # 3 2
'1,1' => -3);
MyOEIS::compare_values
(anum => 'A229215',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n);
my $dir = $dxdy_to_dirpn3{"$dx,$dy"};
die if ! defined $dir;
push @got, $dir;
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A005823 - N ternary no 1s is net turn 0
MyOEIS::compare_values
(anum => 'A005823',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my $total_turn = 0;
my @got = (0);
while (@got < $count) {
my ($i, $value) = $seq->next;
$total_turn += $value;
if ($total_turn == 0) {
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A099450 - Y at N=3^k
MyOEIS::compare_values
(anum => 'A099450',
func => sub {
my ($count) = @_;
my @got;
require Math::BigInt;
for (my $k = Math::BigInt->new(1); @got < $count; $k++) {
my ($x,$y) = $path->n_to_xy(3**$k);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A189673 - morphism turn 0=left, 1=right, extra initial 0
MyOEIS::compare_values
(anum => 'A189673',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Left');
my @got = (0);
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A189640 - morphism turn 0=left, 1=right, extra initial 0
MyOEIS::compare_values
(anum => 'A189640',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my @got = (0);
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A060032 - turn 1=left, 2=right as bignums to 3^level
MyOEIS::compare_values
(anum => 'A060032',
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
require Math::BigInt;
for (my $level = 0; @got < $count; $level++) {
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my $big = Math::BigInt->new(0);
foreach my $n (1 .. 3**$level) {
my ($i, $value) = $seq->next;
$big = 10*$big + $value+1;
}
push @got, $big;
}
return \@got;
});
#------------------------------------------------------------------------------
# A062756 - ternary count 1s, is cumulative turn left=+1, right=-1
MyOEIS::compare_values
(anum => 'A062756',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my @got = (0); # bvalues starts with an n=0
my $cumulative;
while (@got < $count) {
my ($i, $value) = $seq->next;
$cumulative += $value;
push @got, $cumulative;
}
return \@got;
});
#------------------------------------------------------------------------------
# A080846 - turn 0=left, 1=right
MyOEIS::compare_values
(anum => 'A080846',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A038502 - taken mod 3 is 1=left, 2=right
MyOEIS::compare_values
(anum => 'A038502',
fixup => sub {
my ($bvalues) = @_;
@$bvalues = map { $_ % 3 } @$bvalues;
},
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value+1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A026225 - positions of left turns
MyOEIS::compare_values
(anum => 'A026225',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Left');
my @got;
while (@got < $count) {
my ($i, $value) = $seq->next;
if ($value) {
push @got, $i;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A026225},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 1; @got < $count; $n++) {
if (digit_above_low_zeros($n) == 1) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A026179 - positions of right turns
MyOEIS::compare_values
(anum => 'A026179',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my @got = (1); # extra 1 ...
while (@got < $count) {
my ($i, $value) = $seq->next;
if ($value) {
push @got, $i;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A026179',
func => sub {
my ($count) = @_;
my @got = (1);
for (my $n = 1; @got < $count; $n++) {
if (digit_above_low_zeros($n) == 2) {
push @got, $n;
}
}
return \@got;
});
sub digit_above_low_zeros {
my ($n) = @_;
if ($n == 0) {
return 0;
}
while (($n % 3) == 0) {
$n = int($n/3);
}
return ($n % 3);
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/QuadricCurve-oeis.t 0000644 0001750 0001750 00000003113 12153211070 016776 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::QuadricCurve;
use Test;
plan tests => 11;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A133851 -- Y at N=2^k is 2^(k/4) when k=0mod4, starting
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
MyOEIS::compare_values
(anum => 'A133851',
max_count => 1000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::QuadricCurve->new;
my @got;
for (my $n = $bigclass->new(2); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/AnvilSpiral-oeis.t 0000644 0001750 0001750 00000003540 12136177303 016644 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 2;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::AnvilSpiral;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A033581 - N on Y axis (6*n^2) except for initial N=2
MyOEIS::compare_values
(anum => 'A033581',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::AnvilSpiral->new (wider => 2);
my @got = (0);
for (my $y = 1; @got < $count; $y++) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A136392 - N on Y negative, with offset making n=-Y+1
MyOEIS::compare_values
(anum => 'A136392',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::AnvilSpiral->new;
my @got;
for (my $y = 0; @got < $count; $y--) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/CellularRule-oeis.t 0000644 0001750 0001750 00000072131 12616362470 017021 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# cf A094605 rule 30 period of nth diagonal
# A094606 log2 of that period
#
use 5.004;
use strict;
use Test;
use List::Util 'min';
plan tests => 199;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::CellularRule;
# uncomment this to run the ### lines
# use Smart::Comments '###';
sub streq_array {
my ($a1, $a2) = @_;
if (! ref $a1 || ! ref $a2) {
return 0;
}
while (@$a1 && @$a2) {
if ($a1->[0] ne $a2->[0]) {
MyTestHelpers::diag ("differ: ", $a1->[0], ' ', $a2->[0]);
return 0;
}
shift @$a1;
shift @$a2;
}
return (@$a1 == @$a2);
}
#------------------------------------------------------------------------------
# duplications
foreach my $elem (# [ 'A071030', 'A118109', 'rule=54' ],
# [ 'A071033', 'A118102', 'rule=94' ],
# [ 'A071036', 'A118110', 'rule=150' ],
[ 'A071037', 'A118172', 'rule=158' ],
[ 'A071039', 'A118111', 'rule=190' ],
) {
my ($anum1, $anum2, $name) = @$elem;
my ($aref1) = MyOEIS::read_values($anum1);
my ($aref2) = MyOEIS::read_values($anum2);
$#$aref1 = min($#$aref1, $#$aref2);
$#$aref2 = min($#$aref1, $#$aref2);
my $str1 = join(',', @$aref1);
my $str2 = join(',', @$aref2);
print "$name ", $str1 eq $str2 ? "same" : "different","\n";
if ($str1 ne $str2) {
print " $str1\n";
print " $str2\n";
}
}
#------------------------------------------------------------------------------
# A061579 - permutation N at -X,Y
MyOEIS::compare_values
(anum => 'A061579',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule->new (n_start => 0, rule => 50);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n (-$x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
my @data = (
# Not quite, initial values differ
# [ 'A051341', 7, 'bits' ],
[ 'A098608', 2, 'bignum', base=>2 ], # 100^n
[ 'A011557', 4, 'bignum', base=>2 ], # 10^n
[ 'A245549', 30, 'bignum', base=>2 ],
[ 'A094028', 50, 'bignum', base=>2 ],
[ 'A006943', 60, 'bignum', base=>2 ], # Sierpinski
[ 'A245548', 150, 'bignum', base=>2 ],
[ 'A100706', 151, 'bignum', base=>2 ],
[ 'A109241', 206, 'bignum', base=>2 ],
[ 'A000042', 220, 'bignum', base=>2 ], # half-width 1s
# http://oeis.org/A118110
# http://oeis.org/A245548
# characteristic func of pronics m*(m+1)
# rule=4,12,36,44,68,76,100,108,132,140,164,172,196,204,228,236
[ 'A005369', 4, 'bits' ],
[ 'A071022', 70, 'bits', part=>'left' ],
[ 'A071022', 198, 'bits', part=>'left' ],
[ 'A071023', 78, 'bits', part=>'left' ],
[ 'A071024', 92, 'bits', part=>'right' ],
[ 'A071025', 124, 'bits', part=>'right' ],
[ 'A071026', 188, 'bits', part=>'right' ],
[ 'A071027', 230, 'bits', part=>'left' ],
[ 'A071028', 50, 'bits' ],
[ 'A071029', 22, 'bits' ],
[ 'A071030', 54, 'bits' ],
[ 'A071031', 62, 'bits' ],
[ 'A071032', 86, 'bits' ],
[ 'A071033', 94, 'bignum', base=>2 ],
[ 'A071034', 118, 'bits' ],
[ 'A071035', 126, 'bits' ],
[ 'A071036', 150, 'bits' ], # same as A118110
[ 'A071037', 158, 'bits' ],
[ 'A071038', 182, 'bits' ],
[ 'A071039', 190, 'bits' ],
[ 'A071040', 214, 'bits' ],
[ 'A071041', 246, 'bits' ],
# [ 'A060576', 255, 'bits' ], # homeomorphically irreducibles ...
[ 'A070909', 28, 'bits', part=>'right' ],
[ 'A070909', 156, 'bits', part=>'right' ],
[ 'A075437', 110, 'bits' ],
[ 'A118101', 94, 'bignum' ],
[ 'A118102', 94, 'bits' ],
[ 'A118108', 54, 'bignum' ],
[ 'A118109', 54, 'bignum', base=>2 ],
[ 'A118110', 150, 'bignum', base=>2 ],
[ 'A118111', 190, 'bits' ],
[ 'A118171', 158, 'bignum' ],
[ 'A118172', 158, 'bits' ],
[ 'A118173', 188, 'bignum' ],
[ 'A118174', 188, 'bits' ],
[ 'A118175', 220, 'bits' ],
[ 'A118175', 252, 'bits' ],
[ 'A070887', 110, 'bits', part=>'left' ],
[ 'A071042', 90, 'number_of', value=>0 ],
[ 'A071043', 22, 'number_of', value=>0 ],
[ 'A071044', 22, 'number_of', value=>1 ],
[ 'A071045', 54, 'number_of', value=>0 ],
[ 'A071046', 62, 'number_of', value=>0 ],
[ 'A071047', 62, 'number_of', value=>1 ],
[ 'A071049', 110, 'number_of', value=>1, initial=>[0] ],
[ 'A071048', 110, 'number_of', value=>0, part=>'left' ],
[ 'A071050', 126, 'number_of', value=>0 ],
[ 'A071051', 126, 'number_of', value=>1 ],
[ 'A071052', 150, 'number_of', value=>0 ],
[ 'A071053', 150, 'number_of', value=>1 ],
[ 'A071054', 158, 'number_of', value=>1 ],
[ 'A071055', 182, 'number_of', value=>0 ],
[ 'A038184', 150, 'bignum' ],
[ 'A038185', 150, 'bignum', part=>'left' ], # cut after central column
[ 'A001045', 28, 'bignum', initial=>[0,1] ], # Jacobsthal
[ 'A110240', 30, 'bignum' ], # cf A074890 some strange form
[ 'A117998', 102, 'bignum' ],
[ 'A117999', 110, 'bignum' ],
[ 'A037576', 190, 'bignum' ],
[ 'A002450', 250, 'bignum', initial=>[0] ], # (4^n-1)/3 10101 extra 0 at start
[ 'A006977', 230, 'bignum', part=>'left' ],
[ 'A078176', 225, 'bignum', part=>'whole', ystart=>1, inverse=>1 ],
[ 'A051023', 30, 'bits', part=>'centre' ],
[ 'A070950', 30, 'bits' ],
[ 'A070951', 30, 'number_of', value=>0 ],
[ 'A070952', 30, 'number_of', value=>1, max_count=>400, initial=>[0] ],
[ 'A151929', 30, 'number_of_1s_first_diff', max_count=>200,
initial=>[0], # without diffs yet applied ...
],
[ 'A092539', 30, 'bignum_central_column' ],
[ 'A094603', 30, 'trailing_number_of', value=>1 ],
[ 'A094604', 30, 'new_maximum_trailing_number_of', 1 ],
[ 'A001316', 90, 'number_of', value=>1 ], # Gould's sequence
#--------------------------------------------------------------------------
# Sierpinski triangle, 8 of whole
# rule=60 right half
[ 'A047999', 60, 'bits', part=>'right' ], # Sierpinski triangle in right
[ 'A001317', 60, 'bignum' ], # Sierpinski triangle right half
[ 'A075438', 60, 'bits' ], # including 0s in left half
# rule=102 left half
[ 'A047999', 102, 'bits', part=>'left' ],
[ 'A075439', 102, 'bits' ],
[ 'A038183', 18, 'bignum' ], # Sierpinski bignums
[ 'A038183', 26, 'bignum' ],
[ 'A038183', 82, 'bignum' ],
[ 'A038183', 90, 'bignum' ],
[ 'A038183', 146, 'bignum' ],
[ 'A038183', 154, 'bignum' ],
[ 'A038183', 210, 'bignum' ],
[ 'A038183', 218, 'bignum' ],
[ 'A070886', 18, 'bits' ], # Sierpinski 0/1
[ 'A070886', 26, 'bits' ],
[ 'A070886', 82, 'bits' ],
[ 'A070886', 90, 'bits' ],
[ 'A070886', 146, 'bits' ],
[ 'A070886', 154, 'bits' ],
[ 'A070886', 210, 'bits' ],
[ 'A070886', 218, 'bits' ],
#--------------------------------------------------------------------------
# simple stuff
# whole solid, values 2^(2n)-1
[ 'A083420', 151, 'bignum' ], # 8 of
[ 'A083420', 159, 'bignum' ],
[ 'A083420', 183, 'bignum' ],
[ 'A083420', 191, 'bignum' ],
[ 'A083420', 215, 'bignum' ],
[ 'A083420', 223, 'bignum' ],
[ 'A083420', 247, 'bignum' ],
[ 'A083420', 254, 'bignum' ],
# and also
[ 'A083420', 222, 'bignum' ], # 2 of
[ 'A083420', 255, 'bignum' ],
# right half solid 2^n-1
[ 'A000225', 220, 'bignum', initial=>[0] ], # 2^n-1 want start from 1
[ 'A000225', 252, 'bignum', initial=>[0] ],
# left half solid, # 2^n-1
[ 'A000225', 206, 'bignum', part=>'left', initial=>[0] ], # 0xCE
[ 'A000225', 238, 'bignum', part=>'left', initial=>[0] ], # 0xEE
# central column only, values all 1s
[ 'A000012', 4, 'bignum', part=>'left' ],
[ 'A000012', 12, 'bignum', part=>'left' ],
[ 'A000012', 36, 'bignum', part=>'left' ],
[ 'A000012', 44, 'bignum', part=>'left' ],
[ 'A000012', 68, 'bignum', part=>'left' ],
[ 'A000012', 76, 'bignum', part=>'left' ],
[ 'A000012', 100, 'bignum', part=>'left' ],
[ 'A000012', 108, 'bignum', part=>'left' ],
[ 'A000012', 132, 'bignum', part=>'left' ],
[ 'A000012', 140, 'bignum', part=>'left' ],
[ 'A000012', 164, 'bignum', part=>'left' ],
[ 'A000012', 172, 'bignum', part=>'left' ],
[ 'A000012', 196, 'bignum', part=>'left' ],
[ 'A000012', 204, 'bignum', part=>'left' ],
[ 'A000012', 228, 'bignum', part=>'left' ],
[ 'A000012', 236, 'bignum', part=>'left' ],
#
# central column only, central values N=1,2,3,etc all integers
[ 'A000027', 4, 'central_column_N' ],
[ 'A000027', 12, 'central_column_N' ],
[ 'A000027', 36, 'central_column_N' ],
[ 'A000027', 44, 'central_column_N' ],
[ 'A000027', 76, 'central_column_N' ],
[ 'A000027', 108, 'central_column_N' ],
[ 'A000027', 132, 'central_column_N' ],
[ 'A000027', 140, 'central_column_N' ],
[ 'A000027', 164, 'central_column_N' ],
[ 'A000027', 172, 'central_column_N' ],
[ 'A000027', 196, 'central_column_N' ],
[ 'A000027', 204, 'central_column_N' ],
[ 'A000027', 228, 'central_column_N' ],
[ 'A000027', 236, 'central_column_N' ],
#
# central column only, values 2^k
[ 'A000079', 4, 'bignum' ],
[ 'A000079', 12, 'bignum' ],
[ 'A000079', 36, 'bignum' ],
[ 'A000079', 44, 'bignum' ],
[ 'A000079', 68, 'bignum' ],
[ 'A000079', 76, 'bignum' ],
[ 'A000079', 100, 'bignum' ],
[ 'A000079', 108, 'bignum' ],
[ 'A000079', 132, 'bignum' ],
[ 'A000079', 140, 'bignum' ],
[ 'A000079', 164, 'bignum' ],
[ 'A000079', 172, 'bignum' ],
[ 'A000079', 196, 'bignum' ],
[ 'A000079', 204, 'bignum' ],
[ 'A000079', 228, 'bignum' ],
[ 'A000079', 236, 'bignum' ],
# right diagonal only, values all 1, 16 of
[ 'A000012', 0x10, 'bignum' ],
[ 'A000012', 0x18, 'bignum' ],
[ 'A000012', 0x30, 'bignum' ],
[ 'A000012', 0x38, 'bignum' ],
[ 'A000012', 0x50, 'bignum' ],
[ 'A000012', 0x58, 'bignum' ],
[ 'A000012', 0x70, 'bignum' ],
[ 'A000012', 0x78, 'bignum' ],
[ 'A000012', 0x90, 'bignum' ],
[ 'A000012', 0x98, 'bignum' ],
[ 'A000012', 0xB0, 'bignum' ],
[ 'A000012', 0xB8, 'bignum' ],
[ 'A000012', 0xD0, 'bignum' ],
[ 'A000012', 0xD8, 'bignum' ],
[ 'A000012', 0xF0, 'bignum' ],
[ 'A000012', 0xF8, 'bignum' ],
# left diagonal only, values 2^k
[ 'A000079', 0x02, 'bignum', part=>'left' ],
[ 'A000079', 0x0A, 'bignum', part=>'left' ],
[ 'A000079', 0x22, 'bignum', part=>'left' ],
[ 'A000079', 0x2A, 'bignum', part=>'left' ],
[ 'A000079', 0x42, 'bignum', part=>'left' ],
[ 'A000079', 0x4A, 'bignum', part=>'left' ],
[ 'A000079', 0x62, 'bignum', part=>'left' ],
[ 'A000079', 0x6A, 'bignum', part=>'left' ],
[ 'A000079', 0x82, 'bignum', part=>'left' ],
[ 'A000079', 0x8A, 'bignum', part=>'left' ],
[ 'A000079', 0xA2, 'bignum', part=>'left' ],
[ 'A000079', 0xAA, 'bignum', part=>'left' ],
[ 'A000079', 0xC2, 'bignum', part=>'left' ],
[ 'A000079', 0xCA, 'bignum', part=>'left' ],
[ 'A000079', 0xE2, 'bignum', part=>'left' ],
[ 'A000079', 0xEA, 'bignum', part=>'left' ],
# bits, characteristic of square
[ 'A010052', 0x02, 'bits' ],
[ 'A010052', 0x0A, 'bits' ],
[ 'A010052', 0x22, 'bits' ],
[ 'A010052', 0x2A, 'bits' ],
[ 'A010052', 0x42, 'bits' ],
[ 'A010052', 0x4A, 'bits' ],
[ 'A010052', 0x62, 'bits' ],
[ 'A010052', 0x6A, 'bits' ],
[ 'A010052', 0x82, 'bits' ],
[ 'A010052', 0x8A, 'bits' ],
[ 'A010052', 0xA2, 'bits' ],
[ 'A010052', 0xAA, 'bits' ],
[ 'A010052', 0xC2, 'bits' ],
[ 'A010052', 0xCA, 'bits' ],
[ 'A010052', 0xE2, 'bits' ],
[ 'A010052', 0xEA, 'bits' ],
);
# {
# require Data::Dumper;
# foreach my $i (0 .. $#data) {
# my $e1 = $data[$i];
# my @a1 = @$e1; shift @a1;
# my $a1 = Data::Dumper->Dump([\@a1],['args']);
# ### $e1
# ### @a1
# ### $a1
# foreach my $j ($i+1 .. $#data) {
# my $e2 = $data[$j];
# my @a2 = @$e2; shift @a2;
# my $a2 = Data::Dumper->Dump([\@a2],['args']);
#
# if ($a1 eq $a2) {
# print "duplicate $e1->[0] = $e2->[0] params $a1\n";
# }
# }
# }
# }
foreach my $elem (@data) {
### $elem
my ($anum, $rule, $method, @params) = @$elem;
my $func = main->can($method) || die "Unrecognised method $method";
&$func ($anum, $rule, @params);
}
#------------------------------------------------------------------------------
# number of 0s or 1s in row
sub number_of {
my ($anum, $rule, %params) = @_;
my $part = $params{'part'} || 'whole';
my $want_value = $params{'value'} // 1;
my $max_count = $params{'max_count'} || 100;
MyOEIS::compare_values
(anum => $anum,
name => "$anum number of ${want_value}s in rows rule $rule, $part",
max_count => $max_count,
func => sub {
my ($count) = @_;
return number_of_make_values($count, $anum, $rule, %params);
});
}
sub number_of_1s_first_diff {
my ($anum, $rule, %params) = @_;
my $max_count = $params{'max_count'};
MyOEIS::compare_values
(anum => $anum,
name => "$anum number of 1s first differences",
max_count => $max_count,
func => sub {
my ($count) = @_;
my $aref = number_of_make_values($count+1, $anum, $rule, %params);
return [ MyOEIS::first_differences(@$aref) ];
});
}
sub number_of_make_values {
my ($count, $anum, $rule, %params) = @_;
my $initial = $params{'initial'} || [];
my $part = $params{'part'} || 'whole';
my $want_value = $params{'value'} // 1;
my $max_count = $params{'max_count'};
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my @got = @$initial;
for (my $y = 0; @got < $count; $y++) {
my $number_of = 0;
foreach my $x (($part eq 'right' || $part eq 'centre' ? 0 : -$y)
.. ($part eq 'left' || $part eq 'centre' ? 0 : $y)) {
my $n = $path->xy_to_n ($x, $y);
my $got_value = (defined $n ? 1 : 0);
if ($got_value == $want_value) {
$number_of++;
}
}
push @got, $number_of;
}
return \@got;
}
#------------------------------------------------------------------------------
# number of 0s or 1s in row at the rightmost end
sub trailing_number_of {
my ($anum, $rule, %params) = @_;
my $initial = $params{'initial'} || [];
my $part = $params{'part'} || 'whole';
my $want_value = $params{'value'} // 1;
MyOEIS::compare_values
(anum => $anum,
name => "$anum trailing number of ${want_value}s in rows rule $rule",
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my @got = @$initial;
for (my $y = 0; @got < $count; $y++) {
my $number_of = 0;
for (my $x = $y; $x >= -$y; $x--) {
my $n = $path->xy_to_n ($x, $y);
my $got_value = (defined $n ? 1 : 0);
if ($got_value == $want_value) {
$number_of++;
} else {
last;
}
}
push @got, $number_of;
}
return \@got;
});
}
sub new_maximum_trailing_number_of {
my ($anum, $rule, $want_value) = @_;
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
MyTestHelpers::diag ("$anum new_maximum_trailing_number_of");
if ($anum eq 'A094604') {
# new max only at Y=2^k, so limit search
if ($#$bvalues > 10) {
$#$bvalues = 10;
}
}
my $prev = 0;
for (my $y = 0; @got < @$bvalues; $y++) {
my $count = 0;
for (my $x = $y; $x >= -$y; $x--) {
my $n = $path->xy_to_n ($x, $y);
my $got_value = (defined $n ? 1 : 0);
if ($got_value == $want_value) {
$count++;
} else {
last;
}
}
if ($count > $prev) {
push @got, $count;
$prev = $count;
}
}
if (! streq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
streq_array(\@got, $bvalues),
1, "$anum");
}
#------------------------------------------------------------------------------
# bignum rows
sub bignum {
my ($anum, $rule, %params) = @_;
my $part = $params{'part'} || 'whole';
my $initial = $params{'initial'} || [];
my $ystart = $params{'ystart'} || 0;
my $inverse = $params{'inverse'} ? 1 : 0; # for bitwise invert
my $base = $params{'base'} || 10;
my $max_count = $params{'max_count'};
# if ($anum eq 'A000012') { # trim all-ones
# if ($#$bvalues > 50) { $#$bvalues = 50; }
# }
MyOEIS::compare_values
(anum => $anum,
name => "$anum bignums $part, inverse=$inverse",
max_count => $max_count,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my @got = @$initial;
require Math::BigInt;
for (my $y = $ystart; @got < $count; $y++) {
my $b = Math::BigInt->new(0);
foreach my $x (($part eq 'right' ? 0 : -$y)
.. ($part eq 'left' ? 0 : $y)) {
my $bit = ($path->xy_is_visited($x,$y) ? 1 : 0);
if ($inverse) { $bit ^= 1; }
$b = 2*$b + $bit;
}
if ($base == 2) {
$b = $b->as_bin;
$b =~ s/^0b//;
}
push @got, "$b";
}
return \@got;
});
}
#------------------------------------------------------------------------------
# 0/1 by rows
sub bits {
my ($anum, $rule, %params) = @_;
### bits(): @_
my $part = $params{'part'} || 'whole';
my $initial = $params{'initial'} || [];
MyOEIS::compare_values
(anum => $anum,
name => "$anum 0/1 rows rule $rule, $part",
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my @got = @$initial;
OUTER: for (my $y = 0; ; $y++) {
foreach my $x (($part eq 'right' || $part eq 'centre' ? 0 : -$y)
.. ($part eq 'left' || $part eq 'centre' ? 0 : $y)) {
last OUTER if @got >= $count;
push @got, ($path->xy_to_n ($x, $y) ? 1 : 0);
}
}
return \@got;
});
}
#------------------------------------------------------------------------------
# bignum central vertical column in decimal
sub bignum_central_column {
my ($anum, $rule) = @_;
MyOEIS::compare_values
(anum => $anum,
name => "$anum central column bignum, decimal",
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my @got;
require Math::BigInt;
my $b = Math::BigInt->new(0);
for (my $y = 0; @got < $count; $y++) {
my $bit = ($path->xy_to_n (0, $y) ? 1 : 0);
$b = 2*$b + $bit;
push @got, "$b";
}
return \@got;
});
}
#------------------------------------------------------------------------------
# N values of central vertical column
sub central_column_N {
my ($anum, $rule) = @_;
MyOEIS::compare_values
(anum => $anum,
name => "$anum central column N",
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my @got;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n (0, $y);
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A071029 rule 22 ... ?
#
# 22 = 00010110
# 111 -> 0
# 110 -> 0
# 101 -> 0
# 100 -> 1
# 011 -> 0
# 010 -> 1
# 001 -> 1
# 000 -> 0
# 0,
# 1, 0, 1,
# 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,
# 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0
# 0,
# 1,
# 0, 1, 0,
# 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0, 1,
# 0
# A071043 Number of 0's in n-th row of triangle in A071029.
# 0, 0, 3, 1, 7, 5, 9, 3, 15, 13, 17, 11, 21, 15, 21, 7, 31, 29, 33, 27,
# 37, 31, 37, 23, 45, 39, 45, 31, 49, 35, 45, 15, 63, 61, 65, 59, 69, 63,
# 69, 55, 77, 71, 77, 63, 81, 67, 77, 47, 93, 87, 93, 79, 97, 83, 93, 63,
# 105, 91, 101, 71, 105, 75, 93, 31, 127, 125, 129
#
# A071044 Number of 1's in n-th row of triangle in A071029.
# 1, 3, 2, 6, 2, 6, 4, 12, 2, 6, 4, 12, 4, 12, 8, 24, 2, 6, 4, 12, 4, 12,
# 8, 24, 4, 12, 8, 24, 8, 24, 16, 48, 2, 6, 4, 12, 4, 12, 8, 24, 4, 12,
# 8, 24, 8, 24, 16, 48, 4, 12, 8, 24, 8, 24, 16, 48, 8, 24, 16, 48, 16,
# 48, 32, 96, 2, 6, 4, 12, 4, 12, 8, 24, 4, 12, 8, 24, 8, 24, 16, 48
#
# *** *** *** ***
# * * * *
# *** ***
# * *
# *** ***
# * *
# ***
# *
#------------------------------------------------------------------------------
# A071026 rule 188
# rows n+1
#
# 1,
# 1, 0,
# 0, 1, 1,
# 0, 1, 0, 1,
# 1, 1, 1, 1, 0,
# 0, 0, 1, 1, 0, 1,
# 1, 1, 1, 1, 1, 1, 1,
# 1, 0, 1, 1, 0, 0, 1, 1,
# 1, 1, 0, 0, 0, 0, 0, 0, 1,
# 1, 1, 1, 1, 1, 1, 0, 1, 0, 0,
# 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1,
# 0, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0,
# 0, 0, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 0,
# 0, 1, 1, 1, 0, 1, 1, 0
#
# * *** *
# ** ***
# *** *
# ****
# * *
# **
# *
#------------------------------------------------------------------------------
# A071023 rule 78
# *** * * *
# ** * * *
# *** * *
# ** * *
# *** *
# ** *
# ***
# **
# *
# 1, 1, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,
# 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 1, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 1, 1, 1, 1, 1, 1, 1, 1,
# 0, 1, 1, 1, 1,
# 0, 1, 1, 1,
# 0, 1, 0,
# 1, 1, 1
# 111 ->
# 110 ->
# 101 ->
# 100 ->
# 011 ->
# 010 -> 1
# 001 -> 1
# 000 ->
# 1,
# 1, 1,
# 0, 1, 0,
# 1, 0, 1, 0,
# 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 1, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1,
# 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1,
# 1, 1, 0, 1, 0, 1, 1, 1
#------------------------------------------------------------------------------
# A071024 rule 92
# 0, 1, 0, 1, 0,
# 1, 1, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 1, 1, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 1, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 1, 1, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0
#------------------------------------------------------------------------------
# A071027 rule 230
# * *** *** *
# *** *** **
# * *** ***
# *** ****
# * *** *
# *** **
# * ***
# ****
# * *
# **
# *
# 1, 1, 1, 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 1, 1, 0,
# 1
#------------------------------------------------------------------------------
# # A071035 rule 126 sierpinski
#
# 1,
# 1, 0, 1,
# 1, 0, 1,
# 1, 0, 0, 0, 1,
# 1, 1, 1, 0, 1, 0, 1, 1, 1,
# 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1,
# 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0,
# 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1,
# 0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0
#------------------------------------------------------------------------------
# A071022 rule 70,198
# ** * * * *
# * * * * *
# ** * * *
# * * * *
# ** * *
# * * *
# ** *
# * *
# **
# *
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 1, 1, 1, 1, 1, 0,
# 1, 1, 1, 0,
# 1, 1, 0,
# 1, 0,
# 1, 1, 1, 0,
# 1, 0,
# 1, 1, 0,
# 1, 0,
# 1, 0,
# 1, 1, 1, 0,
# 1, 0,
# 1, 0,
# 1, 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 1, 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 0,
# 1, 1, 1, 0,
# 1, 0,
# 1, 0
#------------------------------------------------------------------------------
# A071030 - rule 54, rows 2n+1
# 0,
# 1, 0, 1,
# 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1,
# 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0,
# 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0,
# 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 1,
# 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0
#------------------------------------------------------------------------------
# A071039 rule 190, rows 2n+1
# 1,
# 0, 1, 0,
# 1, 1, 1, 1, 1,
# 0, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1, 1, 1,
# 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0,
# 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,
# 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1
#------------------------------------------------------------------------------
# A071036 rule 150
# ** ** *** ** **
# * * * * *
# *** *** ***
# * * *
# ** * **
# * * *
# ***
# *
# 1,
# 0, 1, 1,
# 0, 1, 1, 0, 0,
# 0, 1, 1, 1, 1, 0, 1,
# 0, 1, 1, 0, 0, 0, 1, 1, 1,
# 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 1,
# 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1,
# 0, 1, 1, 0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1,
# 0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1,
# 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1
#------------------------------------------------------------------------------
# A071022 rule 70,198
# A071023 rule 78
# A071024 rule 92
# A071025 rule 124
# A071026 rule 188
# A071027 rule 230
# A071028 rule 50 ok
# A071029 rule 22
# A071030 rule 54 -- cf A118108 bignum A118109 binary bignum
# A071031 rule 62
# A071032 rule 86
# A071033 rule 94
# A071034 rule 118
# A071035 rule 126 sierpinski
# A071036 rule 150
# A071037 rule 158
# A071038 rule 182
# A071039 rule 190
# A071040 rule 214
# A071041 rule 246
#
# A071042 num 0s in A070886 rule 90 sierpinski ok
# A071043 num 0s in A071029 rule 22 ok
# A071044 num 1s in A071029 rule 22 ok
# A071045 num 0s in A071030 rule 54 ok
# A071046 num 0s in A071031 rule 62 ok
# A071047
# A071048
# A071049
# A071050
# A071051 num 1s in A071035 rule 126 sierpinski
# A071052
# A071053
# A071054
# A071055
#
exit 0;
Math-PlanePath-122/xt/oeis/TriangleSpiral-oeis.t 0000644 0001750 0001750 00000010510 12563462277 017346 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 1;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use List::Util 'min', 'max';
use Math::PlanePath::TriangleSpiral;
use Math::PlanePath::TriangleSpiralSkewed;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $path = Math::PlanePath::TriangleSpiral->new;
#------------------------------------------------------------------------------
# A081272 -- N on Y axis
MyOEIS::compare_values
(anum => 'A081272',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TriangleSpiral->new;
for (my $y = 0; @got < $count; $y -= 2) {
push @got, $path->xy_to_n (0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A081275 -- N on slope=3 ENE
MyOEIS::compare_values
(anum => 'A081275',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TriangleSpiral->new (n_start => 0);
my $x = 2;
my $y = 0;
while (@got < $count) {
push @got, $path->xy_to_n ($x,$y);
$x += 3;
$y += 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A081589 -- N on slope=3 ENE
MyOEIS::compare_values
(anum => 'A081589',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TriangleSpiral->new;
my $x = 0;
my $y = 0;
while (@got < $count) {
push @got, $path->xy_to_n ($x,$y);
$x += 3;
$y += 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A038764 -- N on slope=2 WSW
MyOEIS::compare_values
(anum => 'A038764',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TriangleSpiral->new;
my $x = 0;
my $y = 0;
while (@got < $count) {
push @got, $path->xy_to_n ($x,$y);
$x += -3;
$y += -1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A063177 -- a(n) is sum of existing numbers in row of a(n-1)
MyOEIS::compare_values
(anum => 'A063177',
func => sub {
my ($count) = @_;
my @got;
require Math::BigInt;
my %plotted;
$plotted{0,0} = Math::BigInt->new(1);
my $xmin = 0;
my $ymin = 0;
my $xmax = 0;
my $ymax = 0;
push @got, 1;
for (my $n = $path->n_start + 1; @got < $count; $n++) {
my ($prev_x, $prev_y) = $path->n_to_xy ($n-1);
my ($x, $y) = $path->n_to_xy ($n);
### at: "$x,$y prev $prev_x,$prev_y"
my $total = 0;
if ($x > $prev_x) {
### forward diagonal ...
foreach my $y ($ymin .. $ymax) {
my $delta = $y - $prev_y;
my $x = $prev_x + $delta;
$total += $plotted{$x,$y} || 0;
}
} elsif ($y > $prev_y) {
### row: "$xmin .. $xmax at y=$prev_y"
foreach my $x ($xmin .. $xmax) {
$total += $plotted{$x,$prev_y} || 0;
}
} else {
### opp diagonal ...
foreach my $y ($ymin .. $ymax) {
my $delta = $y - $prev_y;
my $x = $prev_x - $delta;
$total += $plotted{$x,$y} || 0;
}
}
### total: "$total"
$plotted{$x,$y} = $total;
$xmin = min($xmin,$x);
$xmax = max($xmax,$x);
$ymin = min($ymin,$y);
$ymax = max($ymax,$y);
push @got, $total;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/AlternatePaper-oeis.t 0000644 0001750 0001750 00000026434 12563464524 017346 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::AlternatePaper;
use Test;
plan tests => 14;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $paper = Math::PlanePath::AlternatePaper->new;
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
#------------------------------------------------------------------------------
# A001196 - N on X axis, base 4 digits 0,3 only
MyOEIS::compare_values
(anum => 'A001196',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::AlternatePaper->new (arms => 3);
my @got;
for (my $x = $bigclass->new(0); @got < $count; $x++) {
my $n = $path->xy_to_n($x,0);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A077957 -- Y at N=2^k, being alternately 0 and 2^(k/2)
MyOEIS::compare_values
(anum => 'A077957',
max_count => 200,
func => sub {
my ($count) = @_;
my @got;
for (my $n = $bigclass->new(2); @got < $count; $n *= 2) {
my ($x,$y) = $paper->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A052955 single-visited points to N=2^k
MyOEIS::compare_values
(anum => 'A052955',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got = (1); # extra initial 1
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_n_to_singles ($paper, 2**$k);
}
return \@got;
});
# A052940 single-visited points to N=4^k
MyOEIS::compare_values
(anum => 'A052940',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got = (1); # initial 1 instead of 2
for (my $k = 1; @got < $count; $k++) {
push @got, MyOEIS::path_n_to_singles ($paper, 4**$k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A122746 area increment to N=2^k
MyOEIS::compare_values
(anum => 'A122746',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 2; @got < $count; $k++) {
push @got, (MyOEIS::path_enclosed_area($paper, 2**($k+1))
- MyOEIS::path_enclosed_area($paper, 2**$k));
}
return \@got;
});
#------------------------------------------------------------------------------
# A028399 boundary to N=2*4^k
MyOEIS::compare_values
(anum => 'A028399',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got = (0);
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length($paper, 2*4**$k);
}
return \@got;
});
# A131128 boundary to N=4^k
MyOEIS::compare_values
(anum => 'A131128',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got = (1);
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length($paper, 4**$k);
}
return \@got;
});
# A027383 boundary/2 to N=2^k
# is also boundary length verticals or horizontals since boundary is half
# verticals and half horizontals
MyOEIS::compare_values
(anum => 'A027383',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length($paper, 2**$k) / 2;
}
return \@got;
});
#------------------------------------------------------------------------------
# A060867 area to N=2*4^k
MyOEIS::compare_values
(anum => 'A060867',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 1; @got < $count; $k++) {
push @got, MyOEIS::path_enclosed_area($paper, 2*4**$k);
}
return \@got;
});
# A134057 area to N=4^k
MyOEIS::compare_values
(anum => 'A134057',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_enclosed_area($paper, 4**$k);
}
return \@got;
});
# A027556 area*2 to N=2^k
MyOEIS::compare_values
(anum => 'A027556',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_enclosed_area($paper, 2**$k) * 2;
}
return \@got;
});
#------------------------------------------------------------------------------
# A106665 -- turn 1=left, 0=right
# OFFSET=0 cf first turn at N=1 here
MyOEIS::compare_values
(anum => 'A106665',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'AlternatePaper',
turn_type => 'Left');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A090678 "non-squashing partitions" A088567 mod 2
# and A121241 which is 1,-1
# almost but not quite arms=2 turn_type=Left
# A121241 1,-1
# A110036 2,0,-2
# A110037 1,0,-1
# MyOEIS::compare_values
# (anum => 'A090678',
# func => sub {
# my ($count) = @_;
# require Math::NumSeq::PlanePathTurn;
# my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'AlternatePaper,arms=2',
# turn_type => 'Left');
# my @got = (1,1,1,0,0,1,0,1,0,1,1,0,1,0,0,1,0,1);
# while (@got < $count) {
# my ($i,$value) = $seq->next;
# push @got, $value;
# }
# return \@got;
# });
#------------------------------------------------------------------------------
# A020985 - Golay/Rudin/Shapiro is dX and dY alternately
# also is dSum in Math::NumSeq::PlanePathDelta
MyOEIS::compare_values
(anum => q{A020985},
func => sub {
my ($count) = @_;
my @got;
for (my $n = $paper->n_start; @got < $count; ) {
{
my ($dx, $dy) = $paper->n_to_dxdy ($n++);
push @got, $dx;
}
last unless @got < $count;
{
my ($dx, $dy) = $paper->n_to_dxdy ($n++);
push @got, $dy;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A020991 - position of last occurance of n, last time of X+Y=n
MyOEIS::compare_values
(anum => 'A020991',
func => sub {
my ($count) = @_;
my @got;
my @occur;
my $target = 1;
for (my $n = $paper->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $paper->n_to_xy ($n);
my $d = $x + $y;
$occur[$d]++;
if ($occur[$d] == $d) {
push @got, $n-1;
$target++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A093573+1 - triangle of positions where cumulative=k
# cumulative A020986 starts n=0 for GRS(0)=0 (A020985)
# 0,
# 1, 3,
# 2, 4, 6,
# 5, 7, 13, 15,
# 8, 12, 14, 16, 26,
# 9, 11, 17, 19, 25, 27
#
# cf diagonals
# 0
# 1
# 2, 4
# 3,7, 5
# 8, 6,14, 16
# 9,13, 15,27, 17
MyOEIS::compare_values
(anum => 'A093573',
func => sub {
my ($count) = @_;
my @got;
OUTER: for (my $sum = 1; ; $sum++) {
my @n_list;
foreach my $y (0 .. $sum) {
my $x = $sum - $y;
push @n_list, $paper->xy_to_n_list($x,$y);;
}
@n_list = sort {$a<=>$b} @n_list;
foreach my $n (@n_list) {
last OUTER if @got >= $count;
push @got, $n-1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A020986 - GRS cumulative
# X+Y, starting from N=1 (doesn't have X+Y=0 for N=0)
MyOEIS::compare_values
(anum => 'A020986',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $paper->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $paper->n_to_xy ($n);
push @got, $x+$y;
}
return \@got;
});
# is X coord undoubled, starting from N=2 (doesn't have X=0 for N=0)
MyOEIS::compare_values
(anum => q{A020986},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 2; @got < $count; $n += 2) {
my ($x, $y) = $paper->n_to_xy ($n);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A022155 - positions of -1, is S,W steps
MyOEIS::compare_values
(anum => 'A022155',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $paper->n_start; @got < $count; $n++) {
my ($dx,$dy) = $paper->n_to_dxdy($n);
if ($dx < 0 || $dy < 0) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A203463 - positions of 1, is N,E steps
MyOEIS::compare_values
(anum => 'A203463',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $paper->n_start; @got < $count; $n++) {
my ($dx,$dy) = $paper->n_to_dxdy($n);
if ($dx > 0 || $dy > 0) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A020990 - Golay/Rudin/Shapiro * (-1)^k cumulative, is Y coord undoubled,
# except N=0
MyOEIS::compare_values
(anum => 'A020990',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 2; @got < $count; $n += 2) {
my ($x, $y) = $paper->n_to_xy ($n);
push @got, $y;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A020990},
func => sub {
my ($count) = @_;
my @got;
for (my $n = $paper->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $paper->n_to_xy ($n);
push @got, $x-$y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A212591 - position of first occurance of n, first time getting to X+Y=n
# seq 0, 1, 2, 5, 8, 9, 10, 21, 32, 33, 34, 37, 40, 41, 42, 85
# N 0 1 2 3 6, 9, 10, 11, 22, ...
MyOEIS::compare_values
(anum => 'A212591',
max_count => 1000, # because simple linear search
func => sub {
my ($count) = @_;
my @got;
my $target = 1;
for (my $n = $paper->n_start + 1; @got < $count; $n++) {
my ($x, $y) = $paper->n_to_xy ($n);
my $d = $x + $y;
if ($d == $target) {
push @got, $n-1;
$target++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/KochCurve-oeis.t 0000644 0001750 0001750 00000025626 12563471632 016330 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 8;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::KochCurve;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A016153 - area under the curve, (9^n-4^n)/5
MyOEIS::compare_values
(anum => 'A016153',
max_value => 100_000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::KochCurve->new;
my @got;
for (my $k = 0; @got < $count; $k++) {
my @points;
my ($n_lo, $n_hi) = $path->level_to_n_range($k);
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
push @points, [$x,$y];
}
push @got, points_to_area(\@points);
}
return \@got;
});
sub points_to_area {
my ($points) = @_;
if (@$points < 3) {
return 0;
}
require Math::Geometry::Planar;
my $polygon = Math::Geometry::Planar->new;
$polygon->points($points);
return $polygon->area;
}
#------------------------------------------------------------------------------
# A002450 number of right turns N=1 to N < 4^k
#
# 2
# / \ /
# 0---1 3---4
# A020988 number of left turns N=1 to N < 4^k = (2/3)*(4^n-1).
# duplicate A084180
MyOEIS::compare_values
(anum => 'A020988',
max_value => 100_000,
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Left');
my @got;
my $total = 0;
my $target = 1;
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($i == $target) {
push @got, $total;
$target *= 4;
}
$total += $value;
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A002450',
max_value => 100_000,
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Right');
my @got;
my $total = 0;
my $target = 1;
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($i == $target) {
push @got, $total;
$target *= 4;
}
$total += $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A177702 - abs(dX) from N=1 onwards, repeating 1,1,2
MyOEIS::compare_values
(anum => 'A177702',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathDelta;
my $seq = Math::NumSeq::PlanePathDelta->new (planepath => 'KochCurve',
delta_type => 'AbsdX');
$seq->seek_to_i(1);
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A217586
# Not quite turn sequence ...
# differs 0<->1 at n=2^k
#
# a(1) = 1
# if a(n) = 0 then a(2*n) = 1 and a(2*n+1) = 0 # opposite low bit
# if a(n) = 1 then a(2*n) = 0 and a(2*n+1) = 0 # both 0
#
# a(2n+1)=0 # odd always left
# a(2n) = 1-a(n) # even 0 or 1 as odd or even
# a(4n) = 1-a(2n) = 1-(1-a(n)) = a(n)
# a(4n+2) = 1-a(2n+1) = 1-0 = 1 # 4n+2 always right
# except a(0+2) = 1-a(1) = 1-1 = 0
# A Right N differ
# 1 0 1 *
# 0 1 10 *
# 0 0 11
# 1 0 100 *
# 0 0 101
# 1 1 110
# 0 0 111
# 0 1 1000 *
# 0 0 1001
# 1 1 1010
# 0 0 1011
# 0 0 1100
# 0 0 1101
# 1 1 1110
# 0 0 1111
# 1 0 10000 *
# 0 0
# 1 1
# 0 0
# 0 0
# 0 0
# 1 1
# 0 0
# 1 1
MyOEIS::compare_values
(anum => q{A217586},
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Right');
my @got;
while (@got < $count) {
# $seq->next;
my ($i,$value) = $seq->next;
if (is_pow2($i)) { $value ^= 1; }
push @got, $value;
# push @got, A217586_func($i)
}
return \@got;
});
sub A217586_func {
my ($n) = @_;
if ($n < 1) {
die "A217586_func() must have n>=1";
}
{
while (($n & 3) == 0) {
$n >>= 2;
}
if ($n == 1) {
return 1;
}
if (($n & 3) == 2) {
if ($n == 2) { return 0; }
else { return 1; }
}
if ($n & 1) {
return 0;
}
}
# {
# if ($n == 1) {
# return 1;
# }
# if (A217586_func($n >> 1)) {
# if ($n & 1) {
# return 0;
# } else {
# return 0;
# }
# } else {
# if ($n & 1) {
# return 0;
# } else {
# return 1;
# }
# }
# }
#
# {
# if ($n == 1) {
# return 1;
# }
# my $bit = $n & 1;
# if (A217586_func($n >> 1)) {
# return 0;
# } else {
# return $bit ^ 1;
# }
# }
}
sub is_pow2 {
my ($n) = @_;
while ($n > 1) {
if ($n & 1) {
return 0;
}
$n >>= 1;
}
return ($n == 1);
}
#------------------------------------------------------------------------------
# A035263 is turn left=1,right=0 at OFFSET=1
# morphism 1 -> 10, 0 -> 11
MyOEIS::compare_values
(anum => 'A035263',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Left');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
# also left=0,right=1 at even N
MyOEIS::compare_values
(anum => q{A035263},
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
if (($i & 1) == 0) {
push @got, $value;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A073059 a(4k+3)= 1 ..11 = 1
# a(4k+2) = a(4k+4) = 0 ..00 ..10 = 0
# a(16k+13) = 1 1101
# a(4n+1) = a(n) ..01 = base4 above
# a(n) = 1-A035263(n-1) is Koch 1=left,0=right by morphism OFFSET=1
# so A073059 is next turn 0=left,1=right
# ???
#
# MyOEIS::compare_values
# (anum => q{A073059},
# func => sub {
# my ($count) = @_;
# require Math::NumSeq::PlanePathTurn;
# my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
# turn_type => 'Left');
# my @got = (0);
# while (@got < $count) {
# $seq->next;
# my ($i,$value) = $seq->next;
# push @got, $value;
# }
# return \@got;
# });
#------------------------------------------------------------------------------
# A096268 - morphism turn 1=right,0=left
# but OFFSET=0 is turn at N=1
MyOEIS::compare_values
(anum => 'A096268',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A029883 - Thue-Morse first diffs
MyOEIS::compare_values
(anum => 'A029883',
fixup => sub {
my ($bvalues) = @_;
@$bvalues = map {abs} @$bvalues;
},
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Left');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A089045 - +/- increment
MyOEIS::compare_values
(anum => 'A089045',
fixup => sub {
my ($bvalues) = @_;
@$bvalues = map {abs} @$bvalues;
},
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Left');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A003159 - N end in even number of 0 bits, is positions of left turn
MyOEIS::compare_values
(anum => 'A003159',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Left');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value == 1) { # left
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A036554 - N end in odd number of 0 bits, position of right turns
MyOEIS::compare_values
(anum => 'A036554',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'KochCurve',
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value == 1) { # right
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/ZOrderCurve-oeis.t 0000644 0001750 0001750 00000014633 12136177276 016650 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 10;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::ZOrderCurve;
use Math::PlanePath::Diagonals;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A163328 -- radix=3 diagonals same axis
MyOEIS::compare_values
(anum => 'A163328',
func => sub {
my ($count) = @_;
my @got;
my $zorder = Math::PlanePath::ZOrderCurve->new (radix => 3);
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up',
n_start => 0);
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $zorder->xy_to_n ($x, $y);
}
return \@got;
});
# A163329 -- radix=3 diagonals same axis, inverse
MyOEIS::compare_values
(anum => 'A163329',
func => sub {
my ($count) = @_;
my @got;
my $zorder = Math::PlanePath::ZOrderCurve->new (radix => 3);
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up',
n_start => 0);
for (my $n = $zorder->n_start; @got < $count; $n++) {
my ($x, $y) = $zorder->n_to_xy ($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A163330 -- radix=3 diagonals opposite axis
MyOEIS::compare_values
(anum => 'A163330',
func => sub {
my ($count) = @_;
my @got;
my $zorder = Math::PlanePath::ZOrderCurve->new (radix => 3);
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down',
n_start => 0);
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $zorder->xy_to_n ($x, $y);
}
return \@got;
});
# A163331 -- radix=3 diagonals same axis, inverse
MyOEIS::compare_values
(anum => 'A163331',
func => sub {
my ($count) = @_;
my @got;
my $zorder = Math::PlanePath::ZOrderCurve->new (radix => 3);
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down',
n_start => 0);
for (my $n = $zorder->n_start; @got < $count; $n++) {
my ($x, $y) = $zorder->n_to_xy ($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A054238 -- permutation, diagonals same axis
MyOEIS::compare_values
(anum => 'A054238',
func => sub {
my ($count) = @_;
my @got;
my $zorder = Math::PlanePath::ZOrderCurve->new;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up',
n_start => 0);
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy ($n);
push @got, $zorder->xy_to_n ($x, $y);
}
return \@got;
});
# A054239 -- diagonals same axis, inverse
MyOEIS::compare_values
(anum => 'A054239',
func => sub {
my ($count) = @_;
my @got;
my $zorder = Math::PlanePath::ZOrderCurve->new;
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'up',
n_start => 0);
for (my $n = $zorder->n_start; @got < $count; $n++) {
my ($x, $y) = $zorder->n_to_xy ($n);
push @got, $diagonal->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A057300 -- N at transpose Y,X, radix=2
MyOEIS::compare_values
(anum => 'A057300',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::ZOrderCurve->new;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163327 -- N at transpose Y,X, radix=3
MyOEIS::compare_values
(anum => 'A163327',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::ZOrderCurve->new (radix => 3);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A126006 -- N at transpose Y,X, radix=4
MyOEIS::compare_values
(anum => 'A126006',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::ZOrderCurve->new (radix => 4);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A217558 -- N at transpose Y,X, radix=16
MyOEIS::compare_values
(anum => 'A217558',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::ZOrderCurve->new (radix => 16);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x, $y) = ($y, $x);
my $n = $path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/DiamondSpiral-oeis.t 0000644 0001750 0001750 00000013273 12136177302 017151 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 1;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments '###';
use Math::PlanePath::DiamondSpiral;
my $path = Math::PlanePath::DiamondSpiral->new;
#------------------------------------------------------------------------------
# A184636 -- N on Y axis, from Y=2 onwards, if this really is 2*n^2
MyOEIS::compare_values
(anum => 'A184636',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::DiamondSpiral->new (n_start => 0);
my @got = (3);
for (my $y = 2; @got < $count; $y++) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A188551 -- N positions of turns Nstart=-1
MyOEIS::compare_values
(anum => 'A188551',
max_value => 100_000,
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'DiamondSpiral,n_start=-1',
turn_type => 'LSR');
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value != 0 && $i >= 1) {
push @got, $i;
}
}
return \@got;
});
# also prime
MyOEIS::compare_values
(anum => 'A188552',
max_value => 100_000,
func => sub {
my ($count) = @_;
my @got;
require Math::NumSeq::PlanePathTurn;
require Math::Prime::XS;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'DiamondSpiral,n_start=-1',
turn_type => 'LSR');
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value != 0
&& $i >= 1
&& Math::Prime::XS::is_prime($i)) {
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A217296 -- permutation DiamondSpiral -> SquareSpiral rotate +90
# 1 2 3 4 5 6 7 8
# 1, 4, 6, 8, 2, 3, 15, 5,
MyOEIS::compare_values
(anum => 'A217296',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::SquareSpiral;
my $square = Math::PlanePath::SquareSpiral->new;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
($x,$y) = (-$y,$x); # rotate +90
push @got, $square->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A217015 -- permutation SquareSpiral rotate -90 -> DiamondSpiral
# 1 2 3 4 5 6
# 1, 5, 6, 2, 8, 3, 10, 4,
MyOEIS::compare_values
(anum => 'A217015',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::SquareSpiral;
my $square = Math::PlanePath::SquareSpiral->new;
for (my $n = $square->n_start; @got < $count; $n++) {
my ($x, $y) = $square->n_to_xy ($n);
($x,$y) = ($y,-$x); # rotate -90
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A215468 -- N sum 8 neighbours
MyOEIS::compare_values
(anum => 'A215468',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, ($path->xy_to_n($x+1,$y)
+ $path->xy_to_n($x-1,$y)
+ $path->xy_to_n($x,$y+1)
+ $path->xy_to_n($x,$y-1)
+ $path->xy_to_n($x+1,$y+1)
+ $path->xy_to_n($x-1,$y-1)
+ $path->xy_to_n($x-1,$y+1)
+ $path->xy_to_n($x+1,$y-1));
}
return \@got;
});
#------------------------------------------------------------------------------
# A215471 -- primes with >=5 prime neighbours in 8 surround
MyOEIS::compare_values
(anum => 'A215471',
func => sub {
my ($count) = @_;
require Math::Prime::XS;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
my $num = ((!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x,$y-1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y-1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x-1,$y+1)))
+ (!! Math::Prime::XS::is_prime ($path->xy_to_n($x+1,$y-1)))
);
if ($num >= 5) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/Staircase-oeis.t 0000644 0001750 0001750 00000002716 12164406220 016334 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 7;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::Staircase;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A128918 -- N on X axis except initial 1,1
MyOEIS::compare_values
(anum => 'A128918',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Staircase->new (n_start => 2);
my @got = (1,1);
for (my $x = 0; @got < $count; $x++) {
my $n = $path->xy_to_n ($x, 0);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/GcdRationals-oeis.t 0000644 0001750 0001750 00000013007 12136177301 016767 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 6;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::GcdRationals;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A050873 = ceil(X/Y)
MyOEIS::compare_values
(anum => 'A050873',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GcdRationals->new
(pairs_order => 'rows_reverse');
my @got;
my $n_start = $path->n_start;
for (my $n = $n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, div_ceil($x,$y);
}
return \@got;
});
sub div_ceil {
my ($n,$d) = @_;
return int (($n+$d-1) / $d);
}
#------------------------------------------------------------------------------
# A050873 = int(X/Y) + A023532
# so int(X/Y) = A050873 - A023532
{
my ($b2) = MyOEIS::read_values('A023532');
MyOEIS::compare_values
(anum => 'A050873',
max_count => scalar(@$b2),
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GcdRationals->new;
my @got;
my $n_start = $path->n_start;
for (my $n = $n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, int($x/$y) + $b2->[$n-$n_start];
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A178340 Bernoulli denominator = int(X/Y) + 1
# Not quite since A178340 reduced rational. First different at n=49.
#
# MyOEIS::compare_values
# (anum => q{A178340},
# func => sub {
# my ($count) = @_;
# my $path = Math::PlanePath::GcdRationals->new;
# my @got = (1);
# for (my $n = $path->n_start; @got < $count; $n++) {
# my ($x,$y) = $path->n_to_xy($n);
# push @got, int($x/$y) + 1;
# }
# return \@got;
# });
#------------------------------------------------------------------------------
# A033638 - diagonals_down X=1 column, quarter squares + 1, squares+pronic + 1
MyOEIS::compare_values
(anum => 'A033638',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GcdRationals->new
(pairs_order => 'diagonals_down');
my @got = (1);
for (my $y = 1; @got < $count; $y++) {
push @got, $path->xy_to_n(1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A002061 - X axis pairs_order=diagonals_up, central polygonals
MyOEIS::compare_values
(anum => 'A002061',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GcdRationals->new
(pairs_order => 'diagonals_up');
my @got = (1);
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n($x,1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A000124 - Y axis pairs_order=rows (the default), triangular+1
MyOEIS::compare_values
(anum => 'A000124',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GcdRationals->new;
my @got;
for (my $y = 1; @got < $count; $y++) {
push @got, $path->xy_to_n(1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A000290 - X axis pairs_order=diagonals_down, perfect squares
MyOEIS::compare_values
(anum => 'A000290',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GcdRationals->new (pairs_order =>
'diagonals_down');
my @got = (0);
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n($x,1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A002620 - Y axis pairs_order=diagonals_up, squares and pronic
MyOEIS::compare_values
(anum => 'A002620',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GcdRationals->new
(pairs_order => 'diagonals_up');
my @got = (0,0);
for (my $y = 1; @got < $count; $y++) {
push @got, $path->xy_to_n(1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A002522 - Y=X+1 above diagonal pairs_order=diagonals_up, squares+1
MyOEIS::compare_values
(anum => 'A002522',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GcdRationals->new (pairs_order =>
'diagonals_up');
my @got = (1);
for (my $i = 1; @got < $count; $i++) {
push @got, $path->xy_to_n($i,$i+1);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/MPeaks-oeis.t 0000644 0001750 0001750 00000005774 12317701665 015620 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 4;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::MPeaks;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A049450 -- N on Y axis, n_start=0, extra initial 0
MyOEIS::compare_values
(anum => 'A049450',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::MPeaks->new (n_start => 0);
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n (0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A056106 -- N on Y axis, n_start=1, extra initial 1
MyOEIS::compare_values
(anum => 'A056106',
func => sub {
my ($count) = @_;
my @got = (1);
my $path = Math::PlanePath::MPeaks->new;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n (0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A027599 -- N on Y axis, n_start=2, extra initial 6,2
MyOEIS::compare_values
(anum => 'A027599',
func => sub {
my ($count) = @_;
my @got = (6,2);
my $path = Math::PlanePath::MPeaks->new (n_start => 2);
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n (0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A056109 -- N on X negative axis
MyOEIS::compare_values
(anum => 'A056109',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::MPeaks->new;
for (my $x = -1; @got < $count; $x--) {
push @got, $path->xy_to_n ($x,0);
}
return \@got;
});
#------------------------------------------------------------------------------
# A045944 -- N on X axis
MyOEIS::compare_values
(anum => 'A045944',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::MPeaks->new;
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n ($x,0);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/PythagoreanTree-oeis.t 0000644 0001750 0001750 00000043262 12257422351 017526 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 2;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::BigInt try => 'GMP';
use Math::PlanePath::PythagoreanTree;
# uncomment this to run the ### lines
# use Smart::Comments '###';
#------------------------------------------------------------------------------
# A002315 NSW numbers, sum Pell(2k)-Pell(2k-1), is row P-Q
MyOEIS::compare_values
(anum => 'A002315',
max_count => 11,
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ');
for (my $depth = 0; @got < $count; $depth++) {
my $x_total = 0;
foreach my $n ($path->tree_depth_to_n($depth)
.. $path->tree_depth_to_n_end($depth)) {
my ($x,$y) = $path->n_to_xy($n);
$x_total += $x - $y;
}
push @got, $x_total;
}
return \@got;
});
# A001541 is row P+Q
MyOEIS::compare_values
(anum => 'A001541',
max_count => 11,
func => sub {
my ($count) = @_;
my @got = (1);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ');
for (my $depth = 0; @got < $count; $depth++) {
my $x_total = 0;
foreach my $n ($path->tree_depth_to_n($depth)
.. $path->tree_depth_to_n_end($depth)) {
my ($x,$y) = $path->n_to_xy($n);
$x_total += $x + $y;
}
push @got, $x_total;
}
return \@got;
});
# A001653 odd Pells, is row Q total
MyOEIS::compare_values
(anum => 'A001653',
max_count => 11,
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ');
for (my $depth = 0; @got < $count; $depth++) {
my $x_total = 0;
foreach my $n ($path->tree_depth_to_n($depth)
.. $path->tree_depth_to_n_end($depth)) {
my ($x,$y) = $path->n_to_xy($n);
$x_total += $y;
}
push @got, $x_total;
}
return \@got;
});
# A001542 even Pell, is row P total
MyOEIS::compare_values
(anum => 'A001542',
max_count => 11,
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ');
for (my $depth = 0; @got < $count; $depth++) {
my $x_total = 0;
foreach my $n ($path->tree_depth_to_n($depth)
.. $path->tree_depth_to_n_end($depth)) {
my ($x,$y) = $path->n_to_xy($n);
$x_total += $x;
}
push @got, $x_total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A000244 = 3^n is N of A repeatedly in middle of row
MyOEIS::compare_values
(anum => 'A000244',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got;
my $path = Math::PlanePath::PythagoreanTree->new;
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
push @got, ($path->tree_depth_to_n_end($depth)
+ $path->tree_depth_to_n($depth) + 1) / 2;
}
return \@got;
});
#------------------------------------------------------------------------------
# A052940 matrix T repeatedly coordinate P, binary 101111111111 = 3*2^n-1
MyOEIS::compare_values
(anum => 'A052940',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'UMT',
coordinates => 'PQ');
for (my $depth = Math::BigInt->new(1); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n_end($depth));
push @got, $x;
}
return \@got;
});
# A055010 same
MyOEIS::compare_values
(anum => 'A055010',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'UMT',
coordinates => 'PQ');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n_end($depth));
push @got, $x;
}
return \@got;
});
# A083329 same
MyOEIS::compare_values
(anum => 'A083329',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'UMT',
coordinates => 'PQ');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n_end($depth));
push @got, $x;
}
return \@got;
});
# A153893 same
MyOEIS::compare_values
(anum => 'A153893',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got;
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'UMT',
coordinates => 'PQ');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n_end($depth));
push @got, $x;
}
return \@got;
});
# A093357 matrix T repeatedly coordinate B, binary 10111..111000..000
MyOEIS::compare_values
(anum => 'A093357',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'UMT',
coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n_end($depth));
push @got, $y;
}
return \@got;
});
# A134057 matrix T repeatedly coordinate A, binomial(2^n-1,2)
# binary 111..11101000..0001
MyOEIS::compare_values
(anum => 'A134057',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0,0);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'UMT',
coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n_end($depth));
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A106624 matrix K3 repeatedly P,Q pairs 2^k-1,2^k
MyOEIS::compare_values
(anum => 'A106624',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1,0);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'PQ');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n_end($depth));
push @got, $x, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A054881 matrix K2 repeatedly "B" coordinate
MyOEIS::compare_values
(anum => 'A054881',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1,0);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $y;
}
return \@got;
});
# A015249 matrix K2 repeatedly "A" coordinate
MyOEIS::compare_values
(anum => 'A015249',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $x;
}
return \@got;
});
# A084152 same
MyOEIS::compare_values
(anum => 'A084152',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0,0,1);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $x;
}
return \@got;
});
# A084175 same
MyOEIS::compare_values
(anum => 'A084175',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0,1);
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A085601 = matrix K1 repeatedly "C" coordinate, binary 10010001
MyOEIS::compare_values
(anum => 'A085601',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got;
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'AC');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n($depth));
push @got, $y;
}
return \@got;
});
# A028403 = matrix K1 repeatedly "B" coordinate, binary 10010000
MyOEIS::compare_values
(anum => 'A028403',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got;
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n($depth));
push @got, $y;
}
return \@got;
});
# A007582 = matrix K1 repeatedly "B/4" coordinate, binary 1001000
MyOEIS::compare_values
(anum => 'A007582',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got;
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n($depth));
push @got, $y/4;
}
return \@got;
});
#------------------------------------------------------------------------------
# A084159 matrix A repeatedly "A" coordinate, Pell oblongs
MyOEIS::compare_values
(anum => 'A084159',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $x;
}
return \@got;
});
# A046727 matrix A repeatedly "A" coordinate
MyOEIS::compare_values
(anum => 'A046727',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $x;
}
return \@got;
});
# A046729 matrix A repeatedly "B" coordinate
MyOEIS::compare_values
(anum => 'A046729',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $y;
}
return \@got;
});
# A001653 matrix A repeatedly "C" coordinate
MyOEIS::compare_values
(anum => 'A001653',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'AC');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $y;
}
return \@got;
});
# A001652 matrix A repeatedly "S" coordinate
MyOEIS::compare_values
(anum => 'A001652',
# max_count => 50,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'SM');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $x;
}
return \@got;
});
# A046090 matrix A repeatedly "M" coordinate
MyOEIS::compare_values
(anum => 'A046090',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'SM');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $y;
}
return \@got;
});
# A000129 matrix A repeatedly "P" coordinate
MyOEIS::compare_values
(anum => 'A000129',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0,1);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy(3 ** $depth);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A099776 = matrix U repeatedly "C" coordinate
MyOEIS::compare_values
(anum => 'A099776',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got;
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'AC');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n($depth));
push @got, $y;
}
return \@got;
});
# A001844 centred squares same
MyOEIS::compare_values
(anum => 'A001844',
# max_count => 100,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (1);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'AC');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n($depth));
push @got, $y;
}
return \@got;
});
# A046092 matrix U repeatedly "B" coordinate = 4*triangular
MyOEIS::compare_values
(anum => 'A046092',
# max_count => 500,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0);
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'AB');
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n($depth));
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A000466 matrix D repeatedly "A" coordinate = 4n^2-1
MyOEIS::compare_values
(anum => 'A000466',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (-1);
my $path = Math::PlanePath::PythagoreanTree->new;
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
my ($x,$y) = $path->n_to_xy($path->tree_depth_to_n_end($depth));
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A058529 - all prime factors == +/-1 mod 8
# is differences mid-small legs
MyOEIS::compare_values
(anum => 'A058529',
max_count => 35,
func => sub {
my ($count) = @_;
require Math::BigInt;
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'SM');
my %seen;
for (my $n = $path->n_start; $n < 100000; $n++) {
my ($s,$m) = $path->n_to_xy($n);
my $diff = $m - $s;
$seen{$diff} = 1;
}
my @got = sort {$a<=>$b} keys %seen;
$#got = $count-1;
return \@got;
});
#------------------------------------------------------------------------------
# A003462 = (3^n-1)/2 is tree_depth_to_n_end()
MyOEIS::compare_values
(anum => 'A003462',
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = (0);
my $path = Math::PlanePath::PythagoreanTree->new;
for (my $depth = Math::BigInt->new(0); @got < $count; $depth++) {
push @got, $path->tree_depth_to_n_end($depth);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/HypotOctant-oeis.t 0000644 0001750 0001750 00000006242 12136177301 016674 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 4;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use List::Util 'min', 'max';
use Math::PlanePath::HypotOctant;
# uncomment this to run the ### lines
#use Smart::Comments '###';
# #------------------------------------------------------------------------------
# # A001844
#
# {
# my $anum = 'A001844';
# my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
#
# my $diff;
# if ($bvalues) {
# my @got;
# my $path = Math::PlanePath::HypotOctant->new;
# my $i = 0;
# for (my $i = 0; @got < $count; $i++) {
# push @got, $i*$i + ($i+1)*($i+1);
# }
#
# return \@got;
# if ($diff) {
# MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
# MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
# }
# }
# skip (! $bvalues,
# $diff,
# undef,
# "$anum");
# }
#------------------------------------------------------------------------------
# A057653
MyOEIS::compare_values
(anum => 'A057653',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::HypotOctant->new (points => 'odd');
my $prev = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
my $rsquared = $path->n_to_rsquared($n);
if ($rsquared != $prev) {
$prev = $rsquared;
push @got, $rsquared;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A024507
MyOEIS::compare_values
(anum => 'A024507',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::HypotOctant->new;
my $i = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($y != 0 && $x != $y) {
push @got, $path->n_to_rsquared($n);
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A024509
MyOEIS::compare_values
(anum => 'A024509',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::HypotOctant->new;
my $i = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($y != 0) {
push @got, $path->n_to_rsquared($n);
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/PyramidSides-oeis.t 0000644 0001750 0001750 00000003655 12271045176 017026 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 2;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::PyramidSides;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A020703 - permutation N at -X,Y
MyOEIS::compare_values
(anum => 'A020703',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PyramidSides->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n (-$x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A004201 -- N for which X>=0
MyOEIS::compare_values
(anum => 'A004201',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PyramidSides->new;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
if ($x >= 0) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/WythoffArray-oeis.t 0000644 0001750 0001750 00000067115 12400213363 017044 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# A141104 Lower Even Swappage of Upper Wythoff Sequence.
# A141105 Upper Even Swappage of Upper Wythoff Sequence.
# A141106 Lower Odd Swappage of Upper Wythoff Sequence.
# A141107 Upper Odd Swappage of Upper Wythoff Sequence.
use 5.004;
use strict;
use Carp 'croak';
use List::Util 'max';
use Test;
plan tests => 46;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::WythoffArray;
use Math::PlanePath::CoprimeColumns;
*_coprime = \&Math::PlanePath::CoprimeColumns::_coprime;
# uncomment this to run the ### lines
# use Smart::Comments '###';
sub BIGINT {
require Math::NumSeq::PlanePathN;
return Math::NumSeq::PlanePathN::_bigint();
}
# P+A=B P=B-A
sub pair_left_justify {
my ($a,$b) = @_;
my $count = 0;
while ($a <= $b) {
($a,$b) = ($b-$a,$a);
if ($count > 10) {
die "oops cannot left justify $a,$b";
}
}
return ($a,$b);
}
# path_find_row_with_pair() returns the row Y which contains the Fibonacci
# sequence which includes $a,$b somewhere, so W(X,Y)==$a and W(X+1,Y)==$b.
#
# If $a,$b are before the start of a row then the pair are stepped forward
# as necessary. So they specify a Fibonacci-type recurrent sequence which
# is sought.
#
sub path_find_row_with_pair {
my ($path, $a, $b) = @_;
### path_find_row_with_pair(): "$a, $b"
if (($a == 0 && $b == 0) || $b < 0) {
croak "path_find_row_with_pair $a,$b";
}
for (my $count = 0; $count < 50; ($a,$b) = ($b,$a+$b)) {
### at: "a=$a b=$b"
my ($x,$y) = $path->n_to_xy($a) or next;
if ($path->xy_to_n($x+1,$y) == $b) {
### found: " $a $b at X=$x, Y=$y"
return $y;
}
}
die "oops, pair $a,$b not found";
}
#------------------------------------------------------------------------------
# A186007 -- row(i+j) - row(i)
# R(4,1) row 4+1=5 sub row 1
# row=5 | 12 20 32 52 84 136 220 356 576 932 1508
# row=1 | 1 2 3 5 8 13 21 34 55 89 144
# 11 18 29
# tail of row2
# R(4,3) row 4+3=7 sub row 4
# row=7 | 17 28 45 73 118 191 309 500 809 1309 2118
# row=4 | 9 15 24 39 63 102 165 267 432 699 1131
# 8 13
# tail of row=1 fibs
# row=7 | 17 28 45 73 118 191 309 500 809 1309 2118
# row=3 | 6 10 16 26 42 68 110 178 288 466 754
# 11 18
# tail of row=2 lucas
# B-values
# 1, pos=0
# 1,1, pos=1 to 2
# 1,1, 1, pos=3 to 5
# 2,1, 3,1, pos=6 to 9
# 1,3, 1,1,1, pos=10 to 14
# 3,1, 1,1,1,1, pos=15 to 20
# 2,4, 3,3,2,1,1, pos=21 to 27
# 1,2, 8,1,3,1,1,1,
# 4,1, 1,3,1,2,1,3,1,
# 3,6, 4,2,4,1,3,1,1,1,
# 2,3,11,1,2,3,1,2,1,1,1,
# 5
# 1, pos=0
# 1,1, pos=1 to 2
# 1,1, 1, pos=3 to 5
# 2,1, 3,1, pos=6 to 9
# 1,3, 1,1,1, pos=10 to 14
# 3,1, 2,1,1,1, pos=15 to 20 <-
# 2,4, 1,3,2,1,1, pos=21 to 27 <-
# 1,2, 3,1,3,1,1,1,
# 4,1, 8,3,1,2,1,3,1,
# 3,6, 1,2,4,1,3,1,1,1,
# 2,3, 4,1,2,3,1,2,1,1,1,
# 5
# row 9 of W: 22,36,58,94,...
# row 3 of W: 6,10,16,26,...
#
# (row 9)-(row 3): 16,26,42,68 tail of row 3
# code 1....3....1....2....1....3....8....1....4....
# data 1....3....1.... 1....3....8....1....4....11
{
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::WythoffArray->new (x_start=>1, y_start=>1);
my $diag = Math::PlanePath::Diagonals->new (x_start=>1, y_start=>1,
direction => 'up',
n_start => 1);
sub my_A186007 {
my ($n) = @_;
if ($n < 1) { die; }
my ($i,$j) = $diag->n_to_xy($n); # by anti-diagonals
($i,$j) = ($i+$j, $j);
my $ia = $path->xy_to_n(1,$i) or die;
my $ib = $path->xy_to_n(2,$i) or die;
my $ja = $path->xy_to_n(1,$j) or die;
my $jb = $path->xy_to_n(2,$j) or die;
my $da = $ia-$ja;
my $db = $ib-$jb;
my $d = path_find_row_with_pair($path, $da,$db);
# print "n=$n i=$i iab=$ia,$ib j=$j jab=$ja,$jb diff=$da,$db at d=$d\n";
return $d;
}
# foreach my $y (1 .. 5) {
# print " ";
# foreach my $x (1 .. 10) {
# my $n = $diag->xy_to_n($x,$y);
# printf "%d....", my_A186007($n);
# }
# print "\n\n";
# }
#
# print "R(2,6) = ",$diag->xy_to_n(6,2),"\n";
}
MyOEIS::compare_values
(anum => 'A186007',
func => sub {
my ($count) = @_;
my @got;
for (my $n = 1; @got < $count; $n++) {
push @got, my_A186007($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A185735 -- row(i)+row(j) of left-justified array
# 1 0 1 1 2 3
# 2 1 3 4 7 11
# 2 0 2 2 4 6
# 3 0 3 3 6 9
# 4 0 4 4 8 12
# 3 1 4 5 9 14
# row1+row2= 1,0+2,1 = 3,1 = row6
# row1+row3= 1,0+2,0 = 4,0 = row4
MyOEIS::compare_values
(anum => 'A185735',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::WythoffArray->new (x_start=>1, y_start=>1);
# Y>=1, 0<=Xnew (x_start=>1, y_start=>1);
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($i,$j) = $diag->n_to_xy($d); # by anti-diagonals
# if ($i > $j) { ($i,$j) = ($j,$i); }
my $ia = $path->xy_to_n(1,$i) or die;
my $ib = $path->xy_to_n(2,$i) or die;
my $ja = $path->xy_to_n(1,$j) or die;
my $jb = $path->xy_to_n(2,$j) or die;
($ia,$ib) = pair_left_justify($ia,$ib);
($ja,$jb) = pair_left_justify($ja,$jb);
push @got, path_find_row_with_pair($path, $ia+$ja, $ib+$jb);
}
return \@got;
});
#------------------------------------------------------------------------------
# A165357 - Left-justified Wythoff Array by diagonals
{
my $path = Math::PlanePath::WythoffArray->new;
sub left_justified_row_start {
my ($y) = @_;
return pair_left_justify($path->xy_to_n(0,$y),
$path->xy_to_n(1,$y));
}
sub left_justified_xy_to_n {
my ($x,$y) = @_;
my ($a,$b) = left_justified_row_start($y);
foreach (1 .. $x) {
($a,$b) = ($b,$a+$b);
}
return $a;
}
# foreach my $y (0 .. 5) {
# foreach my $x (0 .. 10) {
# printf "%3d ", left_justified_xy_to_n($x,$y);
# }
# print "\n";
# }
}
MyOEIS::compare_values
(anum => 'A165357',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $diag = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
push @got, left_justified_xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A185737 -- accumulation array, by antidiagonals
# accumulation being total sum N in rectangle 0,0 to X,Y
MyOEIS::compare_values
(anum => 'A185737',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
require Math::PlanePath::Diagonals;
my $diag = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
push @got, path_rect_to_accumulation($path, 0,0, $x,$y)
}
return \@got;
});
sub path_rect_to_accumulation {
my ($path, $x1,$y1, $x2,$y2) = @_;
# $x1 = round_nearest ($x1);
# $y1 = round_nearest ($y1);
# $x2 = round_nearest ($x2);
# $y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
my $accumulation = 0;
foreach my $x ($x1 .. $x2) {
foreach my $y ($y1 .. $y2) {
$accumulation += $path->xy_to_n($x,$y);
}
}
return $accumulation;
}
#------------------------------------------------------------------------------
# A173028 -- row number which is x * row(y), by diagonals
# Return pair ($a,$b) which is in the $k'th coprime row of WythoffArray $path
# First pair at $k==1.
sub coprime_pair {
my ($path, $k) = @_;
my $x = $path->x_minimum;
for (my $y = $path->y_minimum; ; $y++) {
my $a = $path->xy_to_n($x, $y);
my $b = $path->xy_to_n($x+1,$y);
if (_coprime($a,$b)) {
$k--;
if ($k <= 0) {
return ($a,$b);
}
}
}
}
# Return the row number Y of WythoffArray $path which contains $multiple
# times the $k'th coprime row.
sub path_y_of_multiple {
my ($path, $multiple, $k) = @_;
### path_y_of_multiple: "$multiple,$k"
if ($multiple < 1) {
croak "path_y_of_multiple multiple=$multiple";
}
($a,$b) = coprime_pair($path,$k);
return path_find_row_with_pair($path, $a*$multiple, $b*$multiple);
}
# {
# my $path = Math::PlanePath::WythoffArray->new (x_start=>1, y_start=>1);
# foreach my $y (1 .. 5) {
# foreach my $x (1 .. 10) {
# printf "%3d ", path_y_of_multiple($path,$x,$y)//-1;
# }
# print "\n";
# }
# }
MyOEIS::compare_values
(anum => 'A173028',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new (x_start=>1, y_start=>1);
require Math::PlanePath::Diagonals;
my $diag = Math::PlanePath::Diagonals->new (x_start => $path->x_minimum,
y_start => $path->y_minimum,
direction => 'up');
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
push @got, path_y_of_multiple($path,$x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A139764 -- lowest Zeckendorf term fibonacci value,
# is N on X axis for the column containing n
MyOEIS::compare_values
(anum => 'A139764',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n($x,0); # down to axis
# Across to Y axis, not in OEIS
# push @got, $path->xy_to_n(0,$y); # across to axis
}
return \@got;
});
#------------------------------------------------------------------------------
# A114579 -- N at transpose Y,X
MyOEIS::compare_values
(anum => 'A114579',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy (BIGINT()->new($n));
my $t = $path->xy_to_n ($y, $x);
push @got, $t;
}
return \@got;
});
#------------------------------------------------------------------------------
# A220249 -- which row is n * Lucas numbers
MyOEIS::compare_values
(anum => 'A220249',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::WythoffArray->new (x_start=>1, y_start=>1);
my @got;
for (my $k = 1; @got < $count; $k++) {
# Lucas numbers starting 1, 3
push @got, path_find_row_with_pair($path, $k, $k*3);
}
return \@got;
});
#------------------------------------------------------------------------------
# A173027 -- which row is n * Fibonacci numbers
MyOEIS::compare_values
(anum => 'A173027',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::WythoffArray->new (x_start=>1, y_start=>1);
my @got;
for (my $k = 1; @got < $count; $k++) {
# Fibonacci numbers starting 1, 1
push @got, path_find_row_with_pair($path, $k, $k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A035614 -- X coord, starting 0
# but is OFFSET=0 so start N=0
MyOEIS::compare_values
(anum => 'A035614',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A188436 -- [3r]-[nr]-[3r-nr], where r=(1+sqrt(5))/2 and []=floor.
# positions of right turns
# Y axis turn right: 0 1 00 101 00 1 00 101
# Fibonacci word: 0 1 00 101 00 1 00 101
#
# N on Y axis
# 101010
# 101001
# 100101
# 100001
# 10101
# 10001
# 1001
# 101
# 1
# A188436: 00000 001000000010000100000001000000010000100000001000010000000100000
# path: 001000000010000100000001000000010000100000001000010000000100000
MyOEIS::compare_values
(anum => 'A188436',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'WythoffArray',
turn_type => 'Right');
my @got = (0,0,0,0,0);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
use constant PHI => (1 + sqrt(5)) / 2;
use POSIX 'floor';
sub A188436_func {
my ($n) = @_;
floor(3*PHI) - floor($n*PHI)-floor(3*PHI-$n*PHI);
}
{
require Math::NumSeq::Fibbinary;
my $seq = Math::NumSeq::Fibbinary->new;
my $bad = 0;
foreach (1 .. 50000) {
my ($i,$seq_value) = $seq->next;
$seq_value = ($seq_value % 8 == 5 ? 1 : 0);
# if ($seq_value) { print "$i," }
my $func_value = A188436_func($i+4);
if ($func_value != $seq_value) {
print "$i fibbinary seq=$seq_value func=$func_value\n";
last if $bad++ > 20;
}
}
ok (0, $bad);
}
{
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'WythoffArray',
turn_type => 'Right');
my $bad = 0;
foreach (1 .. 50000) {
my ($i,$seq_value) = $seq->next;
my $func_value = A188436_func($i+4);
if ($func_value != $seq_value) {
print "$i turn seq=$seq_value func=$func_value\n";
last if $bad++ > 20;
}
}
ok (0, $bad);
}
# [3r]-[(n+4)r]-[3r-(n+4)r]
# = [3r]-[(n+4)r]-[3r-nr-4r]
# = [3r]-[nr+4r]-[-r-nr]
# some of Y axis 4,12,17,25,33,38,46
#------------------------------------------------------------------------------
# A003622 -- Y coordinate of right turns is "odd" Zeckendorf base
MyOEIS::compare_values
(anum => 'A003622',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $path = Math::PlanePath::WythoffArray->new;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value) {
my ($x,$y) = $path->n_to_xy($i);
$x == 0 or die "oops, right turn supposed to be at X=0";
push @got, $y;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A134860 -- Wythoff AAB numbers
# N position of right turns, being Zeckendorf ending "...101"
MyOEIS::compare_values
(anum => 'A134860',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'WythoffArray',
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
if ($value) {
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# Y axis 0=left,1=right is Fibonacci word
{
require Math::NumSeq::PlanePathTurn;
require Math::NumSeq::FibonacciWord;
my $path = Math::PlanePath::WythoffArray->new;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my $fw = Math::NumSeq::FibonacciWord->new;
my $bad = 0;
foreach my $y (1 .. 1000) {
my $n = $path->xy_to_n(0, BIGINT()->new($y));
my $seq_value = $seq->ith($n);
my $fw_value = $fw->ith($y);
if ($fw_value != $seq_value) {
print "y=$y n=$n seq=$seq_value fw=$fw_value\n";
last if $bad++ > 20;
}
}
ok (0, $bad);
}
#------------------------------------------------------------------------------
# A080164 -- Wythoff difference array
# diff(x,y) = wythoff(2x+1,y) - wythoff(2x,y)
MyOEIS::compare_values
(anum => 'A080164',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::WythoffArray->new;
my $diag = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
push @got, $path->xy_to_n(2*$x+1,$y) - $path->xy_to_n(2*$x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A143299 number of Zeckendorf 1-bits in row Y
# cf A007895 which is the fibbinary bit count Math::NumSeq::FibbinaryBitCount
MyOEIS::compare_values
(anum => 'A143299',
func => sub {
my ($count) = @_;
require Math::NumSeq::FibbinaryBitCount;
my $seq = Math::NumSeq::FibbinaryBitCount->new;
my $path = Math::PlanePath::WythoffArray->new;
my @got;
for (my $y = 0; @got < $count; $y++) {
my $n = $path->xy_to_n(0,$y);
push @got, $seq->ith($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A137707 secondary Wythoff array ???
# A137707 Secondary Wythoff Array read by antidiagonals.
# A137708 Secondary Lower Wythoff Sequence.
# A137709 Secondary Upper Wythoff Sequence.
# MyOEIS::compare_values
# (anum => 'A137707',
# func => sub {
# my ($count) = @_;
# require Math::PlanePath::Diagonals;
# my $path = Math::PlanePath::WythoffArray->new;
# my $diag = Math::PlanePath::Diagonals->new;
# my @got;
# for (my $d = $diag->n_start; @got < $count; $d++) {
# my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
# if ($y % 2) {
# push @got, $path->xy_to_n($x,$y-1) + 1;
# } else {
# push @got, $path->xy_to_n($x,$y);
# }
# }
# return \@got;
# });
#------------------------------------------------------------------------------
# A083398 -- anti-diagonals needed to cover numbers 1 to n
# maybe n_range_to_rect() ...
# max(X+Y) for 1 to n
MyOEIS::compare_values
(anum => 'A083398',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got;
my @diag;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
$diag[$n] = $x+$y + 1; # +1 to count first diagonal as 1
push @got, max(@diag[1..$n]);
}
return \@got;
});
#------------------------------------------------------------------------------
# N in columns
foreach my $elem ([ 'A003622', 0 ], # N on Y axis, OFFSET=1
[ 'A035336', 1 ], # N in X=1 column OFFSET=1
[ 'A066097', 1 ], # N in X=1 column, duplicate OFFSET=0
# per list in A035513
[ 'A035337', 2 ], # OFFSET=0
[ 'A035338', 3 ], # OFFSET=0
[ 'A035339', 4 ], # OFFSET=0
[ 'A035340', 5 ], # OFFSET=0
) {
my ($anum, $x, %options) = @$elem;
MyOEIS::compare_values
(anum => $anum,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got = @{$options{'extra_initial'}||[]};
for (my $y = BIGINT()->new(0); @got < $count; $y++) {
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A160997 Antidiagonal sums of the Wythoff array A035513
MyOEIS::compare_values
(anum => 'A160997',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my $d = 0;
my @got;
for (my $d = 0; @got < $count; $d++) {
my $total = 0;
foreach my $x (0 .. $d) {
$total += $path->xy_to_n($x,$d-$x);
}
push @got, $total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A005248 -- every second N on Y=1 row, every second Lucas number
MyOEIS::compare_values
(anum => q{A005248},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got = (2,3); # initial skipped
for (my $x = BIGINT()->new(1); @got < $count; $x+=2) {
push @got, $path->xy_to_n ($x, 1);
}
return \@got;
});
#------------------------------------------------------------------------------
# N on rows
# per list in A035513
foreach my $elem ([ 'A000045', 0, extra_initial=>[0,1] ], # X axis Fibonaccis
[ 'A006355', 2, extra_initial=>[1,0,2,2,4] ],
[ 'A022086', 3, extra_initial=>[0,3,3,6] ],
[ 'A022087', 4, extra_initial=>[0,4,4,8] ],
[ 'A000285', 5, extra_initial=>[1,4,5,9] ],
[ 'A022095', 6, extra_initial=>[1,5,6,11] ],
# sum of Fibonacci and Lucas numbers
[ 'A013655', 7, extra_initial=>[3,2,5,7,12] ],
[ 'A022112', 8, extra_initial=>[2,6,8,14] ],
[ 'A022113', 9, extra_initial=>[2,7,9,16] ],
[ 'A022120', 10, extra_initial=>[3,7,10,17] ],
[ 'A022121', 11, extra_initial=>[3,8,11,19] ],
[ 'A022379', 12, extra_initial=>[3,9,12,21] ],
[ 'A022130', 13, extra_initial=>[4,9,13,22] ],
[ 'A022382', 14, extra_initial=>[4,10,14,24] ],
[ 'A022088', 15, extra_initial=>[0,5,5,10,15,25] ],
[ 'A022136', 16, extra_initial=>[5,11,16,27] ],
[ 'A022137', 17, extra_initial=>[5,12,17,29] ],
[ 'A022089', 18, extra_initial=>[0,6,6,12,18,30] ],
[ 'A022388', 19, extra_initial=>[6,13,19,32] ],
[ 'A022096', 20, extra_initial=>[1,6,7,13,20,33] ],
[ 'A022090', 21, extra_initial=>[0,7,7,14,21,35] ],
[ 'A022389', 22, extra_initial=>[7,15,22,37] ],
[ 'A022097', 23, extra_initial=>[1,7,8,15,23,38] ],
[ 'A022091', 24, extra_initial=>[0,8,8,16,24,40] ],
[ 'A022390', 25, extra_initial=>[8,17,25,42] ],
[ 'A022098', 26, extra_initial=>[1,8,9,17,26,43], ],
[ 'A022092', 27, extra_initial=>[0,9,9,18,27,45], ],
) {
my ($anum, $y, %options) = @$elem;
MyOEIS::compare_values
(anum => $anum,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got = @{$options{'extra_initial'}||[]};
for (my $x = BIGINT()->new(0); @got < $count; $x++) {
push @got, $path->xy_to_n ($x, $y);
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A064274 -- inverse perm of by diagonals up from X axis
MyOEIS::compare_values
(anum => 'A064274',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $diagonals = Math::PlanePath::Diagonals->new (direction => 'up');
my $wythoff = Math::PlanePath::WythoffArray->new;
my @got = (0); # extra 0
for (my $n = $diagonals->n_start; @got < $count; $n++) {
my ($x, $y) = $wythoff->n_to_xy ($n);
$x = BIGINT()->new($x);
$y = BIGINT()->new($y);
push @got, $diagonals->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A003849 -- Fibonacci word
MyOEIS::compare_values
(anum => 'A003849',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got = (0);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, ($x == 0 ? 1 : 0);
}
return \@got;
});
#------------------------------------------------------------------------------
# A000201 -- N+1 for N not on Y axis, spectrum of phi
MyOEIS::compare_values
(anum => 'A000201',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got = (1);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($x != 0) {
push @got, $n+1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A022342 -- N not on Y axis, even Zeckendorfs
MyOEIS::compare_values
(anum => 'A022342',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got = (0);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($x != 0) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A001950 -- N+1 of the N's on Y axis, spectrum
MyOEIS::compare_values
(anum => 'A001950',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffArray->new;
my @got;
for (my $y = 0; @got < $count; $y++) {
my $n = $path->xy_to_n(0,$y);
push @got, $n+1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A083412 -- by diagonals, down from Y axis
MyOEIS::compare_values
(anum => 'A083412',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $diagonals = Math::PlanePath::Diagonals->new (direction => 'down');
my $wythoff = Math::PlanePath::WythoffArray->new;
my @got;
for (my $n = $diagonals->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonals->n_to_xy ($n);
push @got, $wythoff->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A035513 -- by diagonals, up from X axis
MyOEIS::compare_values
(anum => 'A035513',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $diagonals = Math::PlanePath::Diagonals->new (direction => 'up');
my $wythoff = Math::PlanePath::WythoffArray->new;
my @got;
for (my $n = $diagonals->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonals->n_to_xy ($n);
$x = BIGINT()->new($x);
$y = BIGINT()->new($y);
push @got, $wythoff->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/TerdragonCurve-oeis.t 0000644 0001750 0001750 00000035466 12563471745 017401 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 12;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::TerdragonCurve;
# uncomment this to run the ### lines
# use Smart::Comments '###';
my $path = Math::PlanePath::TerdragonCurve->new;
sub ternary_digit_above_low_zeros {
my ($n) = @_;
if ($n == 0) {
return 0;
}
while (($n % 3) == 0) {
$n = int($n/3);
}
return ($n % 3);
}
#------------------------------------------------------------------------------
# A005823 - N positions with net turn == 0, no ternary 1s
MyOEIS::compare_values
(anum => 'A005823',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my $total_turn = 0;
my @got = (0);
while (@got < $count) {
my ($i, $value) = $seq->next;
$total_turn += $value;
if ($total_turn == 0) {
push @got, $i;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A057682 level X
# A057083 level Y
foreach my $elem (['A057682', 1, 0, 0, [0,1]], # X
['A057083', 1, 1, 1, [] ], # Y
['A057681', 2, 0, 0, [1,1]], # X arms=2
['A103312', 2, 0, 0, [0,1,1]], # X arms=2
['A057682', 2, 1, 0, [0] ], # Y arms=2
['A057681', 3, 1, 0, [1,1]], # Y arms=3
['A103312', 3, 1, 0, [0,1,1]], # Y arms=3
) {
my ($anum, $arms, $coord, $initial_level, $initial_got) = @$elem;
my $path = Math::PlanePath::TerdragonCurve->new (arms => $arms);
MyOEIS::compare_values
(anum => $anum,
func => sub {
my ($count) = @_;
require Math::BigInt;
my @got = @$initial_got;
for (my $k = $initial_level; @got < $count; $k++) {
my ($n_lo,$n_hi) = $path->level_to_n_range(Math::BigInt->new($k));
my @coords = $path->n_to_xy($n_hi);
push @got, $coords[$coord];
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A092236 etc counts of segments in direction
foreach my $elem ([1, 'A057083', [], 1],
[0, 'A092236', [], 0],
[1, 'A135254', [0], 0],
[2, 'A133474', [0], 0]) {
my ($dir, $anum, $initial_got, $offset_3k) = @$elem;
MyOEIS::compare_values
(anum => $anum,
max_value => 9,
func => sub {
my ($count) = @_;
my @got = @$initial_got;
my $n = $path->n_start;
my $total = 0;
my $k = 2*$offset_3k;
while (@got < $count) {
### @got
my $n_end = 3**$k;
for ( ; $n < $n_end; $n++) {
$total += (dxdy_to_dir3($path->n_to_dxdy($n)) == $dir);
}
if ($offset_3k) {
push @got, $total - 3**($k-1);
} else {
push @got, $total;
}
$k++;
}
return \@got;
});
}
sub dxdy_to_dir3 {
my ($dx,$dy) = @_;
if ($dx == 2 && $dy == 0) {
return 0;
}
if ($dx == -1) {
if ($dy == 1) {
return 1;
}
if ($dy == -1) {
return 2;
}
}
return undef;
}
#------------------------------------------------------------------------------
# A111286 boundary length is 2 then 3*2^k for points N <= 3^k
MyOEIS::compare_values
(anum => 'A111286',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got = (1);
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($path, 3**$k,
lattice_type => 'triangular');
}
return \@got;
});
# A007283 boundary length is 3*2^k for points N <= 3^k
MyOEIS::compare_values
(anum => 'A007283',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got = (3); # path initial boundary=2 vs bvalues=3
for (my $k = 1; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($path, 3**$k,
lattice_type => 'triangular');
}
return \@got;
});
# A164346 boundary even powers, is 3*4^n
# also one side, odd powers
MyOEIS::compare_values
(anum => 'A164346',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got = (3);
for (my $k = 1; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($path, 3**(2*$k),
lattice_type => 'triangular');
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A164346},
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($path, 3**(2*$k+1),
lattice_type => 'triangular',
side => 'left');
}
return \@got;
});
# A002023 boundary odd powers 6*4^n
# also even powers one side
MyOEIS::compare_values
(anum => 'A002023',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($path, 3**(2*$k+1),
lattice_type => 'triangular');
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A002023',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 1; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($path, 3**(2*$k),
lattice_type => 'triangular',
side => 'right');
}
return \@got;
});
#------------------------------------------------------------------------------
# A003945 R[k] boundary length
MyOEIS::compare_values
(anum => 'A003945',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($path, 3**$k,
side => 'right',
lattice_type => 'triangular');
}
return \@got;
});
#------------------------------------------------------------------------------
# A042950 V[k] boundary length
MyOEIS::compare_values
(anum => 'A042950',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length ($path, 2 * 3**$k,
side => 'left',
lattice_type => 'triangular');
}
return \@got;
});
#------------------------------------------------------------------------------
# A118004 1/2 enclosed area odd levels points N <= 3^(2k+1), is 9^k-4^k
# area[k] = 2*(3^(k-1)-2^(k-1))
# area[2k+1]/2 = 2*(3^(2k+1-1)-2^(2k+1-1))/2
# = 9^k - 4^k
MyOEIS::compare_values
(anum => 'A118004',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
my $area = MyOEIS::path_enclosed_area ($path, 3**(2*$k+1),
lattice_type => 'triangular');
push @got, $area/2;
}
return \@got;
});
# A056182 enclosed area is 2*(3^(k-1)-2^(k-1)) for points N <= 3^k
MyOEIS::compare_values
(anum => 'A056182',
max_value => 10_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 1; @got < $count; $k++) {
push @got, MyOEIS::path_enclosed_area ($path, 3**$k,
lattice_type => 'triangular');
}
return \@got;
});
#------------------------------------------------------------------------------
# A136442 1,1,0,1,1,0,1,0,0,1,1,0,1,1,0,1,0,0,1,1,0,1,0,0,
# OFFSET =0,1,2,3,...
# left 1,1,0,1,1,0,0,1,0,1,1,0,1,1,0,0,1,0,0,1,0,1,1,0,0,1,0,1,1,0,1,1,0,0,1,0,1,1,0,1,1,0,0,1,0,0,1,0,1,1,0,0,1,0,0,1,0,1,1,0,0,1,0,1,1,0,1,1,0,0,1,0,0,1,0,1,1,0,0,1,0,1,1,0,1,1,0,0,1,0,1,1,0,1,1,0,0,1,0,0,1,0,1,1,0
# N=1,2,3,...
# Not quite
#
# MyOEIS::compare_values
# (anum => 'A136442',
# func => sub {
# my ($count) = @_;
# require Math::NumSeq::PlanePathTurn;
# my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
# turn_type => 'Left');
# my @got = (1);
# while (@got < $count) {
# my ($i, $value) = $seq->next;
# push @got, $value;
# }
# return \@got;
# });
#------------------------------------------------------------------------------
# A060032 - turn 1=left, 2=right as bignums to 3^level
MyOEIS::compare_values
(anum => 'A060032',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my @got;
for (my $level = 0; @got < $count; $level++) {
require Math::BigInt;
my $big = Math::BigInt->new(0);
foreach my $n (1 .. 3**$level) {
my $value = $seq->ith($n);
if ($value == -1) { $value = 2; }
$big = 10*$big + $value;
}
push @got, $big;
}
return \@got;
});
#------------------------------------------------------------------------------
# A189673 - morphism turn 1=left, 0=right, extra initial 0
MyOEIS::compare_values
(anum => 'A189673',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Left');
my @got = (0);
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A189640 - morphism turn 0=left, 1=right, extra initial 0
MyOEIS::compare_values
(anum => 'A189640',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my @got = (0);
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A062756 - ternary count 1s, is cumulative turn
MyOEIS::compare_values
(anum => 'A062756',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my @got;
my $cumulative = 0;
for (;;) {
push @got, $cumulative;
last if @got >= $count;
my ($i, $value) = $seq->next;
$cumulative += $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A080846 - turn 0=left, 1=right
MyOEIS::compare_values
(anum => 'A080846',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A038502 - taken mod 3 is 1=left, 2=right
MyOEIS::compare_values
(anum => 'A038502',
fixup => sub {
my ($bvalues) = @_;
@$bvalues = map { $_ % 3 } @$bvalues;
},
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i, $value) = $seq->next;
push @got, $value+1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A026225 - N positions of left turns
MyOEIS::compare_values
(anum => 'A026225',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Left');
my @got;
while (@got < $count) {
my ($i, $value) = $seq->next;
if ($value == 1) {
push @got, $i;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A026225},
func => sub {
my ($count) = @_;
my @got;
for (my $n = 1; @got < $count; $n++) {
if (ternary_digit_above_low_zeros($n) == 1) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A026179 - positions of right turns
MyOEIS::compare_values
(anum => 'A026179',
func => sub {
my ($count) = @_;
my @got = (1); # extra initial 1 ...
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'Right');
while (@got < $count) {
my ($i, $value) = $seq->next;
if ($value == 1) {
push @got, $i;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A026179',
func => sub {
my ($count) = @_;
my @got = (1);
for (my $n = 1; @got < $count; $n++) {
if (ternary_digit_above_low_zeros($n) == 2) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/QuintetCentres-oeis.t 0000644 0001750 0001750 00000004710 12563472320 017376 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::QuintetCentres;
use Test;
plan tests => 11;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A099456 -- level end Y
MyOEIS::compare_values
(anum => 'A099456',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::QuintetCentres->new;
my @got;
require Math::BigInt;
for (my $level = Math::BigInt->new(1); @got < $count; $level++) {
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
my ($x,$y) = $path->n_to_xy($n_hi);
push @got, $y;
}
return \@got;
});
# A139011 -- level end X - 1, Re (2+i)^k
MyOEIS::compare_values
(anum => 'A139011',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::QuintetCentres->new;
my @got;
require Math::BigInt;
for (my $level = Math::BigInt->new(0); @got < $count; $level++) {
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
my ($x,$y) = $path->n_to_xy($n_hi);
push @got, $x + 1;
}
return \@got;
});
# A139011 -- arms=2 level end Y, Re (2+i)^k
MyOEIS::compare_values
(anum => q{A139011},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::QuintetCentres->new (arms => 2);
my @got;
require Math::BigInt;
for (my $level = Math::BigInt->new(0); @got < $count; $level++) {
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
my ($x,$y) = $path->n_to_xy($n_hi);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/HexSpiral-oeis.t 0000644 0001750 0001750 00000014101 12240242753 016310 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# A182619 Number of vertices that are connected to two edges in a spiral without holes constructed with n hexagons.
# A182617 Number of toothpicks in a toothpick spiral around n cells on hexagonal net.
# A182618 Number of new grid points that are covered by the toothpicks added at n-th-stage to the toothpick spiral of A182617.
# A063178 Hexagonal spiral sequence: sequence is written as a hexagonal spiral around a `dummy' center, each entry is the sum of the row in the previous direction containing the previous entry.
# A063253 Values of A063178 on folding point positions of the spiral.
# A063254 Values of A062410 on folding point positions of the spiral.
# A063255 Values of A063177 on folding point positions of the spiral.
# A113519 Semiprimes in first spoke of a hexagonal spiral (A056105).
# A113524 Semiprimes in second spoke of a hexagonal spiral (A056106).
# A113525 Semiprimes in third spoke of a hexagonal spiral (A056107).
# A113527 Semiprimes in fourth spoke of a hexagonal spiral (A056108).
# A113528 Semiprimes in fifth spoke of a hexagonal spiral (A056109).
# A113530 Semiprimes in sixth spoke of a hexagonal spiral (A003215). Semiprime hex (or centered hexagonal) numbers.
# A113653 Isolated semiprimes in the hexagonal spiral.
use 5.004;
use strict;
use Test;
plan tests => 4;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use List::Util 'min', 'max';
use Math::PlanePath::HexSpiral;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A135708 -- grid sticks of N hexagons
# /\ /\
# | | |
# \/ \/
MyOEIS::compare_values
(anum => 'A135708',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::HexSpiral->new;
my @got;
my $boundary = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
$boundary += 6 - triangular_num_preceding_neighbours($path,$n);
push @got, $boundary;
}
return \@got;
});
#------------------------------------------------------------------------------
# A135711 -- boundary length of N hexagons
# /\ /\
# | | |
# \/ \/
MyOEIS::compare_values
(anum => 'A135711',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::HexSpiral->new;
my @got;
my $boundary = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
$boundary += 6 - 2*triangular_num_preceding_neighbours($path,$n);
push @got, $boundary;
}
return \@got;
});
BEGIN {
my @surround6_dx = (2, 1,-1, -2, -1, 1);
my @surround6_dy = (0, 1, 1, 0, -1, -1);
sub triangular_num_preceding_neighbours {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy ($n);
my $count = 0;
foreach my $i (0 .. $#surround6_dx) {
my $n2 = $path->xy_to_n($x + $surround6_dx[$i],
$y + $surround6_dy[$i]);
$count += (defined $n2 && $n2 < $n);
}
return $count;
}
}
#------------------------------------------------------------------------------
# A063436 -- N on slope=3 WSW
MyOEIS::compare_values
(anum => 'A063436',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::HexSpiral->new (n_start => 0);
my $x = 0;
my $y = 0;
while (@got < $count) {
push @got, $path->xy_to_n ($x,$y);
$x -= 3;
$y -= 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A063178 -- a(n) is sum of existing numbers in row of a(n-1)
# 42
# \
# 2-----1 33
# / \ \
# 3 0-----1 23
# \ /
# 5-----8----10
#
# ^ ^ ^ ^ ^ ^ ^
MyOEIS::compare_values
(anum => 'A063178',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::HexSpiral->new;
my @got;
require Math::BigInt;
my %plotted;
$plotted{2,0} = Math::BigInt->new(1);
my $xmin = 0;
my $ymin = 0;
my $xmax = 2;
my $ymax = 0;
push @got, 1;
for (my $n = $path->n_start + 2; @got < $count; $n++) {
my ($prev_x, $prev_y) = $path->n_to_xy ($n-1);
my ($x, $y) = $path->n_to_xy ($n);
### at: "$x,$y prev $prev_x,$prev_y"
my $total = 0;
if (($y > $prev_y && $x < $prev_x)
|| ($y < $prev_y && $x > $prev_x)) {
### forward diagonal ...
foreach my $y ($ymin .. $ymax) {
my $delta = $y - $prev_y;
my $x = $prev_x + $delta;
$total += $plotted{$x,$y} || 0;
}
} elsif (($y == $prev_y && $x < $prev_x)
|| ($y == $prev_y && $x > $prev_x)) {
### opp diagonal ...
foreach my $y ($ymin .. $ymax) {
my $delta = $y - $prev_y;
my $x = $prev_x - $delta;
$total += $plotted{$x,$y} || 0;
}
} else {
### row: "$xmin .. $xmax at y=$prev_y"
foreach my $x ($xmin .. $xmax) {
$total += $plotted{$x,$prev_y} || 0;
}
}
### total: "$total"
$plotted{$x,$y} = $total;
$xmin = min($xmin,$x);
$xmax = max($xmax,$x);
$ymin = min($ymin,$y);
$ymax = max($ymax,$y);
push @got, $total;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/PentSpiralSkewed-oeis.t 0000644 0001750 0001750 00000004321 12240240721 017631 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 3;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::PentSpiralSkewed;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A140066 - N on Y axis
MyOEIS::compare_values
(anum => 'A140066',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PentSpiralSkewed->new;
my @got;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A147875 - N on Y negative axis, n_start=0, second heptagonals
MyOEIS::compare_values
(anum => 'A147875',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PentSpiralSkewed->new (n_start => 0);
my @got;
for (my $y = 0; @got < $count; $y--) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A134238 - N on Y negative axis
MyOEIS::compare_values
(anum => 'A134238',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PentSpiralSkewed->new;
my @got;
for (my $y = 0; @got < $count; $y--) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/HIndexing-oeis.t 0000644 0001750 0001750 00000003012 12153014614 016261 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::HIndexing;
use Test;
plan tests => 11;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A097110 -- Y at N=2^k
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
MyOEIS::compare_values
(anum => 'A097110',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::HIndexing->new;
my @got;
for (my $n = $bigclass->new(1); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/FilledRings-oeis.t 0000644 0001750 0001750 00000006432 12136177301 016623 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::BigInt;
use Math::PlanePath::FilledRings;
use Test;
plan tests => 5;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A036704 -- count |z|<=n+1/2
MyOEIS::compare_values
(anum => 'A036704',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::FilledRings->new (n_start => 0);
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n($x,0);
}
return \@got;
});
#------------------------------------------------------------------------------
# A036708 -- half plane count n-1/2 < |z|<=n+1/2, b>=0
# first diffs of half plane count
# N(X)/2+X-1 - (N(X-1)/2+X-1-1)
# = (N(X)-N(X-1))/2 + X-1 - X + 2
# = (N(X)-N(X-1))/2 + 1
MyOEIS::compare_values
(anum => 'A036708',
func => sub {
my ($count) = @_;
my @got = (1);
my $path = Math::PlanePath::FilledRings->new;
for (my $x = 2; @got < $count; $x++) {
push @got, ($path->xy_to_n($x,0)-$path->xy_to_n($x-1,0))/2 + 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A036707 -- half plane count |z|<=n+1/2, b>=0
MyOEIS::compare_values
(anum => 'A036707',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::FilledRings->new;
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n($x,0)/2 + $x-1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A036706 -- 1/4 of first diffs of N along X axis,
MyOEIS::compare_values
(anum => 'A036706',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::FilledRings->new;
for (my $x = 1; @got < $count; $x++) {
push @got, int (($path->xy_to_n($x,0) - $path->xy_to_n($x-1,0)) / 4);
}
return \@got;
});
#------------------------------------------------------------------------------
# A036705 -- first diffs of N along X axis,
# count of z=a+bi satisfying n-1/2 < |z| <= n+1/2
MyOEIS::compare_values
(anum => 'A036705',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::FilledRings->new;
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n($x,0) - $path->xy_to_n($x-1,0);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/PowerArray-oeis.t 0000644 0001750 0001750 00000033612 12167157313 016521 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 18;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::PowerArray;
# uncomment this to run the ### lines
#use Smart::Comments '###';
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
#------------------------------------------------------------------------------
# A117303 -- permutation, N at transpose (2*x-1)*2^(y-1) <--> (2*y-1)*2^(x-1)
MyOEIS::compare_values
(anum => 'A117303',
func => sub {
my ($count) = @_;
require Math::PlanePath::PowerArray;
my $path = Math::PlanePath::PowerArray->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A151754 -- radix=10, Y at N=2^k starting k=1 N=2, floor(2^k*9/10)
MyOEIS::compare_values
(anum => 'A151754',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PowerArray->new (radix => 10);
my @got;
for (my $n = $bigclass->new(2); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
$x == 0 or die;
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A000975 -- radix=3, Y at N=2^k, being Y=1010101..101 in binary
MyOEIS::compare_values
(anum => 'A000975',
max_count => 1000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PowerArray->new (radix => 3);
my @got;
for (my $n = $bigclass->new(1); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A050603 -- radix=2 abs(dX), but OFFSET=0
MyOEIS::compare_values
(anum => 'A050603',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radix => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n);
push @got, abs($dx);
}
return \@got;
});
#------------------------------------------------------------------------------
# A003159 -- radix=2, N which is in X even
MyOEIS::compare_values
(anum => 'A003159',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PowerArray->new (radix => 2);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy($n);
if ($x % 2 == 0) {
push @got, $n;
}
}
return \@got;
});
# A036554 complement, N which is in X odd
MyOEIS::compare_values
(anum => 'A036554',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PowerArray->new (radix => 2);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy($n);
if ($x % 2 == 1) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A007417 -- radix=3, N which is in X even
MyOEIS::compare_values
(anum => 'A007417',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PowerArray->new (radix => 3);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy($n);
if ($x % 2 == 0) {
push @got, $n;
}
}
return \@got;
});
# A145204 complement, N which is in X odd, and extra initial 0
MyOEIS::compare_values
(anum => 'A145204',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PowerArray->new (radix => 3);
my @got = (0);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy($n);
if ($x % 2 == 1) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A141396 -- radix=3, permutation, N by diagonals
MyOEIS::compare_values
(anum => 'A141396',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $power = Math::PlanePath::PowerArray->new (radix => 3);
my $diagonal = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $diagonal->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal->n_to_xy($n);
push @got, $power->xy_to_n ($x, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A191449 -- radix=3, permutation, N by diagonals up from X axis
MyOEIS::compare_values
(anum => 'A191449',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::Diagonals;
my $diagonals = Math::PlanePath::Diagonals->new (direction => 'up');
my $power = Math::PlanePath::PowerArray->new (radix => 3);
for (my $n = $diagonals->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonals->n_to_xy ($n);
push @got, $power->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A135764 -- dispersion traversed by diagonals, down from Y axis
MyOEIS::compare_values
(anum => 'A135764',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::Diagonals;
my $diagonals = Math::PlanePath::Diagonals->new (direction => 'down');
my $power = Math::PlanePath::PowerArray->new;
for (my $n = $diagonals->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonals->n_to_xy ($n);
push @got, $power->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A075300 -- dispersion traversed by diagonals, minus 1, so starts from 0
MyOEIS::compare_values
(anum => 'A075300',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $diagonals = Math::PlanePath::Diagonals->new (direction => 'up');
my $power = Math::PlanePath::PowerArray->new;
my @got;
for (my $n = $diagonals->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonals->n_to_xy ($n);
push @got, $power->xy_to_n($x,$y) - 1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A001651 -- radix=3, N on Y axis, not divisible by 3
MyOEIS::compare_values
(anum => 'A001651',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radix => 3);
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A067251 -- radix=10, N on Y axis, no trailing 0 digits
MyOEIS::compare_values
(anum => 'A067251',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radix => 10);
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A153733 remove trailing 1s
MyOEIS::compare_values
(anum => 'A153733',
func => sub {
my ($count) = @_;
my @got;
my $power = Math::PlanePath::PowerArray->new;
for (my $n = $power->n_start; @got < $count; $n++) {
my ($x, $y) = $power->n_to_xy ($n);
push @got, 2*$y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A000265 -- 2*Y+1, odd part of n dividing out factors of 2
MyOEIS::compare_values
(anum => 'A000265',
func => sub {
my ($count) = @_;
my @got;
my $power = Math::PlanePath::PowerArray->new;
for (my $n = $power->n_start; @got < $count; $n++) {
my ($x, $y) = $power->n_to_xy ($n);
push @got, 2*$y+1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A094267 -- dX, but OFFSET=0
MyOEIS::compare_values
(anum => 'A094267',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radix => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n);
push @got, $dx;
}
return \@got;
});
#------------------------------------------------------------------------------
# A108715 -- dY
MyOEIS::compare_values
(anum => 'A108715',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radix => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n);
push @got, $dy;
}
return \@got;
});
#------------------------------------------------------------------------------
# A118417 -- N on X=Y+1 diagonal
MyOEIS::compare_values
(anum => 'A118417',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radix => 2);
require Math::BigInt;
for (my $i = Math::BigInt->new(0); @got < $count; $i++) {
push @got, $path->xy_to_n($i+1,$i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A005408 -- N on Y axis, odd numbers
MyOEIS::compare_values
(anum => 'A005408',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new;
for (my $y = 0; @got < $count; $y++) {
push @got, $path->xy_to_n(0,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A057716 -- N not on X axis, the non 2^X
MyOEIS::compare_values
(anum => 'A057716',
func => sub {
my ($count) = @_;
my @got = (0); # extra 0
my $path = Math::PlanePath::PowerArray->new (radix => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($y != 0) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A135765 -- odd numbers radix 3, down from Y axis
#
# 0 1 2 3 4 5 6
# 0 . . 3 4 . . 7 8 . . 11 12
# 2*y+($y%2)
#
# math-image --all --wx --path=PowerArray,radix=3 --output=numbers --size=15x20
#
# A135765 odd numbers by factors of 3
# product A000244 3^n, A007310 1or5 mod 6 is LCF>=5
# 1 5 7 11 13 17 19 23 25 29
# 3 15 21 33 39 51 57 69 75
# 9 25 63 99 117 153 171 207
# 27 135 189 297 351 459 513
# 81 405 567 891 1053 1377
# 243 1215 1701 2673 3159
# 729 3645 5103 8019
# 2187 10935 15309
# 6561 32805
#
MyOEIS::compare_values
(anum => 'A135765',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::Diagonals;
my $diagonals = Math::PlanePath::Diagonals->new (direction => 'down');
my $power = Math::PlanePath::PowerArray->new (radix => 3);
for (my $n = $diagonals->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonals->n_to_xy ($n);
$y = 2*$y+($y%2); # stretch
push @got, $power->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A006519 -- 2^X coord
MyOEIS::compare_values
(anum => 'A006519',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radix => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, 2**$x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A025480 -- Y coord
MyOEIS::compare_values
(anum => 'A025480',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radix => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A003602 -- Y+1 coord, k for which N=(2k-1)*2^m
MyOEIS::compare_values
(anum => 'A003602',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PowerArray->new (radixt => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $y+1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A054582 -- dispersion traversed by diagonals, up from X axis
MyOEIS::compare_values
(anum => 'A054582',
func => sub {
my ($count) = @_;
my @got;
require Math::PlanePath::Diagonals;
my $diagonals = Math::PlanePath::Diagonals->new (direction => 'up');
my $power = Math::PlanePath::PowerArray->new;
for (my $n = $diagonals->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonals->n_to_xy ($n);
push @got, $power->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/GrayCode-oeis.t 0000644 0001750 0001750 00000055341 12563466437 016140 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 33;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::Base::Digits 'digit_split_lowtohigh';
use Math::PlanePath::GrayCode;
use Math::PlanePath::Diagonals;
use Math::PlanePath::Base::Digits
'digit_join_lowtohigh';
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A003188 -- Gray code radix=2 is ZOrder X,Y -> Gray TsF
# and Gray FsT X,Y -> ZOrder
MyOEIS::compare_values
(anum => 'A003188',
func => sub {
my ($count) = @_;
require Math::PlanePath::ZOrderCurve;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'TsF');
my $zorder_path = Math::PlanePath::ZOrderCurve->new;
my @got;
for (my $n = $zorder_path->n_start; @got < $count; $n++) {
my ($x, $y) = $zorder_path->n_to_xy ($n);
my $n = $gray_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A003188},
func => sub {
my ($count) = @_;
require Math::PlanePath::ZOrderCurve;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'FsT');
my $zorder_path = Math::PlanePath::ZOrderCurve->new;
my @got;
for (my $n = $gray_path->n_start; @got < $count; $n++) {
my ($x, $y) = $gray_path->n_to_xy ($n);
my $n = $zorder_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A006068 -- ungray, inverse Gray TsT X,Y -> ZOrder N
# and ZOrder X,Y -> Gray FsF
MyOEIS::compare_values
(anum => 'A006068',
func => sub {
my ($count) = @_;
require Math::PlanePath::ZOrderCurve;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'TsF');
my $zorder_path = Math::PlanePath::ZOrderCurve->new;
my @got;
for (my $n = $gray_path->n_start; @got < $count; $n++) {
my ($x, $y) = $gray_path->n_to_xy ($n);
my $n = $zorder_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
# A006068 -- ungray, ZOrder X,Y -> Gray FsT N
MyOEIS::compare_values
(anum => 'A006068',
func => sub {
my ($count) = @_;
require Math::PlanePath::ZOrderCurve;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'FsT');
my $zorder_path = Math::PlanePath::ZOrderCurve->new;
my @got;
for (my $n = $zorder_path->n_start; @got < $count; $n++) {
my ($x, $y) = $zorder_path->n_to_xy ($n);
my $n = $gray_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A064707 -- permutation radix=2 TsF -> FsT
# inverse square of A003188 Gray code
# A064706 -- permutation radix=2 FsT -> TsF
# square of A003188 Gray code ZOrder->TsF
# not same as A100281,A100282
MyOEIS::compare_values
(anum => q{A064707},
func => sub {
my ($count) = @_;
my $TsF_path = Math::PlanePath::GrayCode->new (apply_type => 'TsF');
my $FsT_path = Math::PlanePath::GrayCode->new (apply_type => 'FsT');
my @got;
for (my $n = $TsF_path->n_start; @got < $count; $n++) {
my ($x, $y) = $TsF_path->n_to_xy ($n);
my $n = $FsT_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A064706},
func => sub {
my ($count) = @_;
my $TsF_path = Math::PlanePath::GrayCode->new (apply_type => 'TsF');
my $FsT_path = Math::PlanePath::GrayCode->new (apply_type => 'FsT');
my @got;
for (my $n = $FsT_path->n_start; @got < $count; $n++) {
my ($x, $y) = $FsT_path->n_to_xy ($n);
my $n = $TsF_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
# {
# my $seq = Math::NumSeq::OEIS->new(anum=>'A099896');
# sub A100281_by_twice {
# my ($i) = @_;
# $i = $seq->ith($i);
# if (defined $i) { $i = $seq->ith($i); }
# return $i;
# }
# }
# sub A100281_by_func {
# my ($i) = @_;
# $i = ($i ^ ($i>>1) ^ ($i>>2));
# $i = ($i ^ ($i>>1) ^ ($i>>2));
# return $i;
# }
#------------------------------------------------------------------------------
# A099896 -- permutation Peano radix=2 -> Gray sF, from N=1 onwards
# n XOR [n/2] XOR [n/4]
# 1, 3, 2, 7, 6, 4, 5, 14, 15, 13, 12, 9, 8, 10, 11, 28, 29, 31, 30, 27,
# to_gray = n xor n/2
# PeanoCurve radix=2
#
# 54--55 49--48 43--42 44--45 64--65 71--70 93--92 90--91 493-492
# | | | | | | | | |
# 53--52 50--51 40--41 47--46 67--66 68--69 94--95 89--88 494-495
#
# 56--57 63--62 37--36 34--35 78--79 73--72 83--82 84--85 483-482
# | | | | | | | | |
# 59--58 60--61 38--39 33--32 77--76 74--75 80--81 87--86 480-481
#
# 13--12 10--11 16--17 23--22 123-122 124-125 102-103 97--96 470-471
# | | | | | | | | |
# 14--15 9-- 8 19--18 20--21 120-121 127-126 101-100 98--99 469-468
#
# 3-- 2 4-- 5 30--31 25--24 117-116 114-115 104-105 111-110 472-473
# | | | | | | | | |
# 0-- 1 7-- 6 29--28 26--27 118-119 113-112 107-106 108-109 475-474
# apply_type => "sF"
#
# 7 | 32--33 37--36 52--53 49--48
# | / \ / \
# 6 | 34--35 39--38 54--55 51--50
# |
# 5 | 42--43 47--46 62--63 59--58
# | \ / \ /
# 4 | 40--41 45--44 60--61 57--56
# |
# 3 | 8-- 9 13--12 28--29 25--24
# | / \ / \
# 2 | 10--11 15--14 30--31 27--26
# |
# 1 | 2-- 3 7-- 6 22--23 19--18
# | \ / \ /
# Y=0 | 0-- 1 5-- 4 20--21 17--16
# |
# +---------------------------------
# X=0 1 2 3 4 5 6 7
MyOEIS::compare_values
(anum => 'A099896',
func => sub {
my ($count) = @_;
require Math::PlanePath::PeanoCurve;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $peano_path = Math::PlanePath::PeanoCurve->new (radix => 2);
my @got;
for (my $n = 1; @got < $count; $n++) {
my ($x, $y) = $peano_path->n_to_xy ($n);
my $n = $gray_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
# A100280 -- inverse
MyOEIS::compare_values
(anum => 'A100280',
func => sub {
my ($count) = @_;
require Math::PlanePath::PeanoCurve;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $peano_path = Math::PlanePath::PeanoCurve->new (radix => 2);
my @got;
for (my $n = $gray_path->n_start; @got < $count; $n++) {
my ($x, $y) = $gray_path->n_to_xy ($n);
my $n = $peano_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A003159 -- (N+1)/2 of positions of Left turns
MyOEIS::compare_values
(anum => 'A003159',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::GrayCode->new;
for (my $n = 2; @got < $count; $n += 2) {
if (path_n_turn($path,$n) == 1) {
push @got, $n/2;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A036554 -- (N+1)/2 of positions of Left turns
MyOEIS::compare_values
(anum => 'A036554',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GrayCode->new;
my @got;
for (my $n = 2; @got < $count; $n += 2) {
if (path_n_turn($path,$n) == 0) {
push @got, $n/2;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A039963 -- Left turns
MyOEIS::compare_values
(anum => 'A039963',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GrayCode->new;
my @got;
for (my $n = $path->n_start + 1; @got < $count; $n++) {
push @got, path_n_turn($path,$n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A035263 -- Left turns undoubled, skip N even
MyOEIS::compare_values
(anum => 'A035263',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GrayCode->new;
my @got;
for (my $n = $path->n_start + 1; @got < $count; $n += 2) {
push @got, path_n_turn($path,$n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A065882 -- low base4 non-zero digit
MyOEIS::compare_values
(anum => 'A065882',
fixup => sub {
my ($bvalues) = @_;
foreach (@$bvalues) { $_ %= 2; }
},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GrayCode->new;
my @got;
for (my $n = $path->n_start + 1; @got < $count; $n += 2) {
push @got, path_n_turn($path,$n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A007913 -- Left turns from square free part of N, skip N even
MyOEIS::compare_values
(anum => q{A007913}, # not xreffed in GrayCode.pm
fixup => sub {
my ($bvalues) = @_;
foreach (@$bvalues) { $_ %= 2; }
},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::GrayCode->new;
my @got;
for (my $n = $path->n_start + 1; @got < $count; $n += 2) {
push @got, path_n_turn($path,$n);
}
return \@got;
});
# return 1 for left, 0 for right
sub path_n_turn {
my ($path, $n) = @_;
my $prev_dir = path_n_dir ($path, $n-1);
my $dir = path_n_dir ($path, $n);
my $turn = ($dir - $prev_dir) % 4;
if ($turn == 1) { return 1; }
if ($turn == 2) { return 0; }
die "Oops, unrecognised turn";
}
# return 0,1,2,3
sub path_n_dir {
my ($path, $n) = @_;
my ($dx,$dy) = $path->n_to_dxdy($n) or die "Oops, no point at ",$n;
return dxdy_to_dir4 ($dx, $dy);
}
# return 0,1,2,3, with Y reckoned increasing upwards
sub dxdy_to_dir4 {
my ($dx, $dy) = @_;
if ($dx > 0) { return 0; } # east
if ($dx < 0) { return 2; } # west
if ($dy > 0) { return 1; } # north
if ($dy < 0) { return 3; } # south
}
#------------------------------------------------------------------------------
# A163233 -- permutation diagonals sF
MyOEIS::compare_values
(anum => 'A163233',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $diagonal_path = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $diagonal_path->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal_path->n_to_xy ($n);
my $n = $gray_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
# A163234 -- diagonals sF inverse
MyOEIS::compare_values
(anum => 'A163234',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $diagonal_path = Math::PlanePath::Diagonals->new (direction => 'up',
n_start => 0);
my @got;
for (my $n = $gray_path->n_start; @got < $count; $n++) {
my ($x, $y) = $gray_path->n_to_xy ($n);
my $n = $diagonal_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163235 -- diagonals sF, opposite side start
MyOEIS::compare_values
(anum => 'A163235',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $diagonal_path = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $diagonal_path->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal_path->n_to_xy ($n);
my $n = $gray_path->xy_to_n ($x, $y);
push @got, $n;
}
return \@got;
});
# A163236 -- diagonals sF inverse, opposite side start
MyOEIS::compare_values
(anum => 'A163236',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $diagonal_path = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $gray_path->n_start; @got < $count; $n++) {
my ($x, $y) = $gray_path->n_to_xy ($n);
my $n = $diagonal_path->xy_to_n ($x, $y);
push @got, $n + $gray_path->n_start - $diagonal_path->n_start;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163237 -- diagonals sF, same side start, flip base-4 digits 2,3
sub flip_base4_23 {
my ($n) = @_;
my @digits = digit_split_lowtohigh($n,4);
foreach my $digit (@digits) {
if ($digit == 2) { $digit = 3; }
elsif ($digit == 3) { $digit = 2; }
}
return digit_join_lowtohigh(\@digits,4);
}
MyOEIS::compare_values
(anum => 'A163237',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $diagonal_path = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $diagonal_path->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal_path->n_to_xy ($n);
my $n = $gray_path->xy_to_n ($x, $y);
$n = flip_base4_23($n);
push @got, $n;
}
return \@got;
});
# A163238 -- inverse
MyOEIS::compare_values
(anum => 'A163238',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $diagonal_path = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $gray_path->n_start; @got < $count; $n++) {
my $n = flip_base4_23($n);
my ($x, $y) = $gray_path->n_to_xy ($n);
$n = $diagonal_path->xy_to_n ($x, $y);
push @got, $n + $gray_path->n_start - $diagonal_path->n_start;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163239 -- diagonals sF, opposite side start, flip base-4 digits 2,3
MyOEIS::compare_values
(anum => 'A163239',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $diagonal_path = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $diagonal_path->n_start; @got < $count; $n++) {
my ($x, $y) = $diagonal_path->n_to_xy ($n);
my $n = $gray_path->xy_to_n ($x, $y);
$n = flip_base4_23($n);
push @got, $n;
}
return \@got;
});
# A163240 -- inverse
MyOEIS::compare_values
(anum => 'A163240',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my $diagonal_path = Math::PlanePath::Diagonals->new (direction => 'down');
my @got;
for (my $n = $gray_path->n_start; @got < $count; $n++) {
my $n = flip_base4_23($n);
my ($x, $y) = $gray_path->n_to_xy ($n);
$n = $diagonal_path->xy_to_n ($x, $y);
push @got, $n + $gray_path->n_start - $diagonal_path->n_start;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163242 -- sF diagonal sums
MyOEIS::compare_values
(anum => 'A163242',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my @got;
for (my $y = 0; @got < $count; $y++) {
my $sum = 0;
foreach my $i (0 .. $y) {
$sum += $gray_path->xy_to_n ($i, $y-$i);
}
push @got, $sum;
}
return \@got;
});
#------------------------------------------------------------------------------
# A163478 -- sF diagonal sums, divided by 3
MyOEIS::compare_values
(anum => 'A163478',
func => sub {
my ($count) = @_;
my $gray_path = Math::PlanePath::GrayCode->new (apply_type => 'sF');
my @got;
for (my $y = 0; @got < $count; $y++) {
my $sum = 0;
foreach my $i (0 .. $y) {
$sum += $gray_path->xy_to_n ($i, $y-$i);
}
push @got, $sum / 3;
}
return \@got;
});
#------------------------------------------------------------------------------
# A003188 - binary gray reflected
# modular and reflected same in binary
MyOEIS::compare_values
(anum => 'A003188',
func => sub {
my ($count) = @_;
my $radix = 2;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A003188',
func => sub {
my ($count) = @_;
my $radix = 2;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_modular($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
# A014550 - binary gray reflected, in binary
MyOEIS::compare_values
(anum => 'A014550',
func => sub {
my ($count) = @_;
my $radix = 2;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,$radix);
push @got, digit_join_lowtohigh($digits,10);
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A014550},
func => sub {
my ($count) = @_;
my $radix = 2;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_modular($digits,$radix);
push @got, digit_join_lowtohigh($digits,10);
}
return \@got;
});
# A006068 - binary gray reflected inverse
MyOEIS::compare_values
(anum => 'A006068',
func => sub {
my ($count) = @_;
my $radix = 2;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_from_gray_reflected($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A006068',
func => sub {
my ($count) = @_;
my $radix = 2;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_from_gray_modular($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
#------------------------------------------------------------------------------
# A105530 - ternary gray modular
MyOEIS::compare_values
(anum => 'A105530',
func => sub {
my ($count) = @_;
my $radix = 3;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_modular($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
# A105529 - ternary gray modular inverse
MyOEIS::compare_values
(anum => 'A105529',
func => sub {
my ($count) = @_;
my $radix = 3;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_from_gray_modular($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
#------------------------------------------------------------------------------
# A128173 - ternary gray reflected
# odd radix to and from are the same
MyOEIS::compare_values
(anum => 'A128173',
func => sub {
my ($count) = @_;
my $radix = 3;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A128173},
func => sub {
my ($count) = @_;
my $radix = 3;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_from_gray_reflected($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
#------------------------------------------------------------------------------
# A003100 - decimal gray reflected
MyOEIS::compare_values
(anum => 'A003100',
func => sub {
my ($count) = @_;
my $radix = 10;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
# A174025 - decimal gray reflected inverse
MyOEIS::compare_values
(anum => 'A174025',
func => sub {
my ($count) = @_;
my $radix = 10;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_from_gray_reflected($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
#------------------------------------------------------------------------------
# A098488 - decimal gray modular
MyOEIS::compare_values
(anum => 'A098488',
func => sub {
my ($count) = @_;
my $radix = 10;
my @got;
for (my $n = 0; @got < $count; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_modular($digits,$radix);
push @got, digit_join_lowtohigh($digits,$radix);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/SierpinskiCurve-oeis.t 0000644 0001750 0001750 00000006055 12153015455 017547 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 14;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::SierpinskiCurve;
use Math::NumSeq::PlanePathDelta;
use Math::NumSeq::PlanePathTurn;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A081026 -- X at N=2^k
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
MyOEIS::compare_values
(anum => 'A081026',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiCurve->new;
my @got = (1);
for (my $n = $bigclass->new(1); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $x;
}
return \@got;
});
#------------------------------------------------------------------------------
# A081706 - N-1 positions of left turns
MyOEIS::compare_values
(anum => 'A081706',
func => sub {
my ($count) = @_;
my $seq = Math::NumSeq::PlanePathTurn->new
(planepath => 'SierpinskiCurve',
turn_type => 'Left');
my @got;
for (my $n = $seq->i_start; @got < $count; $n++) {
my ($i,$value) = $seq->next;
if ($value) { # if a left turn
push @got, $i-1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A039963 - turn 1=right,0=left
# R,R L,L R,R
MyOEIS::compare_values
(anum => 'A039963',
func => sub {
my ($count) = @_;
my $seq = Math::NumSeq::PlanePathTurn->new
(planepath => 'SierpinskiCurve',
turn_type => 'Right');
my @got;
for (my $n = $seq->i_start; @got < $count; $n++) {
push @got, $seq->ith($n);
}
return \@got;
});
#------------------------------------------------------------------------------
# A127254 - abs(dY) extra initial 1
MyOEIS::compare_values
(anum => 'A127254',
func => sub {
my ($count) = @_;
my $seq = Math::NumSeq::PlanePathDelta->new
(planepath => 'SierpinskiCurve',
delta_type => 'AbsdY');
my @got = (1);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/Diagonals-oeis.t 0000644 0001750 0001750 00000020703 12153016342 016313 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 12;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::Diagonals;
# uncomment this to run the ### lines
#use Smart::Comments '###';
# A079824
#------------------------------------------------------------------------------
# A057046 -- X at N=2^k
require Math::NumSeq::PlanePathN;
my $bigclass = Math::NumSeq::PlanePathN::_bigint();
{
my $path = Math::PlanePath::Diagonals->new (n_start => 1,
x_start => 1, y_start => 1);
MyOEIS::compare_values
(anum => 'A057046',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $bigclass->new(1); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $x;
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A057047',
func => sub {
my ($count) = @_;
my @got;
for (my $n = $bigclass->new(1); @got < $count; $n *= 2) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A185787 -- total N in row up to Y=X diagonal
MyOEIS::compare_values
(anum => 'A185787',
max_count => 1000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Diagonals->new;
my @got;
for (my $y = 0; @got < $count; $y++) {
push @got, path_rect_to_accumulation ($path, 0,$y, $y,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A100182 -- total N in column to X=Y leading diagonal
# tetragonal anti-prism numbers (7*n^3 - 3*n^2 + 2*n)/6
MyOEIS::compare_values
(anum => 'A100182',
max_count => 1000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Diagonals->new;
my @got;
for (my $x = 0; @got < $count; $x++) {
push @got, path_rect_to_accumulation ($path, $x,0, $x,$x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A185788 -- total N in row to X=Y-1 before leading diagonal
MyOEIS::compare_values
(anum => 'A185788',
max_count => 1000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Diagonals->new;
my @got = (0);
for (my $y = 1; @got < $count; $y++) {
push @got, path_rect_to_accumulation ($path, 0,$y, $y-1,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A101165 -- total N in column up to Y=X-1 before leading diagonal
MyOEIS::compare_values
(anum => 'A101165',
max_count => 1000,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Diagonals->new;
my @got = (0);
for (my $x = 1; @got < $count; $x++) {
push @got, path_rect_to_accumulation ($path, $x,0, $x,$x-1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A185506 -- accumulation array, by antidiagonals
# accumulation being total sum N in rectangle 0,0 to X,Y
MyOEIS::compare_values
(anum => 'A185506',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Diagonals->new;
my @got;
for (my $d = $path->n_start; @got < $count; $d++) {
my ($x,$y) = $path->n_to_xy($d); # by anti-diagonals
push @got, path_rect_to_accumulation($path, 0,0, $x,$y)
}
return \@got;
});
sub path_rect_to_accumulation {
my ($path, $x1,$y1, $x2,$y2) = @_;
# $x1 = round_nearest ($x1);
# $y1 = round_nearest ($y1);
# $x2 = round_nearest ($x2);
# $y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
my $accumulation = 0;
foreach my $x ($x1 .. $x2) {
foreach my $y ($y1 .. $y2) {
$accumulation += $path->xy_to_n($x,$y);
}
}
return $accumulation;
}
#------------------------------------------------------------------------------
# A103451 -- turn 1=left or right, 0=straight
# but has extra n=1 whereas path first turn at starts N=2
MyOEIS::compare_values
(anum => 'A103451',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'Diagonals',
turn_type => 'LSR');
my @got = (1);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, abs($value);
}
return \@got;
});
#------------------------------------------------------------------------------
# A103452 -- turn 1=left,0=straight,-1=right
# but has extra n=1 whereas path first turn at starts N=2
MyOEIS::compare_values
(anum => 'A103452',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'Diagonals',
turn_type => 'LSR');
my @got = (1);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A215200 -- Kronecker(n-k,k) by rows, n>=1 1<=k<=n
# for n=6 runs n-k=5,4,3,2,1,0 for n=1 runs n-k=0
# k=1,2,3,4,5,6 k=1
# x=n-k y=k is diagonal up from X axis
MyOEIS::compare_values
(anum => q{A215200},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Diagonals->new (direction => 'up',
x_start => 0,
y_start => 1);
require Math::NumSeq::PlanePathCoord;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, Math::NumSeq::PlanePathCoord::_kronecker_symbol($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A038722 -- permutation N at transpose Y,X, n_start=1
MyOEIS::compare_values
(anum => 'A038722',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Diagonals->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A038722',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A061579 -- permutation N at transpose Y,X
MyOEIS::compare_values
(anum => 'A061579',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::Diagonals->new (n_start => 0);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A061579',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::Diagonals->new (n_start => 0,
direction => 'up');
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n ($y, $x);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/TriangleSpiralSkewed-oeis.t 0000644 0001750 0001750 00000023717 12136177277 020525 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# "type-2" skewed to the right
#
# 4
# / |
# 14 4 5 3 ... skew="right"
# 13 3 5 / | |
# 12 2 1 6 6 1--2 12
# 11 10 9 8 7 / |
# 7--8--9--10-11
# "type-3" diagonal first 29
# 16 15 14 13-12-11 28
# /
# 7 17 4--3--2 10 27 skew="up"
# 6 8 | / /
# 5 1 9 18 5 1 9 26
# 4 3 2 10 | /
# 15 14 13 12 11 19 6 8 25
# | /
# 20 7 24
# /
# 21 23
# |/
# 22
# TriangleSpiralSkewed
#
# 4
# |\
# 5 3 ...
# | \ \
# 6 1--2 12
# | \
# 7--8--9-10-11
#
use 5.004;
use strict;
use Test;
plan tests => 14;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use List::Util 'min', 'max';
use Math::PlanePath::TriangleSpiralSkewed;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A214230 -- sum of 8 neighbouring N, skew="left"
MyOEIS::compare_values
(anum => 'A214230',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangleSpiralSkewed->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, path_n_sum_surround8($path,$n);
}
return \@got;
});
# A214251 -- sum of 8 neighbouring N, "type 2" skew="right"
MyOEIS::compare_values
(anum => 'A214251',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangleSpiralSkewed->new (skew => 'right');
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, path_n_sum_surround8($path,$n);
}
return \@got;
});
# A214252 -- sum of 8 neighbouring N, "type 3" skew="up"
MyOEIS::compare_values
(anum => 'A214252',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangleSpiralSkewed->new (skew => 'up');
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, path_n_sum_surround8($path,$n);
}
return \@got;
});
sub path_n_sum_surround8 {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy ($n);
return ($path->xy_to_n($x+1,$y)
+ $path->xy_to_n($x-1,$y)
+ $path->xy_to_n($x,$y+1)
+ $path->xy_to_n($x,$y-1)
+ $path->xy_to_n($x+1,$y+1)
+ $path->xy_to_n($x-1,$y-1)
+ $path->xy_to_n($x-1,$y+1)
+ $path->xy_to_n($x+1,$y-1));
}
#------------------------------------------------------------------------------
# A214231 -- sum of 4 neighbouring N
MyOEIS::compare_values
(anum => 'A214231',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::TriangleSpiralSkewed->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
push @got, path_n_sum_surround4($path,$n);
}
return \@got;
});
sub path_n_sum_surround4 {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy ($n);
return ($path->xy_to_n($x+1,$y)
+ $path->xy_to_n($x-1,$y)
+ $path->xy_to_n($x,$y+1)
+ $path->xy_to_n($x,$y-1)
);
}
#------------------------------------------------------------------------------
# A081272 -- N on slope=2 SSE
MyOEIS::compare_values
(anum => 'A081272',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TriangleSpiralSkewed->new;
my $x = 0;
my $y = 0;
while (@got < $count) {
push @got, $path->xy_to_n ($x,$y);
$x += 1;
$y -= 2;
}
return \@got;
});
#------------------------------------------------------------------------------
# A081275 -- N on X=Y+1 diagonal
MyOEIS::compare_values
(anum => 'A081275',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::TriangleSpiralSkewed->new (n_start => 0);
for (my $y = 0; @got < $count; $y++) {
my $x = $y + 1;
push @got, $path->xy_to_n ($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A217010 -- permutation N values by SquareSpiral order
MyOEIS::compare_values
(anum => 'A217010',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $tsp = Math::PlanePath::TriangleSpiralSkewed->new;
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $square->n_start; @got < $count; $n++) {
my ($x, $y) = $square->n_to_xy ($n);
push @got, $tsp->xy_to_n ($x,$y);
}
return \@got;
});
# A217291 -- inverse, TriangleSpiralSkewed X,Y order, SquareSpiral N
MyOEIS::compare_values
(anum => 'A217291',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $tsp = Math::PlanePath::TriangleSpiralSkewed->new;
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $tsp->n_start; @got < $count; $n++) {
my ($x, $y) = $tsp->n_to_xy ($n);
push @got, $square->xy_to_n ($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A217011 -- permutation N values by SquareSpiral order, type-2, skew="right"
# SquareSpiral North first then clockwise
# Triangle West first then clockwise
# rotate 90 degrees to compensate
MyOEIS::compare_values
(anum => 'A217011',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $tsp = Math::PlanePath::TriangleSpiralSkewed->new (skew => 'right');
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $square->n_start; @got < $count; $n++) {
my ($x, $y) = $square->n_to_xy ($n);
($x,$y) = (-$y,$x); # rotate +90
push @got, $tsp->xy_to_n ($x,$y);
}
return \@got;
});
# A217292 -- inverse, TriangleSpiralSkewed X,Y order, SquareSpiral N
MyOEIS::compare_values
(anum => 'A217292',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $tsp = Math::PlanePath::TriangleSpiralSkewed->new (skew => 'right');
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $tsp->n_start; @got < $count; $n++) {
my ($x, $y) = $tsp->n_to_xy ($n);
($x,$y) = ($y,-$x); # rotate -90
push @got, $square->xy_to_n ($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A217012 -- permutation N values by SquareSpiral order, type-3, skew="up"
# SquareSpiral North first then clockwise
# Triangle South-East first then clockwise
# rotate 90 degrees to compensate
MyOEIS::compare_values
(anum => 'A217012',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $tsp = Math::PlanePath::TriangleSpiralSkewed->new (skew => 'up');
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $square->n_start; @got < $count; $n++) {
my ($x, $y) = $square->n_to_xy ($n);
($x,$y) = ($y,-$x); # rotate -90
push @got, $tsp->xy_to_n ($x,$y);
}
return \@got;
});
# A217293 -- inverse, TriangleSpiralSkewed X,Y order, SquareSpiral N
MyOEIS::compare_values
(anum => 'A217293',
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $tsp = Math::PlanePath::TriangleSpiralSkewed->new (skew => 'up');
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $tsp->n_start; @got < $count; $n++) {
my ($x, $y) = $tsp->n_to_xy ($n);
($x,$y) = (-$y,$x); # rotate +90
push @got, $square->xy_to_n ($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A217012 -- permutation N values by SquareSpiral order
# SquareSpiral North first then clockwise
# Triangle South-East first then clockwise
# rotate 180 degrees to compensate to skew="down"
MyOEIS::compare_values
(anum => q{A217012},
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $tsp = Math::PlanePath::TriangleSpiralSkewed->new (skew => 'down');
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $square->n_start; @got < $count; $n++) {
my ($x, $y) = $square->n_to_xy ($n);
($x,$y) = (-$x,-$y); # rotate 180
push @got, $tsp->xy_to_n ($x,$y);
}
return \@got;
});
# A217293 -- inverse, TriangleSpiralSkewed X,Y order, SquareSpiral N
MyOEIS::compare_values
(anum => q{A217293},
func => sub {
my ($count) = @_;
require Math::PlanePath::SquareSpiral;
my $tsp = Math::PlanePath::TriangleSpiralSkewed->new (skew => 'down');
my $square = Math::PlanePath::SquareSpiral->new;
my @got;
for (my $n = $tsp->n_start; @got < $count; $n++) {
my ($x, $y) = $tsp->n_to_xy ($n);
($x,$y) = (-$x,-$y); # rotate 180
push @got, $square->xy_to_n ($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/PyramidRows-oeis.t 0000644 0001750 0001750 00000020261 12271045012 016666 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
use List::Util 'sum';
plan tests => 13;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::PyramidRows;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A020703 - step=2 permutation N at -X,Y
MyOEIS::compare_values
(anum => 'A020703',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PyramidRows->new (n_start => 1, step => 2);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n (-$x,$y);
}
return \@got;
});
# A221217 - step=4 permutation N at -X,Y
MyOEIS::compare_values
(anum => 'A221217',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PyramidRows->new (n_start => 1, step => 4);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, $path->xy_to_n (-$x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A053615 -- distance to pronic is abs(X)
MyOEIS::compare_values
(anum => 'A053615',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PyramidRows->new (n_start => 0);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
push @got, abs($x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A103451 -- turn 1=left or right, 0=straight
# but has extra n=1 whereas path first turn at starts N=2
MyOEIS::compare_values
(anum => 'A103451',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'PyramidRows,step=1',
turn_type => 'LSR');
my @got = (1);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, abs($value);
}
return \@got;
});
#------------------------------------------------------------------------------
# A103452 -- turn 1=left,0=straight,-1=right
# but has extra n=1 whereas path first turn at starts N=2
MyOEIS::compare_values
(anum => 'A103452',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'PyramidRows,step=1',
turn_type => 'LSR');
my @got = (1);
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
# A050873 -- step=1 GCD(X+1,Y+1) by rows
MyOEIS::compare_values
(anum => 'A050873',
func => sub {
my ($count) = @_;
require Math::PlanePath::GcdRationals;
my $path = Math::PlanePath::PyramidRows->new (step => 1);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, Math::PlanePath::GcdRationals::_gcd($x+1,$y+1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A051173 -- step=1 LCM(X+1,Y+1) by rows
MyOEIS::compare_values
(anum => 'A051173',
func => sub {
my ($count) = @_;
require Math::PlanePath::GcdRationals;
my $path = Math::PlanePath::PyramidRows->new (step => 1);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
push @got, ($x+1) * ($y+1)
/ Math::PlanePath::GcdRationals::_gcd($x+1,$y+1);
}
return \@got;
});
#------------------------------------------------------------------------------
# A215200 -- Kronecker(n-k,k) by rows, n>=1 1<=k<=n
MyOEIS::compare_values
(anum => q{A215200},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PyramidRows->new (step => 1);
require Math::NumSeq::PlanePathCoord;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy ($n);
next if $x == 0 || $y == 0;
my $n = $y;
my $k = $x;
push @got, Math::NumSeq::PlanePathCoord::_kronecker_symbol($n-$k,$k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A004201 -- N for which X>=0, step=2
MyOEIS::compare_values
(anum => 'A004201',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PyramidRows->new (step => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
if ($x >= 0) {
push @got, $n;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A079824 -- diagonal sums
# cf A079825 with rows numbered alternately left and right
# a(21)=(n/6)*(7*n^2-6*n+5)
MyOEIS::compare_values
(anum => 'A079824',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::PyramidRows->new(step=>1);
for (my $y = 0; @got < $count; $y++) {
my @diag;
foreach my $i (0 .. $y) {
my $n = $path->xy_to_n($i,$y-$i);
next if ! defined $n;
push @diag, $n;
}
my $total = sum(@diag);
push @got, $total;
# if ($y <= 21) {
# MyTestHelpers::diag (join('+',@diag)," = $total");
# }
}
return \@got;
});
#------------------------------------------------------------------------------
# A000217 -- step=1 X=Y diagonal, the triangular numbers from 1
MyOEIS::compare_values
(anum => 'A000217',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::PyramidRows->new (step => 1);
for (my $i = 0; @got < $count; $i++) {
push @got, $path->xy_to_n($i,$i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A000290 -- step=2 X=Y diagonal, the squares from 1
MyOEIS::compare_values
(anum => 'A000290',
func => sub {
my ($count) = @_;
my @got = (0);
my $path = Math::PlanePath::PyramidRows->new (step => 2);
for (my $i = 0; @got < $count; $i++) {
push @got, $path->xy_to_n($i,$i);
}
return \@got;
});
#------------------------------------------------------------------------------
# A167407 -- dDiffXY step=1, extra initial 0
MyOEIS::compare_values
(anum => 'A167407',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::PyramidRows->new (step => 1);
my @got = (0);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($dx, $dy) = $path->n_to_dxdy ($n);
push @got, $dx-$dy;
}
return \@got;
});
#------------------------------------------------------------------------------
# A010052 -- step=2 dY, 1 at squares
MyOEIS::compare_values
(anum => 'A010052',
func => sub {
my ($count) = @_;
my @got = (1);
my $path = Math::PlanePath::PyramidRows->new (step => 2);
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
my ($next_x, $next_y) = $path->n_to_xy ($n+1);
push @got, $next_y - $y;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/FibonacciWordFractal-oeis.t 0000644 0001750 0001750 00000003147 12207313504 020423 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 1;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::FibonacciWordFractal;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A003849 - Fibonacci word 0/1, 0=straight,1=left or right
MyOEIS::compare_values
(anum => 'A003849',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new
(planepath => 'FibonacciWordFractal',
turn_type => 'LSR'); # turn_type=Straight
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value == 0 ? 1 : 0;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/DivisibleColumns-oeis.t 0000644 0001750 0001750 00000005133 12136177301 017671 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 3;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::DivisibleColumns;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# A077597 - N on X=Y diagonal, being cumulative count divisors - 1
MyOEIS::compare_values
(anum => 'A077597',
func => sub {
my ($count) = @_;
my @got;
my $path = Math::PlanePath::DivisibleColumns->new;
for (my $x = 1; @got < $count; $x++) {
push @got, $path->xy_to_n($x,$x);
}
return \@got;
});
#------------------------------------------------------------------------------
# A027751 - Y coord, proper divisors, extra initial 1
MyOEIS::compare_values
(anum => 'A027751',
func => sub {
my ($count) = @_;
my @got = (1);
my $path = Math::PlanePath::DivisibleColumns->new
(divisor_type => 'proper');
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A006218 - cumulative count of divisors
{
my $anum = 'A006218';
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my $good = 1;
my $count = 0;
if ($bvalues) {
my $path = Math::PlanePath::DivisibleColumns->new;
for (my $i = 0; $i < @$bvalues; $i++) {
my $x = $i+1;
my $want = $bvalues->[$i];
my $got = $path->xy_to_n($x,1);
if ($got != $want) {
MyTestHelpers::diag ("wrong totient sum xy_to_n($x,1)=$got want=$want at i=$i of $filename");
$good = 0;
}
$count++;
}
}
ok ($good, 1, "$anum count $count");
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/Hypot-oeis.t 0000644 0001750 0001750 00000014677 12136645623 015545 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 1;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::Hypot;
# uncomment this to run the ### lines
# use Smart::Comments '###';
#------------------------------------------------------------------------------
# A199015 -- partial sums of A008441
MyOEIS::compare_values
(anum => 'A199015',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Hypot->new(points=>'square_centred');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 2;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
my $norm = $x*$x + $y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num/4;
$want_norm += 8;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A005883 -- count points with norm==4*n+1
# Theta series of square lattice with respect to deep hole.
#
# same as "odd" turned 45-degrees
#
# 3 . 2 . 2 . 3
#
# . . . . . . .
#
# 2 . 1 . 1 . 2
#
# . . . o . . .
#
# 2 . 1 . 1 . 2
#
# . . . . . . .
#
# 3 . 2 . 2 . 3
#
# 4, 8, 4, 8,8,0,12,8,0,8,8,8,4,8,0,8,16,0,8,0,4
MyOEIS::compare_values
(anum => 'A005883',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Hypot->new(points=>'square_centred');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 2;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
my $norm = $x*$x + $y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 8;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
# A008441 = A005883/4
# how many ways to write n = x(x+1)/2 + y(y+1)/2 sum two triangulars
MyOEIS::compare_values
(anum => 'A008441',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Hypot->new(points=>'square_centred');
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 2;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
my $norm = $x*$x + $y*$y;
if ($norm > $want_norm) {
### push: $num
push @got, $num/4;
$want_norm += 8;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
# MyOEIS::compare_values
# (anum => 'A005883',
# func => sub {
# my ($count) = @_;
# my @got;
# my $path = Math::PlanePath::Hypot->new (points => 'square_centred');
# my $n = $path->n_start;
# my $i = 0;
# for (my $i = 0; @got < $count; $i++) {
# my $points = 0;
# for (;;) {
# my $h = $path->n_to_rsquared($n);
# if ($h > 4*$i+1) {
# last;
# }
# $points++;
# $n++;
# }
# ### $points
# push @got, $points;
# }
# return \@got;
# });
#------------------------------------------------------------------------------
# A004020 Theta series of square lattice with respect to edge.
# 2,4,2,4,4
#
# 2 . 2 .
#
# . . . . . .
#
# . 1 o 1 .
#
# . . . .
#
# . 2 . 2 .
#
# Y mod 2 == 0
# X mod 2 == 1
# X+2Y mod 4 == 1
sub xy_is_edge {
my ($x, $y) = @_;
return ($y%2 == 0 && $x%2 == 1);
}
MyOEIS::compare_values
(anum => q{A004020}, # with zeros
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::Hypot->new;
my @got;
my $n = $path->n_start;
my $num = 0;
my $want_norm = 1;
while (@got < $count) {
my ($x,$y) = $path->n_to_xy($n);
if (! xy_is_edge($x,$y)) {
$n++;
next;
}
my $norm = $path->n_to_rsquared($n);
if ($norm > $want_norm) {
### push: $num
push @got, $num;
$want_norm += 4;
$num = 0;
} else {
### point: "$n at $x,$y norm=$norm total num=$num"
$n++;
$num++;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A093837 - denominators N(r) / r^2
{
my $path = Math::PlanePath::Hypot->new;
sub Nr {
my ($r) = @_;
my $n = $path->xy_to_n($r,0);
for (;;) {
my $m = $n+1;
my ($x,$y) = $path->n_to_xy($m);
if ($x*$x+$y*$y > $r*$r) {
return $n;
}
$n = $m;
}
}
}
MyOEIS::compare_values
(anum => q{A093837},
func => sub {
my ($count) = @_;
require Math::BigRat;
my @got;
for (my $r = 1; @got < $count; $r++) {
my $Nr = Nr($r);
my $rsquared = $r*$r;
my $frac = Math::BigRat->new("$Nr/$rsquared");
push @got, $frac->denominator;
}
return \@got;
});
#------------------------------------------------------------------------------
# A093832 - N(r) / r^2 > pi
use Math::Trig 'pi';
MyOEIS::compare_values
(anum => q{A093832},
func => sub {
my ($count) = @_;
require Math::BigRat;
my @got;
for (my $r = 1; @got < $count; $r++) {
my $Nr = Nr($r);
my $rsquared = $r*$r;
if ($Nr / $rsquared > pi) {
push @got, $r;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/SierpinskiTriangle-oeis.t 0000644 0001750 0001750 00000057442 12503737432 020243 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 16;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::BigInt try => 'GMP';
use Math::NumSeq::BalancedBinary;
use Math::PlanePath::SierpinskiTriangle;
use Math::PlanePath::KochCurve;
*_digit_join_hightolow = \&Math::PlanePath::KochCurve::_digit_join_hightolow;
# uncomment this to run the ### lines
# use Smart::Comments '###';
# {
# my $path = Math::PlanePath::SierpinskiTriangle->new;
# print branch_reduced_breadth_bits($path,4);
# exit 0;
# }
#------------------------------------------------------------------------------
{
my $bal = Math::NumSeq::BalancedBinary->new;
# $aref is an arrayref of 1,0 bits.
sub dyck_bits_to_index {
my ($aref) = @_;
my $value = _digit_join_hightolow($aref, 2, Math::BigInt->new(0));
return $bal->value_to_i($value);
}
}
#------------------------------------------------------------------------------
# A130047 - left half Pascal mod 2
MyOEIS::compare_values
(anum => 'A130047',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $y = 0; @got < $count; $y++) {
for (my $x = -$y; $x <= 0 && @got < $count; $x += 2) {
push @got, $path->xy_is_visited($x,$y) ? 1 : 0;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# Branch-reduced breadth-wise
#
# Nodes with just 1 child are collapsed out.
# cf Homeomorphic same if dropping/adding single-child nodes
#
# A080318 decimal
# A080319 binary
# A080320 positions in A014486 list of balanced
#
# 10, branch reduced
# 111000,
# 11111110000000,
# 1111111-11000011-0000000,
# 11111111100001111111111000000000000000,
#
# . .
# *
# plain 10
#
# . . . .
#
# * *
# \ /
# *
# plain 111000
#
# . . . .
#
# * . . *
# \ / . . . .
# * * * *
# \ / \ /
# * *
# plain 1111001000 reduced 111000
#
# . . . . . . . .
# * * * *
# \ / \ / . . .... ..
# * . . * * * * *
# \ / \ / \ /
# * * * *
# \ / \ /
# * *
# plain reduced 11111110000000
#
# . . . .
# * *
# \ . . . . . . /
# * * * *
# \ / \ /
# * . . *
# \ /
# * *
# \ /
# *
#
# . . . . . . . .
# * * * *
# \ / \ /
# * *
# \ . . . . . . / . . . . . . . . 7 trailing
# * * * * * * * *
# \ / \ / \ / ....\ /
# * . . * * * * *
# \ / \ / \ /
# * * * *
# \ / \ /
# * *
# reduced 1111111110000110000000
#
# * * * *
# \ . . / \ . . /
# * * * *
# \ / \ /
# * *
# \ . . . . . . /
# * * * *
# \ / \ /
# * . . *
# \ /
# * *
# \ /
# *
#
# * * * * * * * *
# \ / \ / \ / \ /
# * * * *
# \ . . / \ . . /
# * * * *
# \ / \ / .. .. ............ 15 trailing
# * * * * * * * * * *
# \ . . . . . . / \ / \/ \/ \/
# * * * * * * * *
# \ / \ / \ / ....\ /
# * . . * * * * *
# \ / \ / \ /
# * * * *
# \ / \ /
# * *
# reduced 11111111100001111111111000000000000000
#
# 1111111110000111111111111000000000000110000000
# 11111111100001111111111110000000000001111111111000000000000000
# [9] [4] [12] [12] [10] [15]#
#
# 331698516757016399905370236824584576
# 11111111100001111111111110000000000001111111111110000111100001111111\
# 11111111111110000000000000000000000000000110000000
# 2 0 0 0 0 0 0 2 2 0 0 0 0 0 0 2
# 11 2 2 2 2 2 2 2 2
# 10 2 0 0 2 2 0 0 2
# 9 2 2 0 0 0 0 2 2
## 6 2 2 2 2
# 5 2 0 0 2
# 3 2 2
# 2 2
# 0
{
# double-up check
my ($one) = MyOEIS::read_values('A080268');
my ($two) = MyOEIS::read_values('A080318');
my $path = Math::PlanePath::SierpinskiTriangle->new;
require Math::BigInt;
for (my $i = 0; $i <= $#$one && $i+1 <= $#$two; $i++) {
my $o = $one->[$i];
my $t = $two->[$i+1];
my $ob = Math::BigInt->new("$o")->as_bin;
$ob =~ s/^0b//;
my $o2 = $ob;
$o2 =~ s/(.)/$1$1/g; # double
$o2 = "1".$o2."0";
my $tb = Math::BigInt->new("$t")->as_bin;
$tb =~ s/^0b//;
# print "o $o\nob $ob\no2 $o2\ntb $tb\n\n";
$tb eq $o2 or die "x";
}
}
# decimal, by path
MyOEIS::compare_values
(anum => 'A080318',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $depth = 0; @got < $count; $depth++) {
### $depth
my @bits = branch_reduced_breadth_bits($path, $depth);
### @bits
push @got, _digit_join_hightolow(\@bits, 2, Math::BigInt->new(0));
}
return \@got;
});
# binary, by path
MyOEIS::compare_values
(anum => 'A080319',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
# foreach my $depth (0 .. 11) {
# my @bits = branch_reduced_breadth_bits($path, $depth);
# print @bits,"\n";
# }
my @got;
for (my $depth = 0; @got < $count; $depth++) {
my @bits = branch_reduced_breadth_bits($path, $depth);
push @got, _digit_join_hightolow(\@bits, 10, Math::BigInt->new(0));
}
return \@got;
});
# position in list of all balanced binary (A014486)
MyOEIS::compare_values
(anum => 'A080320',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $depth = 0; @got < $count; $depth++) {
my @bits = branch_reduced_breadth_bits($path, $depth);
push @got, dyck_bits_to_index(\@bits);
}
return \@got;
});
# Return a list of 0,1 bits.
#
sub branch_reduced_breadth_bits {
my ($path, $limit) = @_;
my @pending_n = ($path->n_start);
my @ret;
foreach (0 .. $limit) {
### pending_n: join(',',map{$_//'undef'}@pending_n)
my @new_n;
foreach my $n (@pending_n) {
if (! defined $n) {
push @ret, 0;
next;
}
my ($x,$y) = $path->n_to_xy($n);
push @ret, 1;
$y += 1;
foreach my $dx (-1, 1) {
my $n_child = $path->xy_to_n($x+$dx,$y);
if (defined $n_child) {
$n_child = path_tree_n_branch_reduce($path,$n_child);
}
push @new_n, $n_child;
}
}
@pending_n = @new_n;
}
### final ...
### pending_n: join(',',map{$_//'undef'}@pending_n)
### ret: join('',@ret) . ' ' .('0' x $#pending_n)
return @ret, ((0) x $#pending_n);
}
# sub path_tree_n_branch_reduced_children {
# my ($path, $n) = @_;
# for (;;) {
# my @n_children = $path->tree_n_children($n);
# if (@n_children != 1) {
# return @n_children;
# }
# $n = $n_children[0];
# }
# }
# If $n has only 1 child then descend through it and any further
# 1-child nodes to return an N which has 2 or more children.
# If all the descendents of $n are 1-child then return undef.
sub path_tree_n_branch_reduce {
my ($path, $n) = @_;
my @n_children = $path->tree_n_children($n);
if (@n_children == 1) {
do {
$n = $n_children[0];
@n_children = $path->tree_n_children($n) or return undef;
} while (@n_children == 1);
}
return $n;
}
# Return $x,$y moved down to a "branch reduced" position, if necessary.
# A branch reduced tree has all nodes as either leaves or with 2 or more
# children. If $x,$y has only 1 child then follow down that child node and
# any 1-child nodes below, until reaching a 0 or 2 or more node. If $x,$y
# already has 0 or 2 or more then it's returned unchanged.
#
sub path_tree_xy_branch_reduced {
my ($path, $x,$y) = @_;
for (;;) {
my @xy_list = path_tree_xy_children($path, $x,$y);
if (@xy_list == 2) {
($x,$y) = @xy_list; # single child, descend
} else {
last; # multiple children or nothing, return this $x,$y
}
}
return ($x,$y);
}
# Return a list ($x1,$y1, $x2,$y2, ...) which are the children of $x,$y.
sub path_tree_xy_children {
my ($path, $x,$y) = @_;
return map {$path->n_to_xy($_)}
map {$path->tree_n_children($_)}
$path->xy_to_n_list($x,$y);
}
# Return the number of children of $x,$y, or undef if $x,$y is not visited.
sub path_tree_xy_num_children {
my ($path, $x,$y) = @_;
my $n = $path->xy_to_n($x,$y);
if (! defined $n) { return undef; }
return $path->tree_n_num_children($path,$n);
}
# Return true if $x,$y is a leaf node, ie. has no children.
sub path_tree_xy_is_leaf {
my ($path, $x,$y) = @_;
my $n = $path->xy_to_n($x,$y);
if (! defined $n) { return undef; }
return path_tree_n_is_leaf($path,$n);
}
# Return true if $n is a leaf node, ie. has no children.
sub path_tree_n_is_leaf {
my ($path, $n) = @_;
my $num_children = $path->tree_n_num_children($n);
if (! defined $num_children) { return undef; }
return $num_children == 0;
}
# Return a list of 0,1 bits.
#
sub DOUBLEUP_branch_reduced_breadth_bits {
my ($path, $limit) = @_;
my @pending_x = (0);
my @pending_y = (0);
my @ret = (1);
foreach (1 .. $limit) {
my @new_x;
my @new_y;
foreach my $i (0 .. $#pending_x) {
my $x = $pending_x[$i];
my $y = $pending_y[$i];
if ($path->xy_is_visited($x,$y)) {
push @ret, 1,1;
push @new_x, $x-1;
push @new_y, $y+1;
push @new_x, $x+1;
push @new_y, $y+1;
} else {
push @ret, 0,0;
}
}
@pending_x = @new_x;
@pending_y = @new_y;
}
return (@ret,
((0) x $#pending_x)); # pending open nodes
}
#------------------------------------------------------------------------------
# A001317 - rows as binary bignums, without the skipped (x^y)&1==1 points of
# triangular lattice
MyOEIS::compare_values
(anum => 'A001317',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new (align => 'right');
my @got;
require Math::BigInt;
for (my $y = 0; @got < $count; $y++) {
my $b = 0;
foreach my $x (0 .. $y) {
if ($path->xy_is_visited($x,$y)) {
$b += Math::BigInt->new(2) ** $x;
}
}
push @got, "$b";
}
return \@got;
});
#------------------------------------------------------------------------------
# Dyck coded, depth-first
# A080263 sierpinski 2, 50, 906, 247986
# A080264 binary 10, 110010, 1110001010, 111100100010110010
# ( )
#
# * * * *
# \ / \ /
# * * * *
# \ / \ /
# * * * * * *
# \ / \ / \ /
# * * * *
# 10 110010 1,1100,0101,0 11,110010,0010,110010
# 10, 110010, 1110001010, 111100100010110010
# (())()
# [(())()]
# binary
MyOEIS::compare_values
(anum => 'A080264',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $depth = 1; @got < $count; $depth++) {
my @bits = dyck_tree_bits($path, 0,0, $depth);
push @got, _digit_join_hightolow(\@bits, 10, Math::BigInt->new(0));
}
return \@got;
});
# position in list of all balanced binary (A014486)
MyOEIS::compare_values
(anum => 'A080265',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $depth = 1; @got < $count; $depth++) {
my @bits = dyck_tree_bits($path, 0,0, $depth);
push @got, dyck_bits_to_index(\@bits);
}
return \@got;
});
# decimal
MyOEIS::compare_values
(anum => 'A080263',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $depth = 1; @got < $count; $depth++) {
my @bits = dyck_tree_bits($path, 0,0, $depth);
push @got, _digit_join_hightolow(\@bits, 2, Math::BigInt->new(0));
}
return \@got;
});
# No-such node = 0.
# Node = 1,left,right.
# Drop very last 0 at end.
#
sub dyck_tree_bits {
my ($path, $x,$y, $limit) = @_;
my @ret = dyck_tree_bits_z ($path, $x,$y, $limit);
pop @ret;
return @ret;
}
sub dyck_tree_bits_z {
my ($path, $x,$y, $limit) = @_;
if ($limit > 0 && $path->xy_is_visited($x,$y)) {
return (1,
dyck_tree_bits_z($path, $x-1,$y+1, $limit-1), # left
dyck_tree_bits_z($path, $x+1,$y+1, $limit-1)); # right
} else {
return (0);
}
}
# Doesn't distinguish left and right.
# sub parens_bits_z {
# my ($path, $x,$y, $limit) = @_;
# if ($limit > 0 && $path->xy_is_visited($x,$y)) {
# return (1,
# parens_bits_z($path, $x-1,$y+1, $limit-1), # left
# parens_bits_z($path, $x+1,$y+1, $limit-1), # right
# 0);
# } else {
# return ();
# }
# }
#------------------------------------------------------------------------------
# breath-wise "level-order"
#
# A080268 decimal 2, 56, 968, 249728, 3996680,
# A080269 binary 10, 111000, 1111001000, 111100111110000000, 1111001111110000001000,
# (( (()) () ))
#
# 111100111111000000111111001100111111111000000000000000
#
# cf A057118 permute depth<->breadth
#
# position in list of all balanced binary (A014486)
MyOEIS::compare_values
(anum => 'A080270',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $depth = 1; @got < $count; $depth++) {
my @bits = level_order_bits($path, $depth);
push @got, dyck_bits_to_index(\@bits);
}
return \@got;
});
# decimal
MyOEIS::compare_values
(anum => 'A080268',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $depth = 1; @got < $count; $depth++) {
my @bits = level_order_bits($path, $depth);
push @got, Math::BigInt->new("0b".join('',@bits));
}
return \@got;
});
# binary
MyOEIS::compare_values
(anum => 'A080269',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $depth = 1; @got < $count; $depth++) {
my @bits = level_order_bits($path, $depth);
push @got, _digit_join_hightolow(\@bits, 10, Math::BigInt->new(0));
}
return \@got;
});
# Return a list of 0,1 bits.
# No-such node = 0.
# Node = 1.
# Nodes descend to left,right breadth-wise in next level.
# Drop very last 0 at end.
#
sub level_order_bits {
my ($path, $limit) = @_;
my @pending_x = (0);
my @pending_y = (0);
my @ret;
foreach (1 .. $limit) {
my @new_x;
my @new_y;
foreach my $i (0 .. $#pending_x) {
my $x = $pending_x[$i];
my $y = $pending_y[$i];
if ($path->xy_is_visited($x,$y)) {
push @ret, 1;
push @new_x, $x-1;
push @new_y, $y+1;
push @new_x, $x+1;
push @new_y, $y+1;
} else {
push @ret, 0;
}
}
@pending_x = @new_x;
@pending_y = @new_y;
}
push @ret, (0) x (scalar(@pending_x)-1);
return @ret;
}
#------------------------------------------------------------------------------
# A106344 - by dX=-3,dY=+1 slopes upwards
# cf A106346 its matrix inverse, or something
#
# 1
# 0, 1
# 0, 1, 1,
# 0, 0, 0, 1,
# 0, 0, 1, 1, 1,
# 0, 0, 0, 1, 0, 1,
# 0, 0, 0, 1, 0, 1, 1,
# 0, 0, 0, 0, 0, 0, 0, 1,
# 0, 0, 0, 0, 1, 0, 1, 1, 1,
# 0, 0, 0, 0, 0, 1, 0, 1, 0, 1,
# 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1,
# 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1,
# 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1,
# 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1
# 19 20 21 22 23 24 25 26
# 15 16 17 18
# 11 12 13 14 .
# 9 10 .
# 5 6 7 8 .
# 3 . 4 .
# 1 2 . .
# 0 . . .
# path(x,y) = binomial(y,(x+y)/2)
# T(n,k)=binomial(k,n-k)
# y=k
# (x+y)/2=n-k
# x+k=2n-2k
# x=2n-3k
MyOEIS::compare_values
(anum => 'A106344',
func => sub {
my ($count) = @_;
# align="left" is dX=1,dY=1 diagonals
my $path = Math::PlanePath::SierpinskiTriangle->new (align => 'left');
my @got;
my $xstart = 0;
my $x = 0;
my $y = 0;
while (@got < $count) {
my $n = $path->xy_to_n($x,$y);
push @got, (defined $n ? 1 : 0);
$x += 1;
$y += 1;
if ($x > 0) {
$xstart--;
$x = $xstart;
$y = 0;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A106344},
func => sub {
my ($count) = @_;
# align="right" is dX=2,dY=1 slopes, chess knight moves
my $path = Math::PlanePath::SierpinskiTriangle->new (align => 'right');
my @got;
my $xstart = 0;
my $x = 0;
my $y = 0;
while (@got < $count) {
my $n = $path->xy_to_n($x,$y);
push @got, (defined $n ? 1 : 0);
$x += 2;
$y += 1;
if ($x > $y) {
$xstart--;
$x = $xstart;
$y = 0;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A106344},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
my $xstart = 0;
my $x = 0;
my $y = 0;
while (@got < $count) {
my $n = $path->xy_to_n($x,$y);
push @got, (defined $n ? 1 : 0);
$x += 3;
$y += 1;
if ($x > $y) {
$xstart -= 2;
$x = $xstart;
$y = 0;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A106344},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
OUTER: for (my $n = 0; ; $n++) {
for (my $k = 0; $k <= $n; $k++) {
my $n = $path->xy_to_n(2*$n-3*$k,$k);
push @got, (defined $n ? 1 : 0);
if (@got >= $count) {
last OUTER;
}
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A106344},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
require Math::BigInt;
OUTER: for (my $n = 0; ; $n++) {
for (my $k = 0; $k <= $n; $k++) {
# my $b = Math::BigInt->new($k);
# $b->bnok($n-$k); # binomial(k,k-n)
# $b->bmod(2);
# push @got, $b;
push @got, binomial_mod2 ($k, $n-$k);
if (@got >= $count) {
last OUTER;
}
}
}
return \@got;
});
# my $b = Math::BigInt->new($k);
# $b->bnok($n-$k); # binomial(k,k-n)
# $b->bmod(2);
sub binomial_mod2 {
my ($n, $k) = @_;
return Math::BigInt->new($n)->bnok($k)->bmod(2)->numify;
}
#------------------------------------------------------------------------------
# A106345 -
# k=0..floor(n/2) of binomial(k, n-2k)
#
# path(x,y) = binomial(y,(x+y)/2)
# T(n,k)=binomial(k,n-2k)
# y=k
# (x+y)/2=n-2k
# x+k=2n-4k
# x=2n-5k
MyOEIS::compare_values
(anum => 'A106345',
max_count => 1000, # touch slow, shorten
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
for (my $xstart = 0; @got < $count; $xstart -= 2) {
my $x = $xstart;
my $y = 0;
my $total = 0;
while ($x <= $y) {
my $n = $path->xy_to_n($x,$y);
if (defined $n) {
$total++;
}
$x += 5;
$y += 1;
}
push @got, $total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A002487 - stern diatomic count along of dX=3,dY=1 slopes
MyOEIS::compare_values
(anum => 'A002487',
max_count => 1000, # touch slow, shorten
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got = (0);
for (my $xstart = 0; @got < $count; $xstart -= 2) {
my $x = $xstart;
my $y = 0;
my $total = 0;
while ($x <= $y) {
my $n = $path->xy_to_n($x,$y);
if (defined $n) {
$total++;
}
$x += 3;
$y += 1;
}
push @got, $total;
}
return \@got;
});
#------------------------------------------------------------------------------
# A001316 - Gould's sequence, number of 1s in each row
MyOEIS::compare_values
(anum => 'A001316',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
my $prev_y = 0;
my $num = 0;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($y == $prev_y) {
$num++;
} else {
push @got, $num;
$prev_y = $y;
$num = 1;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A047999 - 1/0 by rows, without the skipped (x^y)&1==1 points of triangular
# lattice
MyOEIS::compare_values
(anum => 'A047999',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @got;
my $x = 0;
my $y = 0;
foreach my $n (1 .. $count) {
push @got, ($path->xy_is_visited($x,$y) ? 1 : 0);
$x += 2;
if ($x > $y) {
$y++;
$x = -$y;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => q{A047999},
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new (align => "right");
my @got;
my $x = 0;
my $y = 0;
foreach my $n (1 .. $count) {
push @got, ($path->xy_is_visited($x,$y) ? 1 : 0);
$x++;
if ($x > $y) {
$y++;
$x = 0;
}
}
return \@got;
});
#------------------------------------------------------------------------------
# A075438 - 1/0 by rows of "right", including blank 0s in left of pyramid
MyOEIS::compare_values
(anum => 'A075438',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::SierpinskiTriangle->new (align => 'right');
my @got;
my $x = 0;
my $y = 0;
foreach my $n (1 .. $count) {
push @got, ($path->xy_is_visited($x,$y) ? 1 : 0);
$x++;
if ($x > $y) {
$y++;
$x = -$y;
}
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/oeis/R5DragonCurve-oeis.t 0000644 0001750 0001750 00000014176 12563472625 017066 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 12;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::R5DragonCurve;
# uncomment this to run the ### lines
#use Smart::Comments '###';
my $path = Math::PlanePath::R5DragonCurve->new;
#------------------------------------------------------------------------------
# A006495 -- level end X, b^k
MyOEIS::compare_values
(anum => 'A006495',
func => sub {
my ($count) = @_;
my @got;
require Math::BigInt;
for (my $k = Math::BigInt->new(0); @got < $count; $k++) {
my ($n_lo, $n_hi) = $path->level_to_n_range($k);
my ($x,$y) = $path->n_to_xy($n_hi);
push @got, $x;
}
return \@got;
});
# A006496 -- level end Y, b^k
MyOEIS::compare_values
(anum => 'A006496',
func => sub {
my ($count) = @_;
my @got;
require Math::BigInt;
for (my $k = Math::BigInt->new(0); @got < $count; $k++) {
my ($n_lo, $n_hi) = $path->level_to_n_range($k);
my ($x,$y) = $path->n_to_xy($n_hi);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A008776 single-visited points to N=5^k
MyOEIS::compare_values
(anum => 'A008776',
max_value => 10_0,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_n_to_singles ($path, 5**$k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A198859 boundary, one side only, N=0 to 25^k, even levels
foreach my $side ('right', 'left') {
MyOEIS::compare_values
(anum => 'A198859',
max_value => 50_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length($path, 25**$k,
side => $side);
}
return \@got;
});
}
# A198963 boundary, one side only, N=0 to 5*25^k, odd levels
foreach my $side ('right', 'left') {
MyOEIS::compare_values
(anum => 'A198963',
max_value => 50_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length($path, 5*25**$k,
side => $side);
}
return \@got;
});
}
# A048473 right or left side boundary for points N <= 5^k
# which is 1/2 of whole boundary
foreach my $side ('right', 'left') {
MyOEIS::compare_values
(anum => 'A048473',
max_value => 50_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length($path, 5**$k,
side => $side);
}
return \@got;
});
}
#------------------------------------------------------------------------------
# A079004 boundary length for points N <= 5^k
MyOEIS::compare_values
(anum => 'A079004',
max_value => 50_000,
func => sub {
my ($count) = @_;
my @got = (7,10);
for (my $k = 1; @got < $count; $k++) {
push @got, MyOEIS::path_boundary_length($path, 5**$k);
}
return \@got;
});
#------------------------------------------------------------------------------
# A005058 1/2 * enclosed area to N <= 5^k, first differences
# A005059 1/4 * enclosed area to N <= 5^k, first differences
MyOEIS::compare_values
(anum => 'A005059',
max_value => 50_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, (MyOEIS::path_enclosed_area($path, 5**($k+1))
- MyOEIS::path_enclosed_area($path, 5**$k)) / 4;
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A005058',
max_value => 50_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 0; @got < $count; $k++) {
push @got, (MyOEIS::path_enclosed_area($path, 5**($k+1))
- MyOEIS::path_enclosed_area($path, 5**$k)) / 2;
}
return \@got;
});
# A007798 1/2 * enclosed area to N <= 5^k
# A016209 1/4 * enclosed area to N <= 5^k
MyOEIS::compare_values
(anum => 'A007798',
max_value => 100_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 1; @got < $count; $k++) {
push @got, MyOEIS::path_enclosed_area($path, 5**$k) / 2;
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A016209',
max_value => 100_000,
func => sub {
my ($count) = @_;
my @got;
for (my $k = 2; @got < $count; $k++) {
push @got, MyOEIS::path_enclosed_area($path, 5**$k) / 4;
}
return \@got;
});
#------------------------------------------------------------------------------
# A175337 -- turn 0=left,1=right
MyOEIS::compare_values
(anum => 'A175337',
func => sub {
my ($count) = @_;
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'R5DragonCurve',
turn_type => 'Right');
my @got;
while (@got < $count) {
my ($i,$value) = $seq->next;
push @got, $value;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/KochCurve-more.t 0000644 0001750 0001750 00000006415 12136177167 015371 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::DragonCurve;
use Test;
plan tests => 1;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# rect_to_n_range() on various boxes
{
require Math::PlanePath::KochCurve;
my $path = Math::PlanePath::KochCurve->new;
my $n_start = $path->n_start;
my $bad = 0;
my $report = sub {
MyTestHelpers::diag (@_);
$bad++;
};
my $count = 0;
foreach my $y1 (-2 .. 10, 18, 30, 50, 100) {
foreach my $y2 ($y1 .. $y1 + 10) {
foreach my $x1 (-2 .. 10, 18, 30, 50, 100) {
my $min;
my $max;
foreach my $x2 ($x1 .. $x1 + 10) {
$count++;
my @col = map {$path->xy_to_n($x2,$_)} $y1 .. $y2;
@col = grep {defined} @col;
$min = List::Util::min (grep {defined} $min, @col);
$max = List::Util::max (grep {defined} $max, @col);
my $want_min = (defined $min ? $min : 1);
my $want_max = (defined $max ? $max : 0);
### @col
### rect: "$x1,$y1 $x2,$y2 expect N=$want_min..$want_max"
foreach my $x_swap (0, 1) {
my ($x1,$x2) = ($x_swap ? ($x1,$x2) : ($x2,$x1));
foreach my $y_swap (0, 1) {
my ($y1,$y2) = ($y_swap ? ($y1,$y2) : ($y2,$y1));
my ($got_min, $got_max)
= $path->rect_to_n_range ($x1,$y1, $x2,$y2);
defined $got_min
or &$report ("rect_to_n_range() got_min undef");
defined $got_max
or &$report ("rect_to_n_range() got_max undef");
$got_min >= $n_start
or &$report ("rect_to_n_range() got_min=$got_min is before n_start=$n_start");
if (! defined $min || ! defined $max) {
next; # outside
}
unless ($got_min == $want_min) {
&$report ("rect_to_n_range() bad min $x1,$y1 $x2,$y2 got_min=$got_min want_min=$want_min".(defined $min ? '' : '[nomin]')
);
}
unless ($got_max == $want_max) {
&$report ("rect_to_n_range() bad max $x1,$y1 $x2,$y2 got $got_max want $want_max".(defined $max ? '' : '[nomax]'));
}
}
}
}
}
}
}
MyTestHelpers::diag ("total $count rectangles");
ok (! $bad);
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/MyOEIS.pm 0000644 0001750 0001750 00000051267 12611261476 013756 0 ustar gg gg # Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# MyOEIS.pm is shared by several distributions.
#
# MyOEIS.pm is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# MyOEIS.pm is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
package MyOEIS;
use strict;
use Carp 'croak';
use File::Spec;
use List::Util 'sum';
# uncomment this to run the ### lines
# use Smart::Comments;
my $without;
sub import {
shift;
foreach (@_) {
if ($_ eq '-without') {
$without = 1;
} else {
die __PACKAGE__." unknown option $_";
}
}
}
# Return $aref, $i_start, $filename
sub read_values {
my ($anum, %option) = @_;
### read_values() ...
if ($without) {
return;
}
my $i_start;
my $filename;
my $next;
if (my $seq = eval { require Math::NumSeq::OEIS::File;
Math::NumSeq::OEIS::File->new (anum => $anum) }) {
### from seq ...
$next = sub {
my ($i, $value) = $seq->next;
return $value;
};
$filename = $seq->{'filename'};
$i_start = $seq->i_start;
} else {
require Math::OEIS::Stripped;
my @values = Math::OEIS::Stripped->anum_to_values($anum);
if (! @values) {
MyTestHelpers::diag ("$anum not available");
return;
}
### from stripped ...
$next = sub {
return shift @values;
};
$filename = Math::OEIS::Stripped->filename;
}
my $desc = $anum; # has ".scalar(@bvalues)." values";
my @bvalues;
for (;;) {
my $value = &$next();
if (! defined $value) {
$desc .= " has ".scalar(@bvalues)." values";
last;
}
if ((defined $option{'max_count'} && @bvalues >= $option{'max_count'})
|| (defined $option{'max_value'} && $value > $option{'max_value'})) {
$desc .= " shortened to ".scalar(@bvalues)." values";
last;
}
push @bvalues, $value;
}
if (@bvalues) {
$desc .= " to $bvalues[-1]";
}
MyTestHelpers::diag ($desc);
return (\@bvalues, $i_start, $filename);
}
# with Y reckoned increasing downwards
sub dxdy_to_direction {
my ($dx, $dy) = @_;
if ($dx > 0) { return 0; } # east
if ($dx < 0) { return 2; } # west
if ($dy > 0) { return 1; } # south
if ($dy < 0) { return 3; } # north
}
sub compare_values {
my %option = @_;
require MyTestHelpers;
my $anum = $option{'anum'} || croak "Missing anum parameter";
my $func = $option{'func'} || croak "Missing func parameter";
my ($bvalues, $lo, $filename) = MyOEIS::read_values
($anum,
max_count => $option{'max_count'},
max_value => $option{'max_value'});
my $diff;
if ($bvalues) {
if (my $fixup = $option{'fixup'}) {
&$fixup($bvalues);
}
my ($got,@rest) = &$func(scalar(@$bvalues));
if (@rest) {
croak "Oops, func return more than just an arrayref";
}
if (ref $got ne 'ARRAY') {
croak "Oops, func return not an arrayref";
}
$diff = diff_nums($got, $bvalues);
if ($diff) {
MyTestHelpers::diag ("bvalues: ",join_values($bvalues));
MyTestHelpers::diag ("got: ",join_values($got));
}
}
if (defined $Test::TestLevel) {
require Test;
local $Test::TestLevel = $Test::TestLevel + 1;
Test::skip (! $bvalues, $diff, undef, "$anum");
} elsif (defined $diff) {
print "$diff\n";
}
}
sub join_values {
my ($aref) = @_;
if (! @$aref) { return ''; }
my $str = $aref->[0];
foreach my $i (1 .. $#$aref) {
my $value = $aref->[$i];
if (! defined $value) { $value = 'undef'; }
last if length($str)+1+length($value) >= 275;
$str .= ',';
$str .= $value;
}
return $str;
}
sub diff_nums {
my ($gotaref, $wantaref) = @_;
my $diff;
for (my $i = 0; $i < @$gotaref; $i++) {
if ($i > @$wantaref) {
return "want ends prematurely pos=$i";
}
my $got = $gotaref->[$i];
my $want = $wantaref->[$i];
if (! defined $got && ! defined $want) {
next;
}
if (defined $got != defined $want) {
if (defined $diff) {
return "$diff, and more diff";
}
$diff = "different pos=$i got=".(defined $got ? $got : '[undef]')
." want=".(defined $want ? $want : '[undef]');
}
unless ($got =~ /^[0-9.-]+$/) {
if (defined $diff) {
return "$diff, and more diff";
}
$diff = "not a number pos=$i got='$got'";
}
unless ($want =~ /^[0-9.-]+$/) {
if (defined $diff) {
return "$diff, and more diff";
}
$diff = "not a number pos=$i want='$want'";
}
if ($got != $want) {
if (defined $diff) {
return "$diff, and more diff";
}
$diff = "different pos=$i numbers got=$got want=$want";
}
}
return $diff;
}
# counting from 1 for prime=2
sub ith_prime {
my ($i) = @_;
if ($i < 1) {
croak "Oops, ith_prime() i=$i";
}
require Math::Prime::XS;
my $to = 100;
for (;;) {
my @primes = Math::Prime::XS::primes($to);
if (@primes >= $i) {
return $primes[$i-1];
}
$to *= 2;
}
}
#------------------------------------------------------------------------------
sub first_differences {
my $prev = shift;
return map { my $diff = $_-$prev; $prev = $_; $diff } @_;
}
#------------------------------------------------------------------------------
# unit square boundary
{
my %lattice_type_to_dfunc = (square => \&path_n_to_dboundary,
triangular => \&path_n_to_dhexboundary);
sub path_n_to_figure_boundary {
my ($path, $n_end, %options) = @_;
my $boundary = 0;
my $dfunc = $lattice_type_to_dfunc{$options{'lattice_type'} || 'square'};
foreach my $n ($path->n_start .. $n_end) {
# print "$n ",&$dfunc($path, $n),"\n";
$boundary += &$dfunc($path, $n);
}
return $boundary;
}
}
BEGIN {
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
sub path_n_to_dboundary {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy($n) or return 0;
{
my @n_list = $path->xy_to_n_list($x,$y);
if ($n > $n_list[0]) {
return 0;
}
}
my $dboundary = 4;
foreach my $i (0 .. $#dir4_to_dx) {
my $an = $path->xy_to_n($x+$dir4_to_dx[$i], $y+$dir4_to_dy[$i]);
$dboundary -= 2*(defined $an && $an < $n);
}
return $dboundary;
}
sub path_n_to_dsticks {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy($n) or return 0;
my $dsticks = 4;
foreach my $i (0 .. $#dir4_to_dx) {
my $an = $path->xy_to_n($x+$dir4_to_dx[$i], $y+$dir4_to_dy[$i]);
$dsticks -= (defined $an && $an < $n);
}
return $dsticks;
}
}
#------------------------------------------------------------------------------
# Return the area enclosed by the curve N=n_start() to N <= $n_limit.
#
# lattice_type => 'triangular'
# Means take the six-way triangular lattice points as adjacent and
# measure in X/2 and Y*sqrt(3)/2 so that the points are unit steps.
#
sub path_enclosed_area {
my ($path, $n_limit, %options) = @_;
### path_enclosed_area() ...
my $points = path_boundary_points($path, $n_limit, %options);
### $points
if (@$points <= 2) {
return 0;
}
require Math::Geometry::Planar;
my $polygon = Math::Geometry::Planar->new;
$polygon->points($points);
return $polygon->area;
}
{
my %lattice_type_to_divisor = (square => 1,
triangular => 4);
# Return the length of the boundary of the curve N=n_start() to N <= $n_limit.
#
# lattice_type => 'triangular'
# Means take the six-way triangular lattice points as adjacent and
# measure in X/2 and Y*sqrt(3)/2 so that the points are unit steps.
#
sub path_boundary_length {
my ($path, $n_limit, %options) = @_;
### path_boundary_length(): "n_limit=$n_limit"
my $points = path_boundary_points($path, $n_limit, %options);
### $points
my $lattice_type = ($options{'lattice_type'} || 'square');
my $triangular_mult = ($lattice_type eq 'triangular' ? 3 : 1);
my $divisor = ($options{'divisor'} || $lattice_type_to_divisor{$lattice_type});
my $side = ($options{'side'} || 'all');
### $divisor
my $boundary = 0;
foreach my $i (($side eq 'all' ? 0 : 1)
..
$#$points) {
### hypot: ($points->[$i]->[0] - $points->[$i-1]->[0])**2 + $triangular_mult*($points->[$i]->[1] - $points->[$i-1]->[1])**2
$boundary += sqrt((( $points->[$i]->[0] - $points->[$i-1]->[0])**2
+ $triangular_mult
* ($points->[$i]->[1] - $points->[$i-1]->[1])**2)
/ $divisor);
}
### $boundary
return $boundary;
}
}
{
my @dir4_to_dxdy = ([1,0], [0,1], [-1,0], [0,-1]);
my @dir6_to_dxdy = ([2,0], [1,1], [-1,1], [-2,0], [-1,-1], [1,-1]);
my %lattice_type_to_dirtable = (square => \@dir4_to_dxdy,
triangular => \@dir6_to_dxdy);
# Return arrayref of points [ [$x,$y], ..., [$to_x,$to_y]]
# which are the points on the boundary of the curve from $x,$y to
# $to_x,$to_y inclusive.
#
# lattice_type => 'triangular'
# Means take the six-way triangular lattice points as adjacent.
#
sub path_boundary_points_ft {
my ($path, $n_limit, $x,$y, $to_x,$to_y, %options) = @_;
### path_boundary_points_ft(): "$x,$y to $to_x,$to_y"
### $n_limit
# my @dirtable = $path->_UNDOCUMENTED__dxdy_list; # $lattice_type_to_dirtable{$lattice_type};
my $lattice_type = ($options{'lattice_type'} || 'square');
my @dirtable = @{$lattice_type_to_dirtable{$lattice_type}};
my $dirmod = scalar(@dirtable);
my $dirrev = $dirmod / 2 - 1;
### @dirtable
### $dirmod
### $dirrev
my $arms = $path->arms_count;
my @points;
my $dir = $options{'dir'} // 1;
my @n_list;
# FIXME: can be on boundary without having untraversed edge
if (! defined $dir) {
foreach my $i (0 .. $dirmod) {
my ($dx,$dy) = @{$dirtable[$i]};
if (! defined ($path->xyxy_to_n($x,$y, $x+$dx,$y+$dy))) {
$dir = $i;
last;
}
}
if (! defined $dir) {
die "Oops, $x,$y apparently not on boundary";
}
}
TOBOUNDARY: for (;;) {
@n_list = $path->xy_to_n_list($x,$y)
or die "Oops, no n_list at $x,$y";
foreach my $i (1 .. $dirmod) {
my $test_dir = ($dir + $i) % $dirmod;
my ($dx,$dy) = @{$dirtable[$test_dir]};
my @next_n_list = $path->xy_to_n_list($x+$dx,$y+$dy);
if (! any_consecutive(\@n_list, \@next_n_list, $n_limit, $arms)) {
### is boundary: "dxdy = $dx,$dy test_dir=$test_dir"
$dir = ($test_dir + 1) % $dirmod;
last TOBOUNDARY;
}
}
my ($dx,$dy) = @{$dirtable[$dir]};
if ($x == $to_x && $y == $to_y) {
$to_x -= $dx;
$to_y -= $dy;
}
$x -= $dx;
$y -= $dy;
### towards boundary: "$x, $y"
}
### initial: "dir=$dir n_list=".join(',',@n_list)." seeking to_xy=$to_x,$to_y"
for (;;) {
### at: "xy=$x,$y n_list=".join(',',@n_list)
push @points, [$x,$y];
$dir = ($dir - $dirrev) % $dirmod;
my $found = 0;
foreach (1 .. $dirmod) {
my ($dx,$dy) = @{$dirtable[$dir]};
my @next_n_list = $path->xy_to_n_list($x+$dx,$y+$dy);
### consider: "dir=$dir next_n_list=".join(',',@next_n_list)
if (any_consecutive(\@n_list, \@next_n_list, $n_limit, $arms)) {
### yes, consecutive, go: "dir=$dir dx=$dx,dy=$dy"
@n_list = @next_n_list;
$x += $dx;
$y += $dy;
$found = 1;
last;
}
$dir = ($dir+1) % $dirmod;
}
if (! $found) {
die "oops, direction of next boundary step not found";
}
if ($x == $to_x && $y == $to_y) {
### stop at: "$x,$y"
unless ($x == $points[0][0] && $y == $points[0][1]) {
push @points, [$x,$y];
}
last;
}
}
return \@points;
}
}
# Return arrayref of points [ [$x1,$y1], [$x2,$y2], ... ]
# which are the points on the boundary of the curve N=n_start() to N <= $n_limit
# The final point should be taken to return to the initial $x1,$y1.
#
# lattice_type => 'triangular'
# Means take the six-way triangular lattice points as adjacent.
#
sub path_boundary_points {
my ($path, $n_limit, %options) = @_;
### path_boundary_points(): "n_limit=$n_limit"
### %options
my $x = 0;
my $y = 0;
my $to_x = $x;
my $to_y = $y;
if ($options{'side'} && $options{'side'} eq 'right') {
($to_x,$to_y) = $path->n_to_xy($n_limit);
} elsif ($options{'side'} && $options{'side'} eq 'left') {
($x,$y) = $path->n_to_xy($n_limit);
}
return path_boundary_points_ft($path, $n_limit, $x,$y, $to_x,$to_y, %options);
}
# $aref and $bref are arrayrefs of N values.
# Return true if any pair of values $aref->[a], $bref->[b] are consecutive.
# Values in the arrays which are > $n_limit are ignored.
sub any_consecutive {
my ($aref, $bref, $n_limit, $arms) = @_;
foreach my $a (@$aref) {
next if $a > $n_limit;
foreach my $b (@$bref) {
next if $b > $n_limit;
if (abs($a-$b) == $arms) {
return 1;
}
}
}
return 0;
}
# Return the count of single points in the path from N=Nstart to N=$n_end
# inclusive. Anything which happends beyond $n_end does not count, so a
# point which is doubled somewhere beyond $n_end is still reckoned as single.
#
sub path_n_to_singles {
my ($path, $n_end) = @_;
my $ret = 0;
foreach my $n ($path->n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n) or next;
my @n_list = $path->xy_to_n_list($x,$y);
if (@n_list == 1
|| (@n_list == 2
&& $n == $n_list[0]
&& $n_list[1] > $n_end)) {
$ret++;
}
}
return $ret;
}
# Return the count of doubled points in the path from N=Nstart to N=$n_end
# inclusive. Anything which happends beyond $n_end does not count, so a
# point which is doubled somewhere beyond $n_end is not reckoned as doubled
# here.
#
sub path_n_to_doubles {
my ($path, $n_end) = @_;
my $ret = 0;
foreach my $n ($path->n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n) or next;
my @n_list = $path->xy_to_n_list($x,$y);
if (@n_list == 2
&& $n == $n_list[0]
&& $n_list[1] <= $n_end) {
$ret++;
}
}
return $ret;
}
# # Return true if the X,Y point at $n is visited only once.
# sub path_n_is_single {
# my ($path, $n) = @_;
# my ($x,$y) = $path->n_to_xy($n) or return 0;
# my @n_list = $path->xy_to_n_list($x,$y);
# return scalar(@n_list) == 1;
# }
# Return the count of distinct visited points in the path from N=Nstart to
# N=$n_end inclusive.
#
sub path_n_to_visited {
my ($path, $n_end) = @_;
my $ret = 0;
foreach my $n ($path->n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n) or next;
my @n_list = $path->xy_to_n_list($x,$y);
if ($n_list[0] == $n) { # relying on sorted @n_list
$ret++;
}
}
return $ret;
}
#------------------------------------------------------------------------------
sub gf_term {
my ($gf_str, $i) = @_;
my ($num,$den) = ($gf_str =~ m{(.*)/(.*)}) or die $gf_str;
$num = Math::Polynomial->new(poly_parse($num));
$den = Math::Polynomial->new(poly_parse($den));
my $q;
foreach (0 .. $i) {
$q = $num->coeff(0) / $den->coeff(0);
$num -= $q * $den;
$num->coeff(0) == 0 or die;
}
return $q;
}
sub poly_parse {
my ($str) = @_;
### poly_parse(): $str
unless ($str =~ /^\s*[+-]/) {
$str = "+ $str";
}
my @coeffs;
my $end = 0;
### $str
while ($str =~ m{\s*([+-]) # +/- between terms
(\s*(-?\d+))? # coefficient
((\s*\*)? # optional * multiplier
\s*x # variable
\s*(\^\s*(\d+))?)? # optional exponent
\s*
}xg) {
### between: $1
### coeff : $2
### x : $4
$end = pos($str);
last if ! defined $2 && ! defined $4;
my $coeff = (defined $2 ? $2 : 1);
my $power = (defined $7 ? $7
: defined $4 ? 1
: 0);
if ($1 eq '-') { $coeff = -$coeff; }
$coeffs[$power] += $coeff;
### $coeff
### $power
### $end
}
### final coeffs: @coeffs
$end == length($str)
or die "parse $str fail at pos=$end";
foreach (@coeffs) { $_ ||= 0 }
require Math::Polynomial;
return Math::Polynomial->new(@coeffs);
}
#------------------------------------------------------------------------------
# boundary iterator
sub path_make_boundary_iterator {
my ($path, %option) = @_;
my $x = $option{'x'};
my $y = $option{'y'};
if (! defined $x) {
($x,$y) = $path->n_to_xy($path->n_start);
}
my $dir = $option{'dir'};
if (! defined $dir) { $dir = 1; }
my @n_list = $path->xy_to_n_list($x,$y);
# my $dirmod = scalar(@$dirtable);
# my $dirrev = $dirmod / 2 - 1;
# ### $dirmod
# ### $dirrev
#
# my $arms = $path->arms_count;
# my @points;
# my $dir = $options{'dir'} // 1;
return sub {
my $ret_x = $x;
my $ret_y = $y;
return ($ret_x,$ret_y);
};
}
#------------------------------------------------------------------------------
# recurrence guess
# sub guess_recurrence {
# my @values = @_;
#
# require Math::Matrix;
# }
#------------------------------------------------------------------------------
# polynomial partial fractions
#
# $numerator / product(@denominators) is a polynomial fraction.
# Return a list of polynomials p1,p2,... which are numerators of partial
# fractions so
#
# p1 p2 $numerator
# -- + -- + ... = ----------------------
# d1 d2 product(@denominators)
#
sub polynomial_partial_fractions {
my ($numerator, @denominators) = @_;
### denominators: "@denominators"
my $total_degree = sum(map {$_->degree} @denominators);
### $total_degree
### numerator degree: $numerator->degree
if ($numerator->degree >= $total_degree) {
croak "Numerator degree should be less than total denominators";
}
require Math::Matrix;
my $m = math_matrix_new_zero($total_degree);
my @prods;
{
my $r = 0;
foreach my $i (0 .. $#denominators) {
my $degree = $denominators[$i]->degree;
if ($degree < 0) {
croak "Zero denominator";
}
# product of denominators excluding this $denominators[$i]
my $prod = Math::Polynomial->new(1);
foreach my $j (0 .. $#denominators) {
if ($i != $j) {
$prod *= $denominators[$j]
}
}
push @prods, $prod;
my $prod_degree = $prod->degree;
### prod: "$prod"
### $prod_degree
foreach my $c (0 .. $degree-1) {
foreach my $j (0 .. $prod_degree) {
$m->[$r][$c+$j] += $prod->coeff($j);
}
$r++;
}
}
}
### m: "\n$m"
$m = $m->transpose;
### transposed: "\n$m"
### det: $m->determinant
if ($m->determinant == 0) {
die "Oops, matrix not invertible";
}
my $v = Math::Matrix->new(map {[$numerator->coeff($_)]} 0 .. $total_degree-1);
### vector: "\n$v"
$m = $m->concat($v);
### concat: "\n$m"
my $s = $m->solve;
### solve: "\n$s"
my @ret;
{
my $check = Math::Polynomial->new(0);
my $r = 0;
foreach my $i (0 .. $#denominators) {
if ($denominators[$i]->degree < 0) {
croak "Zero denominator";
}
my @coeffs;
foreach my $j (1 .. $denominators[$i]->degree) {
push @coeffs, $s->[$r][0];
$r++;
}
my $ret = Math::Polynomial->new(@coeffs);
push @ret, $ret;
$check += $ret * $prods[$i];
}
unless ($check == $numerator) {
die "Oops, multiply back as check not equal to original numerator, got $check want $numerator\n
numerators: ",join(' ',@ret);
}
}
return @ret;
}
# Return a Math::Matrix which is $rows x $columns of zeros.
# If $columns is omitted then square $rows x $rows.
sub math_matrix_new_zero {
my ($rows, $columns) = @_;
if (! defined $columns) {
$columns = $rows;
}
return Math::Matrix->new(map { [ (0) x $columns ]
} 0 .. $rows-1);
}
# a + b*x + c*x^2 d 2 + 2*x^2
# ---------------- + --- = ---------------------
# 1 - x - 2*x^3 1-x (1 - x - 2*x^3)*(1-x)
#
# (a + b*x + c*x^2)*(1-x) + d*(1 - x - 2*x^3) = 2 + 2*x^2
#
# a - a*x
# b*x - b*x^2
# c*x^2 - c*x^3
# d -d*x -2d*x^3
# = 2 + 2*x^2
# m = [1,0,0,1; -1,1,0,-1; 0,-1,1,0; 0,0,-1,-2]
# v = [2;0;2;0]
# matsolve(m,v)
#
# a = -2 4
# b = 2 2
# c = 4 4
# d = 4 -2
#
# (-2 + 2*x + 4*x^2)/(1 - x - 2*x^3) + 4 /(1-x) == (2 + 2*x^2)/(1 - x - 2*x^3)*(1-x)
1;
__END__
Math-PlanePath-122/xt/0-examples-xrefs.t 0000644 0001750 0001750 00000004300 12230011245 015602 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2013 Kevin Ryde
# 0-examples-xrefs.t is shared by several distributions.
#
# 0-examples-xrefs.t is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# 0-examples-xrefs.t is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
BEGIN { require 5 }
use strict;
use ExtUtils::Manifest;
use Test::More;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
my $manifest = ExtUtils::Manifest::maniread();
my @example_files = grep m{examples/.*\.pl$}, keys %$manifest;
my @lib_files = grep m{lib/.*\.(pm|pod)$}, keys %$manifest;
sub any_file_contains_example {
my ($example) = @_;
my $filename;
foreach $filename (@lib_files) {
if (pod_contains_example($filename, $example)) {
return 1;
}
}
foreach $filename (@example_files) {
if ($filename ne $example
&& raw_contains_example($filename, $example)) {
return 1;
}
}
return 0;
}
sub pod_contains_example {
my ($filename, $example) = @_;
open FH, "< $filename" or die "Cannot open $filename: $!";
my $content = do { local $/; }; # slurp
close FH or die "Error closing $filename: $!";
return scalar ($content =~ /F<\Q$example\E>
|F\s+directory
/xs);
}
sub raw_contains_example {
my ($filename, $example) = @_;
$example =~ s{^examples/}{};
open FH, "< $filename" or die "Cannot open $filename: $!";
my $ret = scalar (grep /\b\Q$example\E\b/, );
close FH or die "Error closing $filename: $!";
return $ret > 0;
}
plan tests => scalar(@example_files) + 1;
my $example;
foreach $example (@example_files) {
is (any_file_contains_example($example), 1,
"$example mentioned in some lib/ file");
}
ok(1);
exit 0;
Math-PlanePath-122/xt/PlanePath-subclasses.t 0000644 0001750 0001750 00000324131 12606435140 016545 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Exercise the various PlanePath subclasses checking for consistency between
# n_to_xy() and xy_to_n() and the various range methods, etc.
#
use 5.004;
use strict;
use List::Util;
use Test;
plan tests => 5;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# uncomment this to run the ### lines
# use Smart::Comments;
use Math::PlanePath;
use Math::PlanePath::Base::Generic
'is_infinite';
use Math::PlanePath::Base::Digits
'round_down_pow';
my $verbose = 1;
my @modules = (
# modules marked "*" are from Math-PlanePath-Toothpick or
# elsewhere and are skipped if not available to test
# module list begin
'GrayCode',
'GrayCode,radix=3',
'GrayCode,radix=4',
'GrayCode,radix=5',
'GrayCode,radix=6',
'GrayCode,radix=37',
'GrayCode,apply_type=FsT',
'GrayCode,apply_type=FsT,radix=10',
'GrayCode,apply_type=Fs',
'GrayCode,apply_type=Fs,radix=10',
'GrayCode,apply_type=Ts',
'GrayCode,apply_type=Ts,radix=10',
'GrayCode,apply_type=sF',
'GrayCode,apply_type=sF,radix=10',
'GrayCode,apply_type=sT',
'GrayCode,apply_type=sT,radix=10',
'GrayCode,radix=4,gray_type=modular',
'CfracDigits,radix=1',
'CfracDigits',
'CfracDigits,radix=3',
'CfracDigits,radix=4',
'CfracDigits,radix=10',
'CfracDigits,radix=37',
'DigitGroups',
'DigitGroups,radix=3',
'DigitGroups,radix=4',
'DigitGroups,radix=5',
'DigitGroups,radix=37',
'ChanTree',
'ChanTree,n_start=1234',
'ChanTree,k=2',
'ChanTree,k=2,n_start=1234',
'ChanTree,k=3',
'ChanTree,k=4',
'ChanTree,k=5',
'ChanTree,k=6',
'ChanTree,k=7',
'ChanTree,k=8',
'ChanTree,reduced=1',
'ChanTree,reduced=1,k=2',
'ChanTree,reduced=1,k=3',
'ChanTree,reduced=1,k=4',
'ChanTree,reduced=1,k=5',
'ChanTree,reduced=1,k=6',
'ChanTree,reduced=1,k=7',
'ChanTree,reduced=1,k=8',
'ImaginaryHalf',
'ImaginaryHalf,radix=3',
'ImaginaryHalf,radix=4',
'ImaginaryHalf,radix=5',
'ImaginaryHalf,radix=37',
'ImaginaryHalf,digit_order=XXY,radix=3',
'ImaginaryHalf,digit_order=YXX,radix=3',
'ImaginaryHalf,digit_order=XnXY,radix=3',
'ImaginaryHalf,digit_order=XnYX,radix=3',
'ImaginaryHalf,digit_order=YXnX,radix=3',
'ImaginaryHalf,digit_order=XXY,radix=3',
'MultipleRings,ring_shape=polygon,step=3',
'MultipleRings,ring_shape=polygon,step=4',
'MultipleRings,ring_shape=polygon,step=5',
'MultipleRings,ring_shape=polygon,step=6',
'MultipleRings,ring_shape=polygon,step=7',
'MultipleRings,ring_shape=polygon,step=8',
'MultipleRings,ring_shape=polygon,step=9',
'MultipleRings,ring_shape=polygon,step=12',
'MultipleRings,ring_shape=polygon,step=37',
'MultipleRings',
'MultipleRings,step=0',
'MultipleRings,step=1',
'MultipleRings,step=2',
'MultipleRings,step=3',
'MultipleRings,step=4',
'MultipleRings,step=5',
'MultipleRings,step=6',
'MultipleRings,step=7',
'MultipleRings,step=8',
'MultipleRings,step=37',
'FilledRings',
'FilledRings,n_start=0',
'FilledRings,n_start=37',
'Corner,n_start=101',
'Corner,wider=1,n_start=101',
'Corner,wider=2,n_start=37',
'Corner,wider=13,n_start=37',
'Corner',
'Corner,wider=1',
'Corner,wider=2',
'Corner,wider=37',
'Corner,n_start=0',
'Corner,wider=1,n_start=0',
'Corner,wider=2,n_start=0',
'Corner,wider=37,n_start=0',
'HexSpiral',
'HexSpiral,n_start=0',
'HexSpiral,n_start=37',
'HexSpiral,wider=10,n_start=37',
'HexSpiral,wider=1',
'HexSpiral,wider=2',
'HexSpiral,wider=3',
'HexSpiral,wider=4',
'HexSpiral,wider=5',
'HexSpiral,wider=37',
'HexSpiralSkewed',
'HexSpiralSkewed,n_start=0',
'HexSpiralSkewed,n_start=37',
'HexSpiralSkewed,wider=10,n_start=37',
'HexSpiralSkewed,wider=1',
'HexSpiralSkewed,wider=2',
'HexSpiralSkewed,wider=3',
'HexSpiralSkewed,wider=4',
'HexSpiralSkewed,wider=5',
'HexSpiralSkewed,wider=37',
'Columns',
'Columns,height=1',
'Columns,height=2',
'Columns,n_start=0',
'Columns,height=37,n_start=0',
'Columns,height=37,n_start=123',
'Rows',
'Rows,width=1',
'Rows,width=2',
'Rows,n_start=0',
'Rows,width=37,n_start=0',
'Rows,width=37,n_start=123',
'PeanoCurve',
'PeanoCurve,radix=2',
'PeanoCurve,radix=4',
'PeanoCurve,radix=5',
'PeanoCurve,radix=17',
'PixelRings',
'ImaginaryBase',
'ImaginaryBase,radix=3',
'ImaginaryBase,radix=4',
'ImaginaryBase,radix=5',
'ImaginaryBase,radix=37',
'TriangularHypot',
'TriangularHypot,n_start=0',
'TriangularHypot,n_start=37',
'TriangularHypot,points=odd',
'TriangularHypot,points=all',
'TriangularHypot,points=hex',
'TriangularHypot,points=hex_rotated',
'TriangularHypot,points=hex_centred',
'GreekKeySpiral,turns=0,n_start=100',
'GreekKeySpiral,turns=1,n_start=100',
'GreekKeySpiral,turns=2,n_start=100',
'GreekKeySpiral,turns=3,n_start=100',
'GreekKeySpiral,turns=4,n_start=100',
'GreekKeySpiral,turns=5,n_start=100',
'GreekKeySpiral,turns=6,n_start=100',
'GreekKeySpiral,turns=7,n_start=100',
'GreekKeySpiral,turns=8,n_start=100',
'GreekKeySpiral,turns=9,n_start=100',
'GreekKeySpiral,turns=10,n_start=100',
'GreekKeySpiral,turns=11,n_start=100',
'GreekKeySpiral,turns=37,n_start=100',
'SquareSpiral,n_start=0',
'SquareSpiral,n_start=37',
'SquareSpiral,wider=5,n_start=0',
'SquareSpiral,wider=5,n_start=37',
'SquareSpiral,wider=6,n_start=0',
'SquareSpiral,wider=6,n_start=37',
'SquareSpiral',
'SquareSpiral,wider=1',
'SquareSpiral,wider=2',
'SquareSpiral,wider=3',
'SquareSpiral,wider=4',
'SquareSpiral,wider=5',
'SquareSpiral,wider=6',
'SquareSpiral,wider=37',
'TerdragonMidpoint',
'TerdragonMidpoint,arms=2',
'TerdragonMidpoint,arms=3',
'TerdragonMidpoint,arms=4',
'TerdragonMidpoint,arms=5',
'TerdragonMidpoint,arms=6',
'AnvilSpiral,n_start=0',
'AnvilSpiral,n_start=37',
'AnvilSpiral,n_start=37,wider=9',
'AnvilSpiral',
'AnvilSpiral,wider=1',
'AnvilSpiral,wider=2',
'AnvilSpiral,wider=9',
'AnvilSpiral,wider=17',
'UlamWarburton',
'UlamWarburton,parts=1',
'UlamWarburton,parts=2',
'UlamWarburton,parts=octant',
'UlamWarburton,parts=octant_up',
'UlamWarburton,n_start=0',
'UlamWarburton,n_start=0,parts=2',
'UlamWarburton,n_start=0,parts=1',
'UlamWarburton,n_start=37',
'UlamWarburton,n_start=37,parts=2',
'UlamWarburton,n_start=37,parts=1',
'UlamWarburtonQuarter,parts=octant',
'UlamWarburtonQuarter,parts=octant,n_start=37',
'UlamWarburtonQuarter,parts=octant_up',
'UlamWarburtonQuarter,parts=octant_up,n_start=37',
'UlamWarburtonQuarter',
'UlamWarburtonQuarter,n_start=0',
'UlamWarburtonQuarter,n_start=37',
'*LCornerTree', # parts=4
'*LCornerTree,parts=1',
'*LCornerTree,parts=2',
'*LCornerTree,parts=3',
'*LCornerTree,parts=octant_up+1',
'*LCornerTree,parts=octant+1',
'*LCornerTree,parts=wedge+1',
'*LCornerTree,parts=diagonal-1',
'*LCornerTree,parts=diagonal',
'*LCornerTree,parts=wedge',
'*LCornerTree,parts=octant_up',
'*LCornerTree,parts=octant',
'*OneOfEight',
'*OneOfEight,parts=1',
'*OneOfEight,parts=octant',
'*OneOfEight,parts=octant_up',
'*OneOfEight,parts=wedge',
'*OneOfEight,parts=3side',
# '*OneOfEight,parts=side',
'*OneOfEight,parts=3mid',
'QuintetCentres',
'QuintetCentres,arms=2',
'QuintetCentres,arms=3',
'QuintetCentres,arms=4',
'QuintetReplicate',
'QuintetCurve',
'QuintetCurve,arms=2',
'QuintetCurve,arms=3',
'QuintetCurve,arms=4',
'PythagoreanTree',
'PythagoreanTree,coordinates=AC',
'PythagoreanTree,coordinates=BC',
'PythagoreanTree,coordinates=PQ',
'PythagoreanTree,coordinates=SM',
'PythagoreanTree,coordinates=SC',
'PythagoreanTree,coordinates=MC',
'PythagoreanTree,tree_type=FB',
'PythagoreanTree,tree_type=FB,coordinates=AC',
'PythagoreanTree,tree_type=FB,coordinates=BC',
'PythagoreanTree,tree_type=FB,coordinates=PQ',
'PythagoreanTree,tree_type=FB,coordinates=SM',
'PythagoreanTree,tree_type=FB,coordinates=SC',
'PythagoreanTree,tree_type=FB,coordinates=MC',
'PythagoreanTree,tree_type=UMT',
'PythagoreanTree,tree_type=UMT,coordinates=AC',
'PythagoreanTree,tree_type=UMT,coordinates=BC',
'PythagoreanTree,tree_type=UMT,coordinates=PQ',
'PythagoreanTree,tree_type=UMT,coordinates=SM',
'PythagoreanTree,tree_type=UMT,coordinates=SC',
'PythagoreanTree,tree_type=UMT,coordinates=MC',
'SierpinskiArrowhead',
'SierpinskiArrowhead,align=right',
'SierpinskiArrowhead,align=left',
'SierpinskiArrowhead,align=diagonal',
'SierpinskiArrowheadCentres',
'SierpinskiArrowheadCentres,align=right',
'SierpinskiArrowheadCentres,align=left',
'SierpinskiArrowheadCentres,align=diagonal',
'SierpinskiTriangle',
'SierpinskiTriangle,n_start=37',
'SierpinskiTriangle,align=left',
'SierpinskiTriangle,align=right',
'SierpinskiTriangle,align=diagonal',
'HilbertSides',
'HilbertCurve',
'HilbertSpiral',
'*ToothpickTree',
'*ToothpickTree,parts=1',
'*ToothpickTree,parts=2',
'*ToothpickTree,parts=3',
'*ToothpickTree,parts=wedge',
'*ToothpickTree,parts=two_horiz',
'*ToothpickTree,parts=octant',
'*ToothpickTree,parts=octant_up',
'*ToothpickReplicate',
'*ToothpickReplicate,parts=1',
'*ToothpickReplicate,parts=2',
'*ToothpickReplicate,parts=3',
'*HTree',
'*LCornerReplicate',
'*ToothpickUpist',
'SierpinskiCurveStair',
'SierpinskiCurveStair,diagonal_length=2',
'SierpinskiCurveStair,diagonal_length=3',
'SierpinskiCurveStair,diagonal_length=4',
'SierpinskiCurveStair,arms=2',
'SierpinskiCurveStair,arms=3,diagonal_length=2',
'SierpinskiCurveStair,arms=4',
'SierpinskiCurveStair,arms=5',
'SierpinskiCurveStair,arms=6,diagonal_length=5',
'SierpinskiCurveStair,arms=7',
'SierpinskiCurveStair,arms=8',
'HIndexing',
'KochSquareflakes',
'KochSquareflakes,inward=>1',
'KochCurve',
'KochPeaks',
'KochSnowflakes',
'CCurve',
'SierpinskiCurve',
'SierpinskiCurve,arms=2',
'SierpinskiCurve,arms=3',
'SierpinskiCurve,arms=4',
'SierpinskiCurve,arms=5',
'SierpinskiCurve,arms=6',
'SierpinskiCurve,arms=7',
'SierpinskiCurve,arms=8',
'SierpinskiCurve,diagonal_spacing=5',
'SierpinskiCurve,straight_spacing=5',
'SierpinskiCurve,diagonal_spacing=3,straight_spacing=7',
'SierpinskiCurve,diagonal_spacing=3,straight_spacing=7,arms=7',
'R5DragonMidpoint',
'R5DragonMidpoint,arms=2',
'R5DragonMidpoint,arms=3',
'R5DragonMidpoint,arms=4',
'R5DragonCurve',
'R5DragonCurve,arms=2',
'R5DragonCurve,arms=3',
'R5DragonCurve,arms=4',
'QuadricCurve',
'QuadricIslands',
'LTiling',
'LTiling,L_fill=ends',
'LTiling,L_fill=all',
'FibonacciWordFractal',
'ComplexRevolving',
'ComplexPlus',
'ComplexPlus,realpart=2',
'ComplexPlus,realpart=3',
'ComplexPlus,realpart=4',
'ComplexPlus,realpart=5',
'ComplexMinus',
'ComplexMinus,realpart=2',
'ComplexMinus,realpart=3',
'ComplexMinus,realpart=4',
'ComplexMinus,realpart=5',
'GosperReplicate',
'GosperSide',
'SquareReplicate',
'DekkingCurve',
'DekkingCurve,arms=2',
'DekkingCurve,arms=3',
'DekkingCurve,arms=4',
'DekkingCentres',
'DragonMidpoint',
'DragonMidpoint,arms=2',
'DragonMidpoint,arms=3',
'DragonMidpoint,arms=4',
'DragonRounded',
'DragonRounded,arms=2',
'DragonRounded,arms=3',
'DragonRounded,arms=4',
'TerdragonCurve',
'TerdragonCurve,arms=2',
'TerdragonCurve,arms=3',
'TerdragonCurve,arms=4',
'TerdragonCurve,arms=5',
'TerdragonCurve,arms=6',
'TerdragonRounded',
'TerdragonRounded,arms=2',
'TerdragonRounded,arms=3',
'TerdragonRounded,arms=4',
'TerdragonRounded,arms=5',
'TerdragonRounded,arms=6',
'DragonCurve',
'DragonCurve,arms=2',
'DragonCurve,arms=3',
'DragonCurve,arms=4',
'ZOrderCurve',
'ZOrderCurve,radix=3',
'ZOrderCurve,radix=5',
'ZOrderCurve,radix=9',
'ZOrderCurve,radix=37',
'Flowsnake',
'Flowsnake,arms=2',
'Flowsnake,arms=3',
'FlowsnakeCentres',
'FlowsnakeCentres,arms=2',
'FlowsnakeCentres,arms=3',
'AlternatePaper',
'AlternatePaper,arms=2',
'AlternatePaper,arms=3',
'AlternatePaper,arms=4',
'AlternatePaper,arms=5',
'AlternatePaper,arms=6',
'AlternatePaper,arms=7',
'AlternatePaper,arms=8',
'CellularRule,rule=18', # Sierpinski
'CellularRule,rule=18,n_start=0',
'CellularRule,rule=18,n_start=37',
'CubicBase',
'CubicBase,radix=3',
'CubicBase,radix=4',
'CubicBase,radix=37',
'GosperIslands',
'PowerArray',
'PowerArray,radix=3',
'PowerArray,radix=4',
'WythoffPreliminaryTriangle',
'WythoffArray',
'WythoffArray,x_start=1',
'WythoffArray,y_start=1',
'WythoffArray,x_start=1,y_start=1',
'WythoffArray,x_start=5,y_start=7',
'DiagonalsAlternating',
'DiagonalsAlternating,n_start=0',
'DiagonalsAlternating,n_start=37',
'DiagonalsAlternating,x_start=5',
'DiagonalsAlternating,x_start=2,y_start=5',
# Math::PlanePath::CellularRule::Line
'CellularRule,rule=2', # left line
'CellularRule,rule=2,n_start=0',
'CellularRule,rule=2,n_start=37',
'CellularRule,rule=4', # centre line
'CellularRule,rule=4,n_start=0',
'CellularRule,rule=4,n_start=37',
'CellularRule,rule=16', # right line
'CellularRule,rule=16,n_start=0',
'CellularRule,rule=16,n_start=37',
'CellularRule,rule=6', # left 1,2 line
'CellularRule,rule=6,n_start=0',
'CellularRule,rule=6,n_start=37',
'CellularRule,rule=20', # right 1,2 line
'CellularRule,rule=20,n_start=0',
'CellularRule,rule=20,n_start=37',
# Math::PlanePath::CellularRule::Two
'CellularRule,rule=14', # left 2 cell line
'CellularRule,rule=14,n_start=0',
'CellularRule,rule=14,n_start=37',
'CellularRule,rule=84', # right 2 cell line
'CellularRule,rule=84,n_start=0',
'CellularRule,rule=84,n_start=37',
'CellularRule',
'CellularRule,n_start=0',
'CellularRule,n_start=37',
'CellularRule,rule=206', # left solid
'CellularRule,rule=206,n_start=0',
'CellularRule,rule=206,n_start=37',
'CellularRule,rule=0', # blank
'CellularRule,rule=60',
'CellularRule,rule=220', # right half solid
'CellularRule,rule=222', # full solid
'CretanLabyrinth',
'MPeaks',
'MPeaks,n_start=0',
'MPeaks,n_start=37',
'*ToothpickSpiral',
'*ToothpickSpiral,n_start=0',
'*ToothpickSpiral,n_start=37',
'WunderlichSerpentine',
'WunderlichSerpentine,serpentine_type=100_000_00000',
'WunderlichSerpentine,serpentine_type=110_000_00000',
'WunderlichSerpentine,serpentine_type=111_000_00000',
'WunderlichSerpentine,serpentine_type=10000_00000_00000,radix=5',
'WunderlichSerpentine,serpentine_type=11000_00000_00000,radix=5',
'WunderlichSerpentine,serpentine_type=11100_00000_00000,radix=5',
'WunderlichSerpentine,serpentine_type=11110_00000_00000,radix=5',
'WunderlichSerpentine,serpentine_type=11111_00000_00000,radix=5',
'WunderlichSerpentine,serpentine_type=11111_10000_00000,radix=5',
'WunderlichSerpentine,serpentine_type=11111_11000_00000,radix=5',
'WunderlichSerpentine,serpentine_type=000_000_001',
'WunderlichSerpentine,serpentine_type=010_000_001',
'WunderlichSerpentine,serpentine_type=001_000_001',
'WunderlichSerpentine,serpentine_type=000_100_001',
'WunderlichSerpentine,serpentine_type=000_000_001,radix=5',
'WunderlichSerpentine,serpentine_type=010_000_001,radix=5',
'WunderlichSerpentine,serpentine_type=001_000_001,radix=5',
'WunderlichSerpentine,serpentine_type=000_100_001,radix=5',
'WunderlichSerpentine,radix=2',
'WunderlichSerpentine,radix=4',
'WunderlichSerpentine,radix=5,serpentine_type=coil', # 111..111
'VogelFloret',
'ArchimedeanChords',
'TheodorusSpiral',
'SacksSpiral',
'Hypot,n_start=37',
'Hypot,points=even,n_start=37',
'Hypot',
'Hypot,points=even',
'Hypot,points=odd',
'HypotOctant',
'HypotOctant,points=even',
'HypotOctant,points=odd',
'PyramidRows,align=right',
'PyramidRows,align=right,step=0',
'PyramidRows,align=right,step=1',
'PyramidRows,align=right,step=3',
'PyramidRows,align=right,step=4',
'PyramidRows,align=right,step=5',
'PyramidRows,align=right,step=37',
'PyramidRows,align=left',
'PyramidRows,align=left,step=0',
'PyramidRows,align=left,step=1',
'PyramidRows,align=left,step=3',
'PyramidRows,align=left,step=4',
'PyramidRows,align=left,step=5',
'PyramidRows,align=left,step=37',
'PyramidRows',
'PyramidRows,step=0',
'PyramidRows,step=1',
'PyramidRows,step=3',
'PyramidRows,step=4',
'PyramidRows,step=5',
'PyramidRows,step=37',
'PyramidRows,step=0,n_start=37',
'PyramidRows,step=1,n_start=37',
'PyramidRows,step=2,n_start=37',
'PyramidRows,align=right,step=5,n_start=37',
'PyramidRows,align=left,step=3,n_start=37',
'TriangleSpiralSkewed',
'TriangleSpiralSkewed,n_start=0',
'TriangleSpiralSkewed,n_start=37',
'TriangleSpiralSkewed,skew=right',
'TriangleSpiralSkewed,skew=right,n_start=0',
'TriangleSpiralSkewed,skew=right,n_start=37',
'TriangleSpiralSkewed,skew=up',
'TriangleSpiralSkewed,skew=up,n_start=0',
'TriangleSpiralSkewed,skew=up,n_start=37',
'TriangleSpiralSkewed,skew=down',
'TriangleSpiralSkewed,skew=down,n_start=0',
'TriangleSpiralSkewed,skew=down,n_start=37',
'TriangleSpiral',
'TriangleSpiral,n_start=0',
'TriangleSpiral,n_start=37',
'KnightSpiral',
'KnightSpiral,n_start=0',
'KnightSpiral,n_start=37',
'AlternatePaperMidpoint',
'AlternatePaperMidpoint,arms=2',
'AlternatePaperMidpoint,arms=3',
'AlternatePaperMidpoint,arms=4',
'AlternatePaperMidpoint,arms=5',
'AlternatePaperMidpoint,arms=6',
'AlternatePaperMidpoint,arms=7',
'AlternatePaperMidpoint,arms=8',
'PentSpiral',
'PentSpiral,n_start=0',
'PentSpiral,n_start=37',
'PentSpiralSkewed',
'PentSpiralSkewed,n_start=0',
'PentSpiralSkewed,n_start=37',
'CellularRule54',
'CellularRule54,n_start=0',
'CellularRule54,n_start=37',
'CellularRule57',
'CellularRule57,n_start=0',
'CellularRule57,n_start=37',
'CellularRule57,mirror=1',
'CellularRule57,mirror=1,n_start=0',
'CellularRule57,mirror=1,n_start=37',
'CellularRule190',
'CellularRule190,n_start=0',
'CellularRule190,n_start=37',
'CellularRule190,mirror=1',
'CellularRule190,mirror=1,n_start=0',
'CellularRule190,mirror=1,n_start=37',
'DivisibleColumns',
'DivisibleColumns,n_start=37',
'DivisibleColumns,divisor_type=proper',
'CoprimeColumns',
'CoprimeColumns,n_start=37',
'DiamondArms',
'SquareArms',
'HexArms',
'AR2W2Curve',
'AR2W2Curve,start_shape=D2',
'AR2W2Curve,start_shape=B2',
'AR2W2Curve,start_shape=B1rev',
'AR2W2Curve,start_shape=D1rev',
'AR2W2Curve,start_shape=A2rev',
'BetaOmega',
'KochelCurve',
'CincoCurve',
'WunderlichMeander',
'AztecDiamondRings',
'AztecDiamondRings,n_start=0',
'AztecDiamondRings,n_start=37',
'FactorRationals,sign_encoding=revbinary',
'FactorRationals',
'FactorRationals,sign_encoding=odd/even',
'FactorRationals,sign_encoding=negabinary',
'FactorRationals,sign_encoding=spread',
'PyramidSides',
'PyramidSides,n_start=0',
'PyramidSides,n_start=37',
'Diagonals',
'Diagonals,direction=up',
'Diagonals,n_start=0',
'Diagonals,direction=up,n_start=0',
'Diagonals,n_start=37',
'Diagonals,direction=up,n_start=37',
'Diagonals,x_start=5',
'Diagonals,direction=up,x_start=5',
'Diagonals,x_start=2,y_start=5',
'Diagonals,direction=up,x_start=2,y_start=5',
'PyramidSpiral',
'PyramidSpiral,n_start=0',
'PyramidSpiral,n_start=37',
'HeptSpiralSkewed',
'HeptSpiralSkewed,n_start=0',
'HeptSpiralSkewed,n_start=37',
'Staircase',
'Staircase,n_start=0',
'Staircase,n_start=37',
'StaircaseAlternating',
'StaircaseAlternating,n_start=0',
'StaircaseAlternating,n_start=37',
'StaircaseAlternating,end_type=square',
'StaircaseAlternating,end_type=square,n_start=0',
'StaircaseAlternating,end_type=square,n_start=37',
'OctagramSpiral',
'OctagramSpiral,n_start=0',
'OctagramSpiral,n_start=37',
'CornerReplicate',
'RationalsTree',
'RationalsTree,tree_type=CW',
'RationalsTree,tree_type=AYT',
'RationalsTree,tree_type=Bird',
'RationalsTree,tree_type=Drib',
'RationalsTree,tree_type=L',
'RationalsTree,tree_type=HCS',
# '*PeninsulaBridge',
'DiagonalRationals',
'DiagonalRationals,n_start=37',
'DiagonalRationals,direction=up',
'DiagonalRationals,direction=up,n_start=37',
'GcdRationals',
'GcdRationals,pairs_order=rows_reverse',
'GcdRationals,pairs_order=diagonals_down',
'GcdRationals,pairs_order=diagonals_up',
'DiamondSpiral',
'DiamondSpiral,n_start=0',
'DiamondSpiral,n_start=37',
'FractionsTree',
'DiagonalsOctant',
'DiagonalsOctant,direction=up',
'DiagonalsOctant,n_start=0',
'DiagonalsOctant,direction=up,n_start=0',
'DiagonalsOctant,n_start=37',
'DiagonalsOctant,direction=up,n_start=37',
'File',
# module list end
# cellular 0 to 255
(map {("CellularRule,rule=$_",
"CellularRule,rule=$_,n_start=0",
"CellularRule,rule=$_,n_start=37")} 0..255),
);
@modules = grep { module_exists($_) } @modules;
sub module_exists {
my ($module) = @_;
if ($module =~ /^\*([^,]+)/) {
require Module::Util;
my $filename = Module::Util::find_installed("Math::PlanePath::$1");
if ($filename) {
return 1;
} else {
MyTestHelpers::diag ("skip optional $module");
return 0;
}
} else {
return 1; # not optional
}
}
foreach (@modules) { s/^\*// }
my @classes = map {(module_parse($_))[0]} @modules;
{ my %seen; @classes = grep {!$seen{$_}++} @classes } # uniq
sub module_parse {
my ($mod) = @_;
my ($class, @parameters) = split /,/, $mod;
return ("Math::PlanePath::$class",
map {/(.*?)=(.*)/ or die; ($1 => $2)} @parameters);
}
sub module_to_pathobj {
my ($mod) = @_;
my ($class, @parameters) = module_parse($mod);
### $mod
### @parameters
eval "require $class" or die;
return $class->new (@parameters);
}
{
eval {
require Module::Util;
my %classes = map {$_=>1} @classes;
foreach my $module (Module::Util::find_in_namespace('Math::PlanePath')) {
next if $classes{$module}; # listed, good
next if $module =~ /^Math::PlanePath::[^:]+::/; # skip Base etc submods
MyTestHelpers::diag ("other module ",$module);
}
};
}
BEGIN {
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
# return the change in figure boundary from N to N+1
sub path_n_to_dboundary {
my ($path, $n) = @_;
$n += 1;
my ($x,$y) = $path->n_to_xy($n) or do {
if ($n == $path->n_start - 1) {
return 4;
} else {
return undef;
}
};
### N+1 at: "n=$n xy=$x,$y"
my $dboundary = 4;
foreach my $i (0 .. $#dir4_to_dx) {
my $an = $path->xy_to_n($x+$dir4_to_dx[$i], $y+$dir4_to_dy[$i]);
### consider: "xy=".($x+$dir4_to_dx[$i]).",".($y+$dir4_to_dy[$i])." is an=".($an||'false')
$dboundary -= 2*(defined $an && $an < $n);
}
### $dboundary
return $dboundary;
}
}
#------------------------------------------------------------------------------
# VERSION
my $want_version = 122;
ok ($Math::PlanePath::VERSION, $want_version, 'VERSION variable');
ok (Math::PlanePath->VERSION, $want_version, 'VERSION class method');
ok (eval { Math::PlanePath->VERSION($want_version); 1 },
1,
"VERSION class check $want_version");
my $check_version = $want_version + 1000;
ok (! eval { Math::PlanePath->VERSION($check_version); 1 },
1,
"VERSION class check $check_version");
#------------------------------------------------------------------------------
# new and VERSION
# foreach my $class (@classes) {
# eval "require $class" or die;
#
# ok (eval { $class->VERSION($want_version); 1 },
# 1,
# "VERSION class check $want_version in $class");
# ok (! eval { $class->VERSION($check_version); 1 },
# 1,
# "VERSION class check $check_version in $class");
#
# my $path = $class->new;
# ok ($path->VERSION, $want_version,
# "VERSION object method in $class");
#
# ok (eval { $path->VERSION($want_version); 1 },
# 1,
# "VERSION object check $want_version in $class");
# ok (! eval { $path->VERSION($check_version); 1 },
# 1,
# "VERSION object check $check_version in $class");
# }
#------------------------------------------------------------------------------
# x_negative, y_negative
foreach my $mod (@modules) {
my $path = module_to_pathobj($mod);
$path->x_negative;
$path->y_negative;
$path->n_start;
# ok (1,1, 'x_negative(),y_negative(),n_start() methods run');
}
#------------------------------------------------------------------------------
# n_to_xy, xy_to_n
my %xy_maximum_duplication =
('Math::PlanePath::HilbertSides' => 2,
'Math::PlanePath::DragonCurve' => 2,
'Math::PlanePath::R5DragonCurve' => 2,
'Math::PlanePath::CCurve' => 9999,
'Math::PlanePath::AlternatePaper' => 2,
'Math::PlanePath::TerdragonCurve' => 3,
'Math::PlanePath::KochSnowflakes' => 2,
'Math::PlanePath::QuadricIslands' => 2,
);
my %xy_maximum_duplication_at_origin =
('Math::PlanePath::DragonCurve' => 4,
'Math::PlanePath::TerdragonCurve' => 6,
'Math::PlanePath::R5DragonCurve' => 4,
);
# modules for which rect_to_n_range() is exact
my %rect_exact = (
# rect_to_n_range exact begin
'Math::PlanePath::ImaginaryBase' => 1,
'Math::PlanePath::CincoCurve' => 1,
'Math::PlanePath::DiagonalsAlternating' => 1,
'Math::PlanePath::CornerReplicate' => 1,
'Math::PlanePath::Rows' => 1,
'Math::PlanePath::Columns' => 1,
'Math::PlanePath::Diagonals' => 1,
'Math::PlanePath::DiagonalsOctant' => 1,
'Math::PlanePath::Staircase' => 1,
'Math::PlanePath::StaircaseAlternating' => 1,
'Math::PlanePath::PyramidRows' => 1,
'Math::PlanePath::PyramidSides' => 1,
'Math::PlanePath::CellularRule190' => 1,
'Math::PlanePath::Corner' => 1,
'Math::PlanePath::HilbertCurve' => 1,
'Math::PlanePath::HilbertSpiral' => 1,
'Math::PlanePath::PeanoCurve' => 1,
'Math::PlanePath::ZOrderCurve' => 1,
'Math::PlanePath::Flowsnake' => 1,
'Math::PlanePath::FlowsnakeCentres' => 1,
'Math::PlanePath::QuintetCurve' => 1,
'Math::PlanePath::QuintetCentres' => 1,
'Math::PlanePath::DiamondSpiral' => 1,
'Math::PlanePath::AztecDiamondRings' => 1,
'Math::PlanePath::BetaOmega' => 1,
'Math::PlanePath::AR2W2Curve' => 1,
'Math::PlanePath::KochelCurve' => 1,
'Math::PlanePath::WunderlichMeander' => 1,
'Math::PlanePath::File' => 1,
'Math::PlanePath::KochCurve' => 1,
# rect_to_n_range exact end
);
my %rect_exact_hi = (%rect_exact,
# high is exact but low is not
'Math::PlanePath::SquareSpiral' => 1,
'Math::PlanePath::SquareArms' => 1,
'Math::PlanePath::TriangleSpiralSkewed' => 1,
'Math::PlanePath::MPeaks' => 1,
);
my %rect_before_n_start = ('Math::PlanePath::Rows' => 1,
'Math::PlanePath::Columns' => 1,
);
my %non_linear_frac = (
'Math::PlanePath::SacksSpiral' => 1,
'Math::PlanePath::VogelFloret' => 1,
);
#------------------------------------------------------------------------------
my ($pos_infinity, $neg_infinity, $nan);
my ($is_infinity, $is_nan);
if (! eval { require Data::Float; 1 }) {
MyTestHelpers::diag ("Data::Float not available");
} elsif (! Data::Float::have_infinite()) {
MyTestHelpers::diag ("Data::Float have_infinite() is false");
} else {
$is_infinity = sub {
my ($x) = @_;
return defined($x) && Data::Float::float_is_infinite($x);
};
$is_nan = sub {
my ($x) = @_;
return defined($x) && Data::Float::float_is_nan($x);
};
$pos_infinity = Data::Float::pos_infinity();
$neg_infinity = Data::Float::neg_infinity();
$nan = Data::Float::nan();
}
sub pos_infinity_maybe {
return (defined $pos_infinity ? $pos_infinity : ());
}
sub neg_infinity_maybe {
return (defined $neg_infinity ? $neg_infinity : ());
}
sub dbl_max {
require POSIX;
return POSIX::DBL_MAX();
}
sub dbl_max_neg {
require POSIX;
return - POSIX::DBL_MAX();
}
sub dbl_max_for_class_xy {
my ($path) = @_;
### dbl_max_for_class_xy(): "$path"
if ($path->isa('Math::PlanePath::CoprimeColumns')
|| $path->isa('Math::PlanePath::DiagonalRationals')
|| $path->isa('Math::PlanePath::DivisibleColumns')
|| $path->isa('Math::PlanePath::CellularRule')
|| $path->isa('Math::PlanePath::DragonCurve')
|| $path->isa('Math::PlanePath::PixelRings')
) {
### don't try DBL_MAX on this path xy_to_n() ...
return ();
}
return dbl_max();
}
sub dbl_max_neg_for_class_xy {
my ($path) = @_;
if (dbl_max_for_class_xy($path)) {
return dbl_max_neg();
} else {
return ();
}
}
sub dbl_max_for_class_rect {
my ($path) = @_;
# no DBL_MAX on these
if ($path->isa('Math::PlanePath::CoprimeColumns')
|| $path->isa('Math::PlanePath::DiagonalRationals')
|| $path->isa('Math::PlanePath::DivisibleColumns')
|| $path->isa('Math::PlanePath::CellularRule')
|| $path->isa('Math::PlanePath::PixelRings')
) {
### don't try DBL_MAX on this path rect_to_n_range() ...
return ();
}
return dbl_max();
}
sub dbl_max_neg_for_class_rect {
my ($path) = @_;
if (dbl_max_for_class_rect($path)) {
return dbl_max_neg();
} else {
return ();
}
}
sub is_pos_infinity {
my ($n) = @_;
return defined $n && defined $pos_infinity && $n == $pos_infinity;
}
sub is_neg_infinity {
my ($n) = @_;
return defined $n && defined $neg_infinity && $n == $neg_infinity;
}
sub pythagorean_diag {
my ($path,$x,$y) = @_;
$path->isa('Math::PlanePath::PythagoreanTree')
or return;
my $z = Math::Libm::hypot ($x, $y);
my $z_not_int = (int($z) != $z);
my $z_even = ! ($z & 1);
MyTestHelpers::diag ("x=$x y=$y, hypot z=$z z_not_int='$z_not_int' z_even='$z_even'");
my $psq = ($z+$x)/2;
my $p = sqrt(($z+$x)/2);
my $p_not_int = ($p != int($p));
MyTestHelpers::diag ("psq=$psq p=$p p_not_int='$p_not_int'");
my $qsq = ($z-$x)/2;
my $q = sqrt(($z-$x)/2);
my $q_not_int = ($q != int($q));
MyTestHelpers::diag ("qsq=$qsq q=$q q_not_int='$q_not_int'");
}
{
my $default_limit = ($ENV{'MATH_PLANEPATH_TEST_LIMIT'} || 30);
my $rect_limit = $ENV{'MATH_PLANEPATH_TEST_RECT_LIMIT'} || 4;
MyTestHelpers::diag ("test limit $default_limit, rect limit $rect_limit");
my $good = 1;
foreach my $mod (@modules) {
if ($verbose) {
MyTestHelpers::diag ($mod);
}
my ($class, %parameters) = module_parse($mod);
### $class
eval "require $class" or die;
my $xy_maximum_duplication = $xy_maximum_duplication{$class} || 0;
#
# MyTestHelpers::diag ($mod);
#
my $depth_limit = 10;
my $limit = $default_limit;
if (defined (my $step = $parameters{'step'})) {
if ($limit < 6*$step) {
$limit = 6*$step; # so goes into x/y negative
}
}
if ($mod =~ /^ArchimedeanChords/) {
if ($limit > 1100) {
$limit = 1100; # bit slow otherwise
}
}
if ($mod =~ /^CoprimeColumns|^DiagonalRationals/) {
if ($limit > 1100) {
$limit = 1100; # bit slow otherwise
}
}
my $report = sub {
my $name = $mod;
MyTestHelpers::diag ($name, ' oops ', @_);
$good = 0;
# exit 1;
};
my $path = $class->new (width => 20,
height => 20,
%parameters);
my $arms_count = $path->arms_count;
my $n_start = $path->n_start;
if ($mod !~ /,/) {
# base class only
my $parameter_info_hash = $path->parameter_info_hash;
if (my $pinfo = $parameter_info_hash->{'n_start'}) {
$pinfo->{'default'} == $n_start
or &$report("parameter info n_start default $pinfo->{'default'} but path->n_start $n_start");
}
if (my $pinfo = $parameter_info_hash->{'arms'}) {
$pinfo->{'default'} == $arms_count
or &$report("parameter info arms_count default $pinfo->{'default'} but path->arms_count $arms_count");
}
foreach my $pinfo ($path->parameter_info_list) {
if ($pinfo->{'type'} eq 'enum') {
my $choices = $pinfo->{'choices'};
my $num_choices = scalar(@$choices);
if (my $choices_display = $pinfo->{'choices_display'}) {
my $num_choices_display = scalar(@$choices_display);
if ($num_choices != $num_choices_display) {
&$report("parameter info $pinfo->{'name'} choices $num_choices but choices_display $num_choices_display");
}
}
}
}
### level_to_n_range() different among arms ...
# This checks that if there's an arms parameter then the
# level_to_n_range() code takes account of it.
if (my $pinfo = $parameter_info_hash->{'arms'}) {
my %seen;
foreach my $arms ($pinfo->{'minimum'} .. $pinfo->{'maximum'}) {
my $apath = $class->new (arms => $arms);
my ($n_lo, $n_hi) = $apath->level_to_n_range(3)
or next;
if (exists $seen{$n_hi}) {
&$report ("level_to_n_range() n_hi=$n_hi at arms=$arms is same as from arms=$seen{$n_hi}");
} else {
$seen{$n_hi} = $arms;
}
}
### %seen
}
### level_to_n_range() follows n_start ...
if (my $pinfo = $parameter_info_hash->{'n_start'}) {
my $apath = $class->new (n_start => 100);
my ($n_lo_100, $n_hi_100) = $path->level_to_n_range(3)
or next;
my $bpath = $class->new (n_start => 200);
my ($n_lo_200, $n_hi_200) = $path->level_to_n_range(3)
or next;
if ($n_lo_100 + 100 == $n_lo_200
&& $n_hi_100 + 100 == $n_hi_200) {
&$report ("level_to_n_range() not affected by n_start");
}
}
}
if ($parameters{'arms'} && $arms_count != $parameters{'arms'}) {
&$report("arms_count()==$arms_count expect $parameters{'arms'}");
}
unless ($arms_count >= 1) {
&$report("arms_count()==$arms_count should be >=1");
}
my $n_limit = $n_start + $limit;
my $n_frac_discontinuity = $path->n_frac_discontinuity;
my $x_negative_at_n = $path->x_negative_at_n;
if (defined $x_negative_at_n) {
$x_negative_at_n >= $n_start
or &$report ("x_negative_at_n() = $x_negative_at_n is < n_start=$n_start");
}
my $y_negative_at_n = $path->y_negative_at_n;
if (defined $y_negative_at_n) {
$y_negative_at_n >= $n_start
or &$report ("y_negative_at_n() = $y_negative_at_n is < n_start=$n_start");
}
# _UNDOCUMENTED__dxdy_list()
#
my @_UNDOCUMENTED__dxdy_list = $path->_UNDOCUMENTED__dxdy_list; # list ($dx,$dy, $dx,$dy, ...)
@_UNDOCUMENTED__dxdy_list % 2 == 0
or &$report ("_UNDOCUMENTED__dxdy_list() not an even number of values");
my %_UNDOCUMENTED__dxdy_list; # keys "$dx,$dy"
for (my $i = 0; $i < $#_UNDOCUMENTED__dxdy_list; $i += 2) {
$_UNDOCUMENTED__dxdy_list{"$_UNDOCUMENTED__dxdy_list[$i],$_UNDOCUMENTED__dxdy_list[$i+1]"} = 1;
}
for (my $i = 2; $i < $#_UNDOCUMENTED__dxdy_list; $i += 2) {
if (dxdy_cmp ($_UNDOCUMENTED__dxdy_list[$i-2],$_UNDOCUMENTED__dxdy_list[$i-1],
$_UNDOCUMENTED__dxdy_list[$i],$_UNDOCUMENTED__dxdy_list[$i+1]) >= 0) {
&$report ("_UNDOCUMENTED__dxdy_list() entries not sorted: $_UNDOCUMENTED__dxdy_list[$i-2],$_UNDOCUMENTED__dxdy_list[$i-1] then $_UNDOCUMENTED__dxdy_list[$i],$_UNDOCUMENTED__dxdy_list[$i+1]");
}
}
{
my ($x,$y) = $path->n_to_xy($n_start);
if (! defined $x) {
unless ($path->isa('Math::PlanePath::File')) {
&$report("n_start()==$n_start doesn't have an n_to_xy()");
}
} else {
my ($n_lo, $n_hi) = $path->rect_to_n_range ($x,$y, $x,$y);
if ($n_lo > $n_start || $n_hi < $n_start) {
&$report("n_start()==$n_start outside rect_to_n_range() $n_lo..$n_hi");
}
}
}
if (# VogelFloret has a secret undocumented return for N=0
! $path->isa('Math::PlanePath::VogelFloret')
# Rows/Columns secret undocumented extend into negatives ...
&& ! $path->isa('Math::PlanePath::Rows')
&& ! $path->isa('Math::PlanePath::Columns')) {
my $n = $n_start - 1;
{
my @xy = $path->n_to_xy($n);
if (scalar @xy) {
&$report("n_to_xy() at n_start()-1=$n has X,Y but should not");
}
}
foreach my $method ('n_to_rsquared', 'n_to_radius') {
my @ret = $path->$method($n);
if (scalar(@ret) != 1) {
&$report("$method() at n_start()-1 return not one value");
} elsif (defined $ret[0]) {
&$report("$method() at n_start()-1 has defined value but should not");
}
foreach my $offset (1, 2, 123) {
### n_to_r (n_start - offset): $offset
my $n = $n_start - $offset;
my @ret = $path->$method($n);
if ($path->isa('Math::PlanePath::File')) {
@ret = (undef); # all undefs for File
}
my $num_values = scalar(@ret);
$num_values == 1
or &$report("$method(n_start - $offset) got $num_values values, want 1");
if ($path->isa('Math::PlanePath::Rows')
|| $path->isa('Math::PlanePath::Columns')) {
### Rows,Columns has secret values for negative N, pretend not ...
@ret = (undef);
}
if ($offset == 1 && $path->isa('Math::PlanePath::VogelFloret')) {
### VogelFloret has a secret undocumented return for N=0 ...
@ret = (undef);
}
my ($ret) = @ret;
if (defined $ret) {
&$report("$method($n) n_start-$offset is ",$ret," expected undef");
}
}
}
}
{
my $saw_warning;
local $SIG{'__WARN__'} = sub { $saw_warning = 1; };
foreach my $method ('n_to_xy','n_to_dxdy',
'n_to_rsquared',
'n_to_radius',
($path->tree_n_num_children($n_start)
? ('tree_n_to_depth',
'tree_depth_to_n',
'tree_depth_to_n_end',
'tree_depth_to_n_range',
'tree_n_parent',
'tree_n_root',
'tree_n_children',
'tree_n_num_children',
)
: ())){
$saw_warning = 0;
$path->$method(undef);
$saw_warning or &$report("$method(undef) doesn't give a warning");
}
{
$saw_warning = 0;
$path->xy_to_n(0,undef);
$saw_warning or &$report("xy_to_n(0,undef) doesn't give a warning");
}
{
$saw_warning = 0;
$path->xy_to_n(undef,0);
$saw_warning or &$report("xy_to_n(undef,0) doesn't give a warning");
}
# No warning if xy_is_visited() is a constant, skip test in that case.
unless (coderef_is_const($path->can('xy_is_visited'))) {
$saw_warning = 0;
$path->xy_is_visited(0,undef);
$saw_warning or &$report("xy_is_visited(0,undef) doesn't give a warning");
$saw_warning = 0;
$path->xy_is_visited(undef,0);
$saw_warning or &$report("xy_is_visited(undef,0) doesn't give a warning");
}
}
# undef ok if nothing sensible
# +/-inf ok
# nan not intended, but might be ok
# finite could be a fixed x==0
if (defined $pos_infinity) {
{
### n_to_xy($pos_infinity) ...
my ($x, $y) = $path->n_to_xy($pos_infinity);
if ($path->isa('Math::PlanePath::File')) {
# all undefs for File
if (! defined $x) { $x = $pos_infinity }
if (! defined $y) { $y = $pos_infinity }
} elsif ($path->isa('Math::PlanePath::PyramidRows')
&& ! $parameters{'step'}) {
# x==0 normal from step==0, fake it up to pass test
if (defined $x && $x == 0) { $x = $pos_infinity }
}
(is_pos_infinity($x) || is_neg_infinity($x) || &$is_nan($x))
or &$report("n_to_xy($pos_infinity) x is $x");
(is_pos_infinity($y) || is_neg_infinity($y) || &$is_nan($y))
or &$report("n_to_xy($pos_infinity) y is $y");
}
{
### n_to_dxdy($pos_infinity) ...
my @dxdy = $path->n_to_xy($pos_infinity);
if ($path->isa('Math::PlanePath::File')) {
# all undefs for File
@dxdy = ($pos_infinity, $pos_infinity);
}
my $num_values = scalar(@dxdy);
$num_values == 2
or &$report("n_to_dxdy(pos_infinity) got $num_values values, want 2");
my ($dx,$dy) = @dxdy;
(is_pos_infinity($dx) || is_neg_infinity($dx) || &$is_nan($dx))
or &$report("n_to_dxdy($pos_infinity) dx is $dx");
(is_pos_infinity($dy) || is_neg_infinity($dy) || &$is_nan($dy))
or &$report("n_to_dxdy($pos_infinity) dy is $dy");
}
foreach my $method ('n_to_rsquared','n_to_radius') {
### n_to_r pos_infinity ...
my @ret = $path->$method($pos_infinity);
if ($path->isa('Math::PlanePath::File')) {
# all undefs for File
@ret = ($pos_infinity);
}
my $num_values = scalar(@ret);
$num_values == 1
or &$report("$method(pos_infinity) got $num_values values, want 1");
my ($ret) = @ret;
# allow NaN too, since sqrt(+inf) in various classes gives nan
(is_pos_infinity($ret) || &$is_nan($ret))
or &$report("$method($pos_infinity) ",$ret," expected +infinity");
}
{
### tree_n_children($pos_infinity) ...
my @children = $path->tree_n_children($pos_infinity);
}
{
### tree_n_num_children($pos_infinity) ...
my $num_children = $path->tree_n_num_children($pos_infinity);
}
{
### tree_n_to_subheight($pos_infinity) ...
my $height = $path->tree_n_to_subheight($pos_infinity);
if ($path->tree_n_num_children($n_start)) {
unless (! defined $height || is_pos_infinity($height)) {
&$report("tree_n_to_subheight($pos_infinity) ",$height," expected +inf");
}
} else {
unless (equal(0,$height)) {
&$report("tree_n_to_subheight($pos_infinity) ",$height," expected 0");
}
}
}
# {
# ### _EXPERIMENTAL__tree_n_to_leafdist($pos_infinity) ...
# my $leafdist = $path->_EXPERIMENTAL__tree_n_to_leafdist($pos_infinity);
# # if ($path->tree_n_num_children($n_start)) {
# # unless (! defined $leafdist || is_pos_infinity($leafdist)) {
# # &$report("_EXPERIMENTAL__tree_n_to_leafdist($pos_infinity) ",$leafdist," expected +inf");
# # }
# # } else {
# # unless (equal(0,$leafdist)) {
# # &$report("_EXPERIMENTAL__tree_n_to_leafdist($pos_infinity) ",$leafdist," expected 0");
# # }
# # }
# }
}
if (defined $neg_infinity) {
{
### n_to_xy($neg_infinity) ...
my @xy = $path->n_to_xy($neg_infinity);
if ($path->isa('Math::PlanePath::Rows')) {
# secret negative n for Rows
my ($x, $y) = @xy;
($x==$pos_infinity || $x==$neg_infinity || &$is_nan($x))
or &$report("n_to_xy($neg_infinity) x is $x");
($y==$neg_infinity)
or &$report("n_to_xy($neg_infinity) y is $y");
} elsif ($path->isa('Math::PlanePath::Columns')) {
# secret negative n for Columns
my ($x, $y) = @xy;
($x==$neg_infinity)
or &$report("n_to_xy($neg_infinity) x is $x");
($y==$pos_infinity || $y==$neg_infinity || &$is_nan($y))
or &$report("n_to_xy($neg_infinity) y is $y");
} else {
scalar(@xy) == 0
or &$report("n_to_xy($neg_infinity) xy is ",join(',',@xy));
}
}
{
### n_to_dxdy($neg_infinity) ...
my @dxdy = $path->n_to_xy($neg_infinity);
my $num_values = scalar(@dxdy);
if (($path->isa('Math::PlanePath::Rows')
|| $path->isa('Math::PlanePath::Columns'))
&& $num_values == 2) {
# Rows,Columns has secret values for negative N, pretend not
$num_values = 0;
}
$num_values == 0
or &$report("n_to_dxdy(neg_infinity) got $num_values values, want 0");
}
foreach my $method ('n_to_rsquared','n_to_radius') {
### n_to_r (neg_infinity) ...
my @ret = $path->$method($neg_infinity);
if ($path->isa('Math::PlanePath::File')) {
@ret = (undef); # all undefs for File
}
my $num_values = scalar(@ret);
$num_values == 1
or &$report("$method($neg_infinity) got $num_values values, want 1");
if ($path->isa('Math::PlanePath::Rows')
|| $path->isa('Math::PlanePath::Columns')) {
### Rows,Columns has secret values for negative N, pretend not ...
@ret = (undef);
}
my ($ret) = @ret;
if (defined $ret) {
&$report("$method($neg_infinity) $ret expected undef");
}
}
{
### tree_n_children($neg_infinity) ...
my @children = $path->tree_n_children($neg_infinity);
if (@children) {
&$report("tree_n_children($neg_infinity) ",@children," expected none");
}
}
{
### tree_n_num_children($neg_infinity) ...
my $num_children = $path->tree_n_num_children($neg_infinity);
if (defined $num_children) {
&$report("tree_n_children($neg_infinity) ",$num_children," expected undef");
}
}
{
### tree_n_to_subheight($neg_infinity) ...
my $height = $path->tree_n_to_subheight($neg_infinity);
if ($path->tree_n_num_children($n_start)) {
if (defined $height) {
&$report("tree_n_to_subheight($neg_infinity) ",$height," expected undef");
}
}
}
if ($path->can('_EXPERIMENTAL__tree_n_to_leafdist')) {
my $leafdist = $path->_EXPERIMENTAL__tree_n_to_leafdist($neg_infinity);
if ($path->tree_n_num_children($n_start)) {
if (defined $leafdist) {
&$report("_EXPERIMENTAL__tree_n_to_leafdist($neg_infinity) ",$leafdist," expected undef");
}
}
}
}
# nan input documented loosely as yet ...
if (defined $nan) {
{
my @xy = $path->n_to_xy($nan);
if ($path->isa('Math::PlanePath::File')) {
# allow empty from File without filename
if (! @xy) { @xy = ($nan, $nan); }
} elsif ($path->isa('Math::PlanePath::PyramidRows')
&& ! $parameters{'step'}) {
# x==0 normal from step==0, fake it up to pass test
if (defined $xy[0] && $xy[0] == 0) { $xy[0] = $nan }
}
my ($x, $y) = @xy;
&$is_nan($x) or &$report("n_to_xy($nan) x not nan, got ", $x);
&$is_nan($y) or &$report("n_to_xy($nan) y not nan, got ", $y);
}
{
my @dxdy = $path->n_to_xy($nan);
if ($path->isa('Math::PlanePath::File')
&& @dxdy == 0) {
# allow empty from File without filename
@dxdy = ($nan, $nan);
}
my $num_values = scalar(@dxdy);
$num_values == 2
or &$report("n_to_dxdy(nan) got $num_values values, want 2");
my ($dx,$dy) = @dxdy;
&$is_nan($dx) or &$report("n_to_dxdy($nan) dx not nan, got ", $dx);
&$is_nan($dy) or &$report("n_to_dxdy($nan) dy not nan, got ", $dy);
}
{
### tree_n_children($nan) ...
my @children = $path->tree_n_children($nan);
# ENHANCE-ME: what should nan return?
# if (@children) {
# &$report("tree_n_children($nan) ",@children," expected none");
# }
}
{
### tree_n_num_children($nan) ...
my $num_children = $path->tree_n_num_children($nan);
# ENHANCE-ME: what should nan return?
# &$is_nan($num_children)
# or &$report("tree_n_children($nan) ",$num_children," expected nan");
}
{
### tree_n_to_subheight($nan) ...
my $height = $path->tree_n_to_subheight($nan);
if ($path->tree_n_num_children($n_start)) {
(! defined $height || &$is_nan($height))
or &$report("tree_n_to_subheight($nan) ",$height," expected nan");
}
}
# {
# ### _EXPERIMENTAL__tree_n_to_leafdist($nan) ...
# my $leafdist = $path->_EXPERIMENTAL__tree_n_to_leafdist($nan);
# if ($path->tree_n_num_children($n_start)) {
# (! defined $leafdist || &$is_nan($leafdist))
# or &$report("_EXPERIMENTAL__tree_n_to_leafdist($nan) ",$leafdist," expected nan");
# }
# }
}
foreach my $x
(0,
pos_infinity_maybe(),
neg_infinity_maybe(),
dbl_max_for_class_xy($path),
dbl_max_neg_for_class_xy($path)) {
foreach my $y (0,
pos_infinity_maybe(),
neg_infinity_maybe(),,
dbl_max_for_class_xy($path),
dbl_max_neg_for_class_xy($path)) {
next if ! defined $y;
### xy_to_n: $x, $y
my @n = $path->xy_to_n($x,$y);
scalar(@n) == 1
or &$report("xy_to_n($x,$y) want 1 value, got ",scalar(@n));
# my $n = $n[0];
# &$is_infinity($n) or &$report("xy_to_n($x,$y) n not inf, got ",$n);
}
}
foreach my $x1 (0,
pos_infinity_maybe(),
neg_infinity_maybe(),
dbl_max_for_class_rect($path),
dbl_max_neg_for_class_rect($path)) {
foreach my $x2 (0,
pos_infinity_maybe(),
neg_infinity_maybe(),
dbl_max_for_class_rect($path),
dbl_max_neg_for_class_rect($path)) {
foreach my $y1 (0,
pos_infinity_maybe(),
neg_infinity_maybe(),
dbl_max_for_class_rect($path),
dbl_max_neg_for_class_rect($path)) {
foreach my $y2 (0,
pos_infinity_maybe(),
neg_infinity_maybe(),
dbl_max_for_class_rect($path),
dbl_max_neg_for_class_rect($path)) {
my @nn = $path->rect_to_n_range($x1,$y1, $x2,$y2);
scalar(@nn) == 2
or &$report("rect_to_n_range($x1,$y1, $x2,$y2) want 2 values, got ",scalar(@nn));
# &$is_infinity($n) or &$report("xy_to_n($x,$y) n not inf, got ",$n);
}
}
}
}
my $x_minimum = $path->x_minimum;
my $x_maximum = $path->x_maximum;
my $y_minimum = $path->y_minimum;
my $y_maximum = $path->y_maximum;
my $sumxy_minimum = $path->sumxy_minimum;
my $sumxy_maximum = $path->sumxy_maximum;
my $sumabsxy_minimum = $path->sumabsxy_minimum;
my $sumabsxy_maximum = $path->sumabsxy_maximum;
my $diffxy_minimum = $path->diffxy_minimum;
my $diffxy_maximum = $path->diffxy_maximum;
my $absdiffxy_minimum = $path->absdiffxy_minimum;
my $absdiffxy_maximum = $path->absdiffxy_maximum;
my $gcdxy_minimum = $path->gcdxy_minimum;
my $gcdxy_maximum = $path->gcdxy_maximum;
my $turn_any_left = $path->turn_any_left;
my $turn_any_right = $path->turn_any_right;
my $turn_any_straight = $path->turn_any_straight;
my %saw_n_to_xy;
my %count_n_to_xy;
my $got_x_negative_at_n;
my $got_y_negative_at_n;
my $got_x_minimum;
my $got_y_minimum;
my (@prev_x,@prev_y, @prev_dx,@prev_dy);
my ($dx_minimum, $dy_minimum);
my ($dx_maximum, $dy_maximum);
my %seen_dxdy;
my $seen__UNDOCUMENTED__dxdy_list_at_n;
my $got_turn_any_left_at_n;
my $got_turn_any_right_at_n;
my $got_turn_any_straight_at_n;
my @n_to_x;
my @n_to_y;
foreach my $n ($n_start .. $n_limit) {
my ($x, $y) = $path->n_to_xy ($n)
or next;
$n_to_x[$n] = $x;
$n_to_y[$n] = $y;
defined $x or &$report("n_to_xy($n) X undef");
defined $y or &$report("n_to_xy($n) Y undef");
my $arm = $n % $arms_count;
if ($x < 0) {
if (! defined $got_x_negative_at_n) {
$got_x_negative_at_n= $n;
}
}
if ($y < 0) {
if (! defined $got_y_negative_at_n) {
$got_y_negative_at_n= $n;
}
}
if (defined $x_minimum && $x < $x_minimum) {
&$report("n_to_xy($n) X=$x below x_minimum=$x_minimum");
}
if (defined $x_maximum && $x > $x_maximum) {
&$report("n_to_xy($n) X=$x below x_maximum=$x_maximum");
}
if (defined $y_minimum && $y < $y_minimum) {
&$report("n_to_xy($n) Y=$y below y_minimum=$y_minimum");
}
if (defined $y_maximum && $y > $y_maximum) {
&$report("n_to_xy($n) Y=$y below y_maximum=$y_maximum");
}
# if (! defined $got_x_minimum || $x < $got_x_minimum) {
# $got_x_minimum = $x;
# }
# if (! defined $got_y_minimum || $y < $got_y_minimum) {
# $got_y_minimum = $y;
# }
# if (! defined $got_x_maximum || $x < $got_x_maximum) {
# $got_x_maximum = $x;
# }
# if (! defined $got_y_maximum || $y < $got_y_maximum) {
# $got_y_maximum = $y;
# }
{
my $sumxy = $x + $y;
if (defined $sumxy_minimum && $sumxy < $sumxy_minimum) {
&$report("n_to_xy($n) X+Y=$sumxy below sumxy_minimum=$sumxy_minimum");
}
if (defined $sumxy_maximum && $sumxy > $sumxy_maximum) {
&$report("n_to_xy($n) X+Y=$sumxy above sumxy_maximum=$sumxy_maximum");
}
}
{
my $sumabsxy = abs($x) + abs($y);
if (defined $sumabsxy_minimum && $sumabsxy < $sumabsxy_minimum) {
&$report("n_to_xy($n) abs(X)+abs(Y)=$sumabsxy below sumabsxy_minimum=$sumabsxy_minimum");
}
if (defined $sumabsxy_maximum && $sumabsxy > $sumabsxy_maximum) {
&$report("n_to_xy($n) abs(X)+abs(Y)=$sumabsxy above sumabsxy_maximum=$sumabsxy_maximum");
}
}
{
my $diffxy = $x - $y;
if (defined $diffxy_minimum && $diffxy < $diffxy_minimum) {
&$report("n_to_xy($n) X-Y=$diffxy below diffxy_minimum=$diffxy_minimum");
}
if (defined $diffxy_maximum && $diffxy > $diffxy_maximum) {
&$report("n_to_xy($n) X-Y=$diffxy above diffxy_maximum=$diffxy_maximum");
}
}
{
my $absdiffxy = abs($x - $y);
if (defined $absdiffxy_minimum && $absdiffxy < $absdiffxy_minimum) {
&$report("n_to_xy($n) abs(X-Y)=$absdiffxy below absdiffxy_minimum=$absdiffxy_minimum");
}
if (defined $absdiffxy_maximum && $absdiffxy > $absdiffxy_maximum) {
&$report("n_to_xy($n) abs(X-Y)=$absdiffxy above absdiffxy_maximum=$absdiffxy_maximum");
}
}
{
my $gcdxy = gcd(abs($x),abs($y));
if (defined $gcdxy_minimum && $gcdxy < $gcdxy_minimum) {
&$report("n_to_xy($n) gcd($x,$y)=$gcdxy below gcdxy_minimum=$gcdxy_minimum");
}
if (defined $gcdxy_maximum && $gcdxy > $gcdxy_maximum) {
&$report("n_to_xy($n) gcd($x,$y)=$gcdxy above gcdxy_maximum=$gcdxy_maximum");
}
}
my $xystr = (int($x) == $x && int($y) == $y
? sprintf('%d,%d', $x,$y)
: sprintf('%.3f,%.3f', $x,$y));
if ($count_n_to_xy{$xystr}++ > $xy_maximum_duplication) {
unless ($x == 0 && $y == 0
&& $count_n_to_xy{$xystr} <= $xy_maximum_duplication_at_origin{$class}) {
&$report ("n_to_xy($n) duplicate$count_n_to_xy{$xystr} xy=$xystr prev n=$saw_n_to_xy{$xystr}");
}
}
$saw_n_to_xy{$xystr} = $n;
my ($dx,$dy);
if (defined $prev_x[$arm]) { $dx = $x - $prev_x[$arm]; }
if (defined $prev_y[$arm]) { $dy = $y - $prev_y[$arm]; }
$prev_x[$arm] = $x;
$prev_y[$arm] = $y;
my $dxdy_str = (defined $dx && defined $dy ? "$dx,$dy" : undef);
if (defined $dxdy_str) {
if (! defined $seen_dxdy{$dxdy_str}) {
$seen_dxdy{$dxdy_str} ||= [$dx,$dy];
$seen__UNDOCUMENTED__dxdy_list_at_n = $n-$arms_count;
}
if (@_UNDOCUMENTED__dxdy_list) {
$_UNDOCUMENTED__dxdy_list{$dxdy_str}
or &$report ("N=$n dxdy=$dxdy_str not in _UNDOCUMENTED__dxdy_list");
}
}
if (defined $dx) {
if (! defined $dx_maximum || $dx > $dx_maximum) { $dx_maximum = $dx; }
if (! defined $dx_minimum || $dx < $dx_minimum) { $dx_minimum = $dx; }
}
if (defined $dy) {
if (! defined $dy_maximum || $dy > $dy_maximum) { $dy_maximum = $dy; }
if (! defined $dy_minimum || $dy < $dy_minimum) { $dy_minimum = $dy; }
}
my $prev_dx = $prev_dx[$arm];
my $prev_dy = $prev_dy[$arm];
if (defined $prev_dx) {
my $n_of_turn = $n - $arms_count;
my $LSR = ($dy*$prev_dx - $dx*$prev_dy);
# allow for floating point round-off on MultipleRings polygon straights
if (abs($LSR) < 1e-10) { $LSR = 0; }
$LSR = ($LSR <=> 0); # 1,undef,-1
# print "turn N=$n_of_turn at $x,$y dxdy prev $prev_dx,$prev_dy this $dx,$dy is LSR=$LSR\n";
if ($LSR > 0) {
$turn_any_left
or &$report ("turn_any_left() false but left at N=$n_of_turn");
if (! defined $got_turn_any_left_at_n) { $got_turn_any_left_at_n = $n_of_turn; }
}
if (! $LSR) {
$turn_any_straight
or &$report ("turn_any_straight() false but straight at N=$n_of_turn");
if (! defined $got_turn_any_straight_at_n) { $got_turn_any_straight_at_n = $n_of_turn; }
# print "straight at N=$n_of_turn dxdy $prev_dx,$prev_dy then $dx,$dy\n";
}
if ($LSR < 0) {
$turn_any_right
or &$report ("turn_any_right() false but right at N=$n_of_turn");
if (! defined $got_turn_any_right_at_n) { $got_turn_any_right_at_n = $n_of_turn; }
}
}
$prev_dx[$arm] = $dx;
$prev_dy[$arm] = $dy;
{
my $x2 = $x + ($x >= 0 ? .4 : -.4);
my $y2 = $y + ($y >= 0 ? .4 : -.4);
my ($n_lo, $n_hi) = $path->rect_to_n_range
(0,0, $x2,$y2);
$n_lo <= $n
or &$report ("rect_to_n_range(0,0, $x2,$y2) lo n=$n xy=$xystr, got n_lo=$n_lo");
$n_hi >= $n
or &$report ("rect_to_n_range(0,0, $x2,$y2) hi n=$n xy=$xystr, got n_hi=$n_hi");
$n_lo == int($n_lo)
or &$report ("rect_to_n_range(0,0, $x2,$y2) lo n=$n xy=$xystr, got n_lo=$n_lo, integer");
$n_hi == int($n_hi)
or &$report ("rect_to_n_range(0,0, $x2,$y2) hi n=$n xy=$xystr, got n_hi=$n_hi, integer");
$n_lo >= $n_start
or &$report ("rect_to_n_range(0,0, $x2,$y2) n_lo=$n_lo is before n_start=$n_start");
}
{
my ($n_lo, $n_hi) = $path->rect_to_n_range ($x,$y, $x,$y);
($rect_exact{$class} ? $n_lo == $n : $n_lo <= $n)
or &$report ("rect_to_n_range() lo n=$n xy=$xystr, got $n_lo");
($rect_exact_hi{$class} ? $n_hi == $n : $n_hi >= $n)
or &$report ("rect_to_n_range() hi n=$n xy=$xystr, got $n_hi");
$n_lo == int($n_lo)
or &$report ("rect_to_n_range() lo n=$n xy=$xystr, got n_lo=$n_lo, should be an integer");
$n_hi == int($n_hi)
or &$report ("rect_to_n_range() hi n=$n xy=$xystr, got n_hi=$n_hi, should be an integer");
$n_lo >= $n_start
or &$report ("rect_to_n_range() n_lo=$n_lo is before n_start=$n_start");
}
unless ($xy_maximum_duplication > 0) {
foreach my $x_offset (0) { # bit slow: , -0.2, 0.2) {
foreach my $y_offset (0, +0.2) { # bit slow: , -0.2) {
my $rev_n = $path->xy_to_n ($x + $x_offset, $y + $y_offset);
### try xy_to_n from: "n=$n xy=$x,$y xy=$xystr x_offset=$x_offset y_offset=$y_offset"
### $rev_n
unless (defined $rev_n && $n == $rev_n) {
&$report ("xy_to_n() rev n=$n xy=$xystr x_offset=$x_offset y_offset=$y_offset got ".(defined $rev_n ? $rev_n : 'undef'));
pythagorean_diag($path,$x,$y);
}
}
}
}
}
#--------------------------------------------------------------------------
# turn_any_left(), turn_any_straight(), turn_any_right()
if ($turn_any_left && ! defined $got_turn_any_left_at_n) {
my $at_n;
if ($path->can('_UNDOCUMENTED__turn_any_left_at_n')) {
$at_n = $path->_UNDOCUMENTED__turn_any_left_at_n;
}
if (defined $at_n && $n_limit <= $at_n) {
MyTestHelpers::diag (" skip n_limit=$n_limit < turn left at_n=$at_n");
} elsif ($path->isa('Math::PlanePath::File')) {
MyTestHelpers::diag (" skip turn_any_left() not established for File");
} else {
&$report ("turn_any_left() true but not seen to N=$n_limit");
}
}
if ($turn_any_straight && ! defined $got_turn_any_straight_at_n) {
my $at_n;
if ($path->can('_UNDOCUMENTED__turn_any_straight_at_n')) {
$at_n = $path->_UNDOCUMENTED__turn_any_straight_at_n;
}
if (defined $at_n && $n_limit <= $at_n) {
MyTestHelpers::diag (" skip n_limit=$n_limit < turn straight at_n=$at_n");
} elsif ($path->isa('Math::PlanePath::File')) {
MyTestHelpers::diag (" skip turn_any_straight() not established for File");
} else {
&$report ("turn_any_straight() true but not seen to N=$n_limit");
}
}
if ($turn_any_right && ! defined $got_turn_any_right_at_n) {
my $at_n;
if ($path->can('_UNDOCUMENTED__turn_any_right_at_n')) {
$at_n = $path->_UNDOCUMENTED__turn_any_right_at_n;
}
if (defined $at_n && $n_limit <= $at_n) {
MyTestHelpers::diag (" skip n_limit=$n_limit < turn right at_n=$at_n");
} elsif ($path->isa('Math::PlanePath::File')) {
MyTestHelpers::diag (" skip turn_any_right() not established for File");
} else {
&$report ("turn_any_right() true but not seen to N=$n_limit");
}
}
foreach my $elem
(['_UNDOCUMENTED__turn_any_left_at_n', 1,$got_turn_any_left_at_n ],
['_UNDOCUMENTED__turn_any_straight_at_n',0,$got_turn_any_straight_at_n ],
['_UNDOCUMENTED__turn_any_right_at_n', -1,$got_turn_any_right_at_n ]){
my ($method, $want_LSR, $seen_at_n) = @$elem;
if ($path->can($method)) {
if (defined(my $n = $path->$method)) {
my $got_LSR = path_n_to_LSR($path,$n);
$got_LSR == $want_LSR
or &$report ("$method()=$n got LSR=$got_LSR want $want_LSR");
if (defined $seen_at_n) {
$n == $seen_at_n
or &$report ("$method()=$n but saw first at N=$seen_at_n");
}
}
}
}
#--------------------------------------------------------------------------
### n_to_xy() fractional ...
unless ($non_linear_frac{$class}
|| defined $n_frac_discontinuity) {
foreach my $n ($n_start .. $#n_to_x - $arms_count) {
my $x = $n_to_x[$n];
my $y = $n_to_y[$n];
my $next_x = $n_to_x[$n+$arms_count];
my $next_y = $n_to_y[$n+$arms_count];
next unless defined $x && defined $next_x;
my $dx = $next_x - $x;
my $dy = $next_y - $y;
foreach my $frac (0.25, 0.75) {
my $n_frac = $n + $frac;
my ($got_x,$got_y) = $path->n_to_xy($n_frac);
my $want_x = $x + $frac*$dx;
my $want_y = $y + $frac*$dy;
abs($want_x - $got_x) < 0.00001
or &$report ("n_to_xy($n_frac) got_x=$got_x want_x=$want_x");
abs($want_y - $got_y) < 0.00001
or &$report ("n_to_xy($n_frac) got_y=$got_y want_y=$want_y");
}
}
}
#--------------------------------------------------------------------------
### n_to_dxdy() ...
if ($path->can('n_to_dxdy') != Math::PlanePath->can('n_to_dxdy')) {
MyTestHelpers::diag ($mod, ' n_to_dxdy()');
foreach my $n ($n_start .. $#n_to_x - $arms_count) {
my $x = $n_to_x[$n];
my $y = $n_to_y[$n];
my $next_x = $n_to_x[$n+$arms_count];
my $next_y = $n_to_y[$n+$arms_count];
next unless defined $x && defined $next_x;
my $want_dx = $next_x - $x;
my $want_dy = $next_y - $y;
my ($got_dx,$got_dy) = $path->n_to_dxdy($n);
$want_dx == $got_dx
or &$report ("n_to_dxdy($n) got_dx=$got_dx want_dx=$want_dx (next_x=$n_to_x[$n+$arms_count], x=$n_to_x[$n])");
$want_dy == $got_dy
or &$report ("n_to_dxdy($n) got_dy=$got_dy want_dy=$want_dy");
}
foreach my $n ($n_start .. $n_limit) {
foreach my $offset (0.25, 0.75) {
my $n = $n + $offset;
my ($x,$y) = $path->n_to_xy($n);
my ($next_x,$next_y) = $path->n_to_xy($n+$arms_count);
my $want_dx = ($next_x - $x);
my $want_dy = ($next_y - $y);
my ($got_dx,$got_dy) = $path->n_to_dxdy($n);
$want_dx == $got_dx
or &$report ("n_to_dxdy($n) got_dx=$got_dx want_dx=$want_dx");
$want_dy == $got_dy
or &$report ("n_to_dxdy($n) got_dy=$got_dy want_dy=$want_dy");
}
}
}
#--------------------------------------------------------------------------
### n_to_rsquared() vs X^2,Y^2 ...
if ($path->can('n_to_rsquared') != Math::PlanePath->can('n_to_rsquared')) {
foreach my $n ($n_start .. $#n_to_x) {
my $x = $n_to_x[$n];
my $y = $n_to_y[$n];
my ($n_to_rsquared) = $path->n_to_rsquared($n);
my $xy_to_rsquared = $x*$x + $y*$y;
if (abs($n_to_rsquared - $xy_to_rsquared) > 0.0000001) {
&$report ("n_to_rsquared() at n=$n,x=$x,y=$y got $n_to_rsquared whereas x^2+y^2=$xy_to_rsquared");
}
}
}
#--------------------------------------------------------------------------
### n_to_radius() vs X^2,Y^2 ...
if ($path->can('n_to_radius') != Math::PlanePath->can('n_to_radius')) {
foreach my $n ($n_start .. $#n_to_x) {
my $x = $n_to_x[$n];
my $y = $n_to_y[$n];
my ($n_to_radius) = $path->n_to_radius($n);
my $xy_to_radius = sqrt($x*$x + $y*$y);
if (abs($n_to_radius - $xy_to_radius) > 0.0000001) {
&$report ("n_to_radius() at n=$n,x=$x,y=$y got $n_to_radius whereas x^2+y^2=$xy_to_radius");
}
}
}
#--------------------------------------------------------------------------
### _NOTDOCUMENTED_n_to_figure_boundary() ...
if ($path->can('_NOTDOCUMENTED_n_to_figure_boundary')) {
my $want = 4;
my $bad = 0;
foreach my $n ($n_start .. $n_start + 1000) {
my $got = $path->_NOTDOCUMENTED_n_to_figure_boundary($n);
if ($want != $got) {
my ($x,$y) = $path->n_to_xy($n);
&$report ("_NOTDOCUMENTED_n_to_figure_boundary() at n=$n,x=$x,y=$y got $got whereas want $want");
last if $bad++ > 20;
}
$want += path_n_to_dboundary($path,$n);
}
}
#--------------------------------------------------------------------------
### level_to_n_range() and with n_to_level() ...
foreach my $n ($n_start-1, $n_start-100) {
my $got = $path->n_to_level($n);
if (defined $got) {
&$report ("n_to_level() not undef on N=$n before n_start=$n_start");
}
}
my $have_level_to_n_range = do {
my @n_range = $path->level_to_n_range(0);
scalar(@n_range)
};
if ($have_level_to_n_range) {
my @n_range;
my $bad = 0;
foreach my $n ($n_start .. $n_start+100) {
my $level = $path->n_to_level($n);
if (! defined $level) {
&$report ("n_to_level($n) undef");
last;
}
if ($level < 0) {
&$report ("n_to_level() negative");
last if $bad++ > 10;
next;
}
$n_range[$level] ||= [ $path->level_to_n_range($level) ];
my ($n_lo, $n_hi) = @{$n_range[$level]};
unless ($n >= $n_lo && $n <= $n_hi) {
&$report ("n_to_level($n)=$level has $n outside $n_lo .. $n_hi");
last if $bad++ > 10;
}
}
}
# n_to_level() just before and after level_to_n_range() high limit
if ($have_level_to_n_range) {
foreach my $level (0 .. 10) {
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
last if $n_hi > 2**24;
foreach my $offset (-6 .. 0) {
my $n = $n_hi + $offset;
next if $n < $n_start;
my $got_level = $path->n_to_level($n_hi);
unless ($got_level == $level) {
&$report ("n_to_level(n_hi$offset=$n)=$got_level but level_to_n_range($level)= $n_lo .. $n_hi");
}
}
foreach my $offset (1 .. 6) {
my $n = $n_hi + $offset;
my $got_level = $path->n_to_level($n_hi+1);
my $want_level = $level+1;
unless ($got_level == $want_level) {
&$report ("n_to_level(n_hi+$offset=$n)=$got_level but level_to_n_range($level)= $n_lo .. $n_hi want $want_level");
}
}
}
}
#--------------------------------------------------------------------------
### n_to_xy() various bogus values return 0 or 2 values and not crash ...
foreach my $n (-100, -2, -1, -0.6, -0.5, -0.4,
0, 0.4, 0.5, 0.6) {
my @xy = $path->n_to_xy ($n);
(@xy == 0 || @xy == 2)
or &$report ("n_to_xy() n=$n got ",scalar(@xy)," values");
}
foreach my $elem ([-1,-1, -1,-1],
) {
my ($x1,$y1,$x2,$y2) = @$elem;
my ($got_lo, $got_hi) = $path->rect_to_n_range ($x1,$y1, $x2,$y2);
(defined $got_lo && defined $got_hi)
or &$report ("rect_to_n_range() x1=$x1,y1=$y1, x2=$x2,y2=$y2 undefs");
if ($got_hi >= $got_lo) {
$got_lo >= $n_start
or &$report ("rect_to_n_range() got_lo=$got_lo is before n_start=$n_start");
}
}
#--------------------------------------------------------------------------
### _UNDOCUMENTED__n_is_x_positive() ...
if ($path->can('_UNDOCUMENTED__n_is_x_positive')) {
foreach my $n (0 .. $arms_count * 256) {
my ($x,$y) = $path->n_to_xy($n);
my $want = ($x >= 0 && $y == 0 ? 1 : 0);
my $got = $path->_UNDOCUMENTED__n_is_x_positive($n) ? 1 : 0;
unless ($got == $want) {
&$report ("_UNDOCUMENTED__n_is_x_positive() n=$n want $want got $got");
}
}
}
#--------------------------------------------------------------------------
### _UNDOCUMENTED__n_is_diagonal_NE() ...
if ($path->can('_UNDOCUMENTED__n_is_diagonal_NE')) {
foreach my $n (0 .. $arms_count * 256) {
my ($x,$y) = $path->n_to_xy($n);
my $want = ($x >= 0 && $x == $y ? 1 : 0);
my $got = $path->_UNDOCUMENTED__n_is_diagonal_NE($n) ? 1 : 0;
unless ($got == $want) {
&$report ("_UNDOCUMENTED__n_is_diagonal_NE() n=$n want $want got $got");
}
}
}
#--------------------------------------------------------------------------
### _UNDOCUMENTED__dxdy_list() completeness ...
if (@_UNDOCUMENTED__dxdy_list) {
my $_UNDOCUMENTED__dxdy_list_at_n;
my $dxdy_num = int(scalar(@_UNDOCUMENTED__dxdy_list)/2);
my $seen_dxdy_num = scalar keys %seen_dxdy;
$_UNDOCUMENTED__dxdy_list_at_n = $path->_UNDOCUMENTED__dxdy_list_at_n;
if (defined $_UNDOCUMENTED__dxdy_list_at_n) {
$_UNDOCUMENTED__dxdy_list_at_n >= $n_start
or &$report ("_UNDOCUMENTED__dxdy_list_at_n() = $_UNDOCUMENTED__dxdy_list_at_n is < n_start=$n_start");
if ($seen_dxdy_num == $dxdy_num) {
$seen__UNDOCUMENTED__dxdy_list_at_n == $_UNDOCUMENTED__dxdy_list_at_n
or &$report ("_UNDOCUMENTED__dxdy_list_at_n() = $_UNDOCUMENTED__dxdy_list_at_n but seen__UNDOCUMENTED__dxdy_list_at_n=$seen__UNDOCUMENTED__dxdy_list_at_n");
}
} else {
$_UNDOCUMENTED__dxdy_list_at_n = $n_start;
}
if ($n_limit - $arms_count < $_UNDOCUMENTED__dxdy_list_at_n) {
MyTestHelpers::diag (" skip n_limit=$n_limit <= _UNDOCUMENTED__dxdy_list_at_n=$_UNDOCUMENTED__dxdy_list_at_n");
} else {
foreach my $dxdy_str (keys %_UNDOCUMENTED__dxdy_list) {
if (! $seen_dxdy{$dxdy_str}) {
&$report ("_UNDOCUMENTED__dxdy_list() has $dxdy_str not seen to n_limit=$n_limit");
}
}
}
} else {
my $seen_dxdy_count = scalar keys %seen_dxdy;
if ($seen_dxdy_count > 0
&& $seen_dxdy_count <= 10
&& ($dx_maximum||0) < 4
&& ($dy_maximum||0) < 4
&& ($dx_minimum||0) > -4
&& ($dy_minimum||0) > -4) {
MyTestHelpers::diag (" possible dxdy list: ", join(' ', keys %seen_dxdy));
}
}
#--------------------------------------------------------------------------
### x negative xy_to_n() ...
foreach my $x (-100, -99) {
### $x
my @n = $path->xy_to_n ($x,-1);
### @n
(scalar(@n) == 1)
or &$report ("xy_to_n($x,-1) array context got ",scalar(@n)," values but should be 1, possibly undef");
}
{
my $x_negative = ($path->x_negative ? 1 : 0);
my $got_x_negative = (defined $got_x_negative_at_n ? 1 : 0);
# if ($mod eq 'ComplexPlus,realpart=2'
# || $mod eq 'ComplexPlus,realpart=3'
# || $mod eq 'ComplexPlus,realpart=4'
# || $mod eq 'ComplexPlus,realpart=5'
# ) {
# # these don't get to X negative in small rectangle
# $got_x_negative = 1;
# }
if ($n_limit < (defined $x_negative_at_n ? $x_negative_at_n : $n_start)) {
MyTestHelpers::diag (" skip n_limit=$n_limit <= x_negative_at_n=$x_negative_at_n");
} else {
($x_negative == $got_x_negative)
or &$report ("x_negative() $x_negative but in rect to n=$limit got $got_x_negative (x_negative_at_n=$x_negative_at_n)");
}
if (defined $got_x_negative_at_n) {
equal($x_negative_at_n, $got_x_negative_at_n)
or &$report ("x_negative_at_n() = ",$x_negative_at_n," but got_x_negative_at_n=$got_x_negative_at_n");
}
if (defined $x_negative_at_n && $x_negative_at_n < 0x100_0000) {
{
my ($x,$y) = $path->n_to_xy($x_negative_at_n);
$x < 0 or &$report ("x_negative_at_n()=$x_negative_at_n but xy=$x,$y");
}
if ($x_negative_at_n > $n_start) {
my $n = $x_negative_at_n - 1;
my ($x,$y) = $path->n_to_xy($n);
$x >= 0 or &$report ("x_negative_at_n()=$x_negative_at_n but at N=$n xy=$x,$y");
}
}
}
{
my $y_negative = ($path->y_negative ? 1 : 0);
my $got_y_negative = (defined $got_y_negative_at_n ? 1 : 0);
# if (($mod eq 'ComplexPlus' && $limit < 32) # first y_neg at N=32
# || $mod eq 'ComplexPlus,realpart=2' # y_neg big
# || $mod eq 'ComplexPlus,realpart=3'
# || $mod eq 'ComplexPlus,realpart=4'
# || $mod eq 'ComplexPlus,realpart=5'
# || $mod eq 'ComplexMinus,realpart=3'
# || $mod eq 'ComplexMinus,realpart=4'
# || $mod eq 'ComplexMinus,realpart=5'
# ) {
# # GosperSide take a long time to get
# # to Y negative, not reached by the rectangle
# # considered here. ComplexMinus doesn't get there
# # on realpart==5 or bigger too.
# $got_y_negative = 1;
# }
if ($n_limit < (defined $y_negative_at_n ? $y_negative_at_n : $n_start)) {
MyTestHelpers::diag (" skip n_limit=$n_limit <= y_negative_at_n=$y_negative_at_n");
} else {
($y_negative == $got_y_negative)
or &$report ("y_negative() $y_negative but in rect to n=$limit got $got_y_negative (y_negative_at_n=$y_negative_at_n)");
}
if (defined $got_y_negative_at_n) {
equal($y_negative_at_n, $got_y_negative_at_n)
or &$report ("y_negative_at_n() = ",$y_negative_at_n," but got_y_negative_at_n=$got_y_negative_at_n");
}
if (defined $y_negative_at_n && $y_negative_at_n < 0x100_0000) {
{
# n_to_xy() of y_negative_at_n should be Y < 0
my ($x,$y) = $path->n_to_xy($y_negative_at_n);
$y < 0 or &$report ("y_negative_at_n()=$y_negative_at_n but xy=$x,$y");
}
{
# n_to_xy() of y_negative_at_n - 1 should be Y >= 0,
# unless y_negative_at_n is at n_start
my $n = $y_negative_at_n - 1;
if ($n >= $n_start) {
my ($x,$y) = $path->n_to_xy($n);
$y >= 0 or &$report ("y_negative_at_n()=$y_negative_at_n but at N=$n xy=$x,$y");
}
}
}
}
if ($path->figure ne 'circle'
# bit slow
&& ! ($path->isa('Math::PlanePath::Flowsnake'))) {
my $x_min = ($path->x_negative ? - int($rect_limit/2) : -2);
my $y_min = ($path->y_negative ? - int($rect_limit/2) : -2);
my $x_max = $x_min + $rect_limit;
my $y_max = $y_min + $rect_limit;
my $data;
foreach my $x ($x_min .. $x_max) {
foreach my $y ($y_min .. $y_max) {
my $n = $path->xy_to_n ($x, $y);
if (defined $n && $n < $n_start
&& ! $path->isa('Math::PlanePath::Rows')
&& ! $path->isa('Math::PlanePath::Columns')) {
&$report ("xy_to_n($x,$y) gives n=$n < n_start=$n_start");
}
$data->{$y}->{$x} = $n;
}
}
#### $data
# MyTestHelpers::diag ("rect check ...");
foreach my $y1 ($y_min .. $y_max) {
foreach my $y2 ($y1 .. $y_max) {
foreach my $x1 ($x_min .. $x_max) {
my $min;
my $max;
foreach my $x2 ($x1 .. $x_max) {
my @col = map {$data->{$_}->{$x2}} $y1 .. $y2;
@col = grep {defined} @col;
$min = List::Util::min (grep {defined} $min, @col);
$max = List::Util::max (grep {defined} $max, @col);
my $want_min = (defined $min ? $min : 1);
my $want_max = (defined $max ? $max : 0);
### @col
### rect: "$x1,$y1 $x2,$y2 expect N=$want_min..$want_max"
foreach my $x_swap (0, 1) {
my ($x1,$x2) = ($x_swap ? ($x1,$x2) : ($x2,$x1));
foreach my $y_swap (0, 1) {
my ($y1,$y2) = ($y_swap ? ($y1,$y2) : ($y2,$y1));
my ($got_min, $got_max)
= $path->rect_to_n_range ($x1,$y1, $x2,$y2);
defined $got_min
or &$report ("rect_to_n_range($x1,$y1, $x2,$y2) got_min undef");
defined $got_max
or &$report ("rect_to_n_range($x1,$y1, $x2,$y2) got_max undef");
if ($got_max >= $got_min) {
$got_min >= $n_start
or $rect_before_n_start{$class}
or &$report ("rect_to_n_range() got_min=$got_min is before n_start=$n_start");
}
if (! defined $min || ! defined $max) {
if (! $rect_exact_hi{$class}) {
next; # outside
}
}
unless ($rect_exact{$class}
? $got_min == $want_min
: $got_min <= $want_min) {
### $x1
### $y1
### $x2
### $y2
### got: $path->rect_to_n_range ($x1,$y1, $x2,$y2)
### $want_min
### $want_max
### $got_min
### $got_max
### @col
### $data
&$report ("rect_to_n_range($x1,$y1, $x2,$y2) bad min got_min=$got_min want_min=$want_min".(defined $min ? '' : '[nomin]')
);
}
unless ($rect_exact_hi{$class}
? $got_max == $want_max
: $got_max >= $want_max) {
&$report ("rect_to_n_range($x1,$y1, $x2,$y2 ) bad max got $got_max want $want_max".(defined $max ? '' : '[nomax]'));
}
}
}
}
}
}
}
if ($path->can('xy_is_visited') != Math::PlanePath->can('xy_is_visited')) {
# MyTestHelpers::diag ("xy_is_visited() check ...");
foreach my $y ($y_min .. $y_max) {
foreach my $x ($x_min .. $x_max) {
my $got_visited = ($path->xy_is_visited($x,$y) ? 1 : 0);
my $want_visited = (defined($data->{$y}->{$x}) ? 1 : 0);
unless ($got_visited == $want_visited) {
&$report ("xy_is_visited($x,$y) got $got_visited want $want_visited");
}
}
}
}
}
my $is_a_tree;
{
my @n_children = $path->tree_n_children($n_start);
if (@n_children) {
$is_a_tree = 1;
}
}
my $num_children_minimum = $path->tree_num_children_minimum;
my $num_children_maximum = $path->tree_num_children_maximum;
($num_children_maximum >= $num_children_minimum)
or &$report ("tree_num_children_maximum() is ",$num_children_maximum,
"expect >= tree_num_children_minimum() is ",$num_children_minimum);
my @num_children_list = $path->tree_num_children_list;
my $num_children_list_str = join(',',@num_children_list);
my %num_children_hash;
@num_children_hash{@num_children_list} = (); # hash slice
@num_children_list >= 1
or &$report ("tree_num_children_list() is empty");
$num_children_list[0] == $num_children_minimum
or &$report ("tree_num_children_list() first != minimum");
$num_children_list[-1] == $num_children_maximum
or &$report ("tree_num_children_list() last != maximum");
join(',',sort {$a<=>$b} @num_children_list) eq $num_children_list_str
or &$report ("tree_num_children_list() not sorted");
# tree_any_leaf() is the same as tree_num_children_minimum()==0
my $any_leaf = $path->tree_any_leaf;
((!!$any_leaf) == ($num_children_minimum==0))
or &$report ("tree_any_leaf() is ",$any_leaf," but tree_num_children_minimum() is ",$num_children_minimum);
my $num_roots = $path->tree_num_roots;
if ($is_a_tree) {
$num_roots > 0
or &$report ("tree_num_roots() should be > 0, got ", $num_roots);
} else {
$num_roots == 0
or &$report ("tree_num_roots() should be 0 for non-tree, got ", $num_roots);
}
my @root_n_list = $path->tree_root_n_list;
my $root_n_list_str = join(',',@root_n_list);
scalar(@root_n_list) == $num_roots
or &$report ("tree_root_n_list() $root_n_list_str expected num_roots=$num_roots many values");
my %root_n_list;
foreach my $root_n (@root_n_list) {
if (exists $root_n_list{$root_n}) {
&$report ("tree_root_n_list() duplicate $root_n in list $root_n_list_str");
}
$root_n_list{$root_n} = 1;
}
### tree_n_root() of each ...
my $have_class_tree_n_root
= ($path->can('tree_n_root') != Math::PlanePath->can('tree_n_root'));
if ($have_class_tree_n_root) {
MyTestHelpers::diag ("tree_n_root() specific implementation ...");
}
foreach my $n ($n_start .. $n_start+$limit) {
my $root_n = $path->tree_n_root($n);
if ($is_a_tree) {
if (! defined $root_n || ! $root_n_list{$root_n}) {
&$report ("tree_n_root($n) got ",$root_n," is not a root ($root_n_list_str)");
}
if ($have_class_tree_n_root) {
my $root_n_by_search = $path->Math::PlanePath::tree_n_root($n);
$root_n == $root_n_by_search
or &$report ("tree_n_root($n) got ",$root_n," but by search is ",$root_n_by_search);
}
} else {
if (defined $root_n) {
&$report ("tree_n_root($n) got ",$root_n," expected undef for non-tree");
}
}
}
### tree_n_children before n_start ...
foreach my $n ($n_start-5 .. $n_start-1) {
{
my @n_children = $path->tree_n_children($n);
(@n_children == 0)
or &$report ("tree_n_children($n) before n_start=$n_start unexpectedly got ",scalar(@n_children)," values:",@n_children);
}
{
my $num_children = $path->tree_n_num_children($n);
if (defined $num_children) {
&$report ("tree_n_num_children($n) before n_start=$n_start unexpectedly $num_children not undef");
}
}
}
### tree_n_parent() before n_start ...
foreach my $n ($n_start-5 .. $n_start) {
my $n_parent = $path->tree_n_parent($n);
if (defined $n_parent) {
&$report ("tree_n_parent($n) <= n_start=$n_start unexpectedly got parent ",$n_parent);
}
}
### tree_n_children() look at tree_n_parent of each ...
{
my %unseen_num_children = %num_children_hash;
foreach my $n ($n_start .. $n_start+$limit,
($path->isa('Math::PlanePath::OneOfEight')
? (37, # first with 2 children in parts=4
58) # first with 3 children in parts=4
: ())) {
### $n
my @n_children = $path->tree_n_children($n);
### @n_children
my $num_children = scalar(@n_children);
exists $num_children_hash{$num_children}
or &$report ("tree_n_children($n)=$num_children not in tree_num_children_list()=$num_children_list_str");
delete $unseen_num_children{$num_children};
foreach my $n_child (@n_children) {
my $got_n_parent = $path->tree_n_parent($n_child);
($got_n_parent == $n)
or &$report ("tree_n_parent($n_child) got $got_n_parent want $n");
}
}
if (%unseen_num_children) {
&$report ("tree_num_children_list() values not seen: ",
join(',',sort {$a<=>$b} keys %unseen_num_children),
" of total=$num_children_list_str");
}
}
### tree_n_to_depth() before n_start ...
foreach my $n ($n_start-5 .. $n_start-1) {
my $depth = $path->tree_n_to_depth($n);
if (defined $depth) {
&$report ("tree_n_to_depth($n) < n_start=$n_start unexpectedly got depth ",$depth);
}
}
my @depth_to_width_by_count;
my @depth_to_n_seen;
my @depth_to_n_end_seen;
if ($path->can('tree_n_to_depth')
!= Math::PlanePath->can('tree_n_to_depth')) {
### tree_n_to_depth() vs count up by parents ...
# MyTestHelpers::diag ($mod, ' tree_n_to_depth()');
foreach my $n ($n_start .. $n_start+$limit) {
my $want_depth = path_tree_n_to_depth_by_parents($path,$n);
my $got_depth = $path->tree_n_to_depth($n);
if (! defined $got_depth || ! defined $want_depth
|| $got_depth != $want_depth) {
&$report ("tree_n_to_depth($n) got ",$got_depth," want ",$want_depth);
}
if ($got_depth >= 0 && $got_depth <= $depth_limit) {
$depth_to_width_by_count[$got_depth]++;
if (! defined $depth_to_n_seen[$got_depth]) {
$depth_to_n_seen[$got_depth] = $n;
}
$depth_to_n_end_seen[$got_depth] = $n;
}
}
}
if ($path->can('tree_n_to_subheight')
!= Math::PlanePath->can('tree_n_to_subheight')) {
### tree_n_to_subheight() vs search downwards ...
# MyTestHelpers::diag ($mod, ' tree_n_to_subheight()');
foreach my $n ($n_start .. $n_start+$limit) {
my $want_height = path_tree_n_to_subheight_by_search($path,$n);
my $got_height = $path->tree_n_to_subheight($n);
if (! equal($got_height,$want_height)) {
&$report ("tree_n_to_subheight($n) got ",$got_height," want ",$want_height);
}
}
}
if ($path->can('_EXPERIMENTAL__tree_n_to_leafdist')
# != Math::PlanePath->can('_EXPERIMENTAL__tree_n_to_leafdist')
) {
### _EXPERIMENTAL__tree_n_to_leafdist() vs search downwards ...
# MyTestHelpers::diag ($mod, ' _EXPERIMENTAL__tree_n_to_leafdist()');
foreach my $n ($n_start .. $n_start+$limit) {
my $want_height = path_tree_n_to_leafdist_by_search($path,$n);
my $got_height = $path->_EXPERIMENTAL__tree_n_to_leafdist($n);
if (! equal($got_height,$want_height)) {
&$report ("_EXPERIMENTAL__tree_n_to_leafdist($n) got ",$got_height," want ",$want_height);
}
}
}
### tree_depth_to_n() on depth<0 ...
foreach my $depth (-2 .. -1) {
foreach my $method ('tree_depth_to_n','tree_depth_to_n_end') {
my $n = $path->$method($depth);
if (defined $n) {
&$report ("$method($depth) unexpectedly got n=",$n);
}
}
{
my @ret = $path->tree_depth_to_n_range($depth);
scalar(@ret) == 0
or &$report ("tree_depth_to_n_range($depth) not an empty return");
}
}
### tree_depth_to_n() ...
if ($is_a_tree) {
my $n_rows_are_contiguous = path_tree_n_rows_are_contiguous($path);
foreach my $depth (0 .. $depth_limit) {
my $n = $path->tree_depth_to_n($depth);
if (! defined $n) {
&$report ("tree_depth_to_n($depth) should not be undef");
next;
}
if ($n != int($n)) {
&$report ("tree_depth_to_n($depth) not an integer: ",$n);
next;
}
if ($n <= $limit) {
my $want_n = $depth_to_n_seen[$depth];
if (! defined $want_n || $n != $want_n) {
&$report ("tree_depth_to_n($depth)=$n but depth_to_n_seen[$depth]=",$want_n);
}
}
my $n_end = $path->tree_depth_to_n_end($depth);
$n_end >= $n
or &$report ("tree_depth_to_n_end($depth) $n_end less than tree_depth_to_n() start $n");
my ($n_range_lo, $n_range_hi) = $path->tree_depth_to_n_range($depth);
$n_range_lo == $n
or &$report ("tree_depth_to_n_range($depth) $n_range_lo != tree_depth_to_n() start $n");
$n_range_hi == $n_end
or &$report ("tree_depth_to_n_range($depth) $n_range_hi != tree_depth_to_n_end() start $n_end");
{
my $got_depth = $path->tree_n_to_depth($n);
if (! defined $got_depth || $got_depth != $depth) {
&$report ("tree_depth_to_n($depth)=$n reverse got_depth=",$got_depth);
}
}
{
my $got_depth = $path->tree_n_to_depth($n-1);
if (defined $got_depth && $got_depth >= $depth) {
&$report ("tree_depth_to_n($depth)=$n reverse of n-1 got_depth=",$got_depth);
}
}
{
my $got_depth = $path->tree_n_to_depth($n_end);
if (! defined $got_depth || $got_depth != $depth) {
&$report ("tree_depth_to_n_end($depth)=$n_end reverse n_end got_depth=",$got_depth);
}
}
{
my $got_depth = $path->tree_n_to_depth($n_end+1);
if (defined $got_depth && $got_depth <= $depth) {
&$report ("tree_depth_to_n($depth)=$n reverse of n_end+1 got_depth=",$got_depth);
}
}
if ($n_end <= $limit) {
my $got_width = $path->tree_depth_to_width($depth);
my $want_width = $depth_to_width_by_count[$depth] || 0;
if ($got_width != $want_width) {
&$report ("tree_depth_to_width($depth)=$got_width but counting want=$want_width");
}
}
}
}
### done mod: $mod
}
ok ($good, 1);
}
#------------------------------------------------------------------------------
# path calculations
# Return true if the rows of the tree are numbered contiguously, so each row
# starts immediately following the previous with no overlapping.
sub path_tree_n_rows_are_contiguous {
my ($path) = @_;
foreach my $depth (0 .. 10) {
my $n_end = $path->tree_depth_to_n_end($depth);
my $n_next = $path->tree_depth_to_n($depth+1);
if ($n_next != $n_end+1) {
return 0;
}
}
return 1;
}
# Unused for now.
#
# sub path_tree_depth_to_width_by_count {
# my ($path, $depth) = @_;
# ### path_tree_depth_to_width_by_count(): $depth
# my $width = 0;
# my ($n_lo, $n_hi) = $path->tree_depth_to_n_range($depth);
# ### $n_lo
# ### $n_hi
# foreach my $n ($n_lo .. $n_hi) {
# ### d: $path->tree_n_to_depth($n)
# $width += ($path->tree_n_to_depth($n) == $depth);
# }
# ### $width
# return $width;
# }
sub path_tree_n_to_depth_by_parents {
my ($path, $n) = @_;
if ($n < $path->n_start) {
return undef;
}
my $depth = 0;
for (;;) {
my $parent_n = $path->tree_n_parent($n);
last if ! defined $parent_n;
if ($parent_n >= $n) {
die "Oops, tree parent $parent_n >= child $n in ", ref $path;
}
$n = $parent_n;
$depth++;
}
return $depth;
}
# use Smart::Comments;
use constant SUBHEIGHT_SEARCH_LIMIT => 50;
sub path_tree_n_to_subheight_by_search {
my ($path, $n, $limit) = @_;
if ($path->isa('Math::PlanePath::HTree') && is_pow2($n)) {
return undef; # infinite
}
if (! defined $limit) { $limit = SUBHEIGHT_SEARCH_LIMIT; }
if ($limit <= 0) {
return undef; # presumed infinite
}
if (! exists $path->{'path_tree_n_to_subheight_by_search__cache'}->{$n}) {
my @children = $path->tree_n_children($n);
my $height = 0;
foreach my $n_child (@children) {
my $h = path_tree_n_to_subheight_by_search($path,$n_child,$limit-1);
if (! defined $h) {
$height = undef; # infinite
last;
}
$h++;
if ($h >= $height) {
$height = $h; # new bigger subheight among the children
}
}
### maximum is: $height
if (defined $height || $limit >= SUBHEIGHT_SEARCH_LIMIT*4/5) {
### set cache: "n=$n ".($height//'[undef]')
$path->{'path_tree_n_to_subheight_by_search__cache'}->{$n} = $height;
### cache: $path->{'path_tree_n_to_subheight_by_search__cache'}
}
}
### path_tree_n_to_subheight_by_search(): "n=$n"
return $path->{'path_tree_n_to_subheight_by_search__cache'}->{$n};
# my @n = ($n);
# my $height = 0;
# my @pending = ($n);
# for (;;) {
# my $n = pop @pending;
# @n = map {} @n
# or return $height;
#
# if (defined my $h = $path->{'path_tree_n_to_subheight_by_search__cache'}->{$n}) {
# return $height + $h;
# }
# @n = map {$path->tree_n_children($_)} @n
# or return $height;
# $height++;
# if (@n > 200 || $height > 200) {
# return undef; # presumed infinite
# }
# }
}
# no Smart::Comments;
sub path_tree_n_to_leafdist_by_search {
my ($path, $n, $limit) = @_;
if (! defined $limit) { $limit = SUBHEIGHT_SEARCH_LIMIT; }
### path_tree_n_to_leafdist_by_search(): "n=$n limit=$limit"
if ($limit <= 0) {
return undef; # presumed infinite
}
if (! exists $path->{'path_tree_n_to_leafdist_by_search__cache'}->{$n}) {
my @children = $path->tree_n_children($n);
my $leafdist = 0;
if (@children) {
my @min;
foreach my $child_n (@children) {
my $child_leafdist = path_tree_n_to_leafdist_by_search
($path, $child_n, List::Util::min(@min,$limit-1));
if (defined $child_leafdist) {
if ($child_leafdist == 0) {
# child is a leaf, distance to it is 1
@min = (1);
last;
}
push @min, $child_leafdist+1;
}
}
$leafdist = List::Util::min(@min);
### for: "n=$n min of ".join(',',@min)." children=".join(',',@children)." gives ",$leafdist
} else {
### for: "n=$n is a leaf node"
}
if (defined $leafdist || $limit >= SUBHEIGHT_SEARCH_LIMIT*4/5) {
$path->{'path_tree_n_to_leafdist_by_search__cache'}->{$n} = $leafdist;
}
}
### path_tree_n_to_leafdist_by_search(): "n=$n"
return $path->{'path_tree_n_to_leafdist_by_search__cache'}->{$n};
}
# no Smart::Comments;
#------------------------------------------------------------------------------
# generic
sub equal {
my ($x,$y) = @_;
return ((! defined $x && ! defined $y)
|| (defined $x && defined $y && $x == $y));
}
use POSIX 'fmod';
sub gcd {
my ($x,$y) = @_;
$x = abs($x);
$y = abs($y);
if (is_infinite($x)) { return $x; }
if (is_infinite($y)) { return $y; }
# hack to recognise 1/3 from KochSnowflakes
if ($x == 1 && $y == 1/3) {
return $y;
}
if ($x == 0) {
return $y;
}
if ($y > $x) {
$y = fmod($y,$x);
}
for (;;) {
### assert: $x >= 1
if ($y == 0) {
return $x; # gcd(x,0)=x
}
if ($y < 0.00001) {
return 0;
}
($x,$y) = ($y, fmod($x,$y));
}
}
sub is_pow2 {
my ($n) = @_;
my ($pow,$exp) = round_down_pow ($n, 2);
return ($n == $pow);
}
sub coderef_is_const {
my ($coderef) = @_;
# FIXME: is not quite right? Is XSUBANY present on ALIAS: xsubs too?
require B;
return defined(B::svref_2object(\&coderef_is_const)->XSUBANY);
}
CHECK {
# my $coderef_is_const_check = 1;
use constant coderef_is_const_check => 1;
coderef_is_const(\&coderef_is_const_check) or die;
}
use constant pi => atan2(1,0)*4;
# $a and $b are arrayrefs [$dx,$dy]
# Return an order +ve,0,-ve between them, first by angle then by length.
sub dxdy_cmp {
my ($a_dx,$a_dy, $b_dx,$b_dy) = @_;
return dxdy_cmp_angle($a_dx,$a_dy, $b_dx,$b_dy) || dxdy_cmp_length($a_dx,$a_dy, $b_dx,$b_dy) || 0;
}
sub dxdy_cmp_angle {
my ($a_dx,$a_dy, $b_dx,$b_dy) = @_;
my $a_angle = atan2($a_dy,$a_dx);
my $b_angle = atan2($b_dy,$b_dx);
if ($a_angle < 0) { $a_angle += 2*pi(); }
if ($b_angle < 0) { $b_angle += 2*pi(); }
return $a_angle <=> $b_angle;
}
sub dxdy_cmp_length {
my ($a_dx,$a_dy, $b_dx,$b_dy) = @_;
return ($a_dx**2 + $a_dy**2
<=> $b_dx**2 + $b_dy**2);
}
sub path_n_to_LSR {
my ($path, $n) = @_;
my ($prev_dx,$prev_dy) = $path->n_to_dxdy($n - $path->arms_count)
or return 98;
my ($dx,$dy) = $path->n_to_dxdy($n)
or return 99;
my $LSR = $dy*$prev_dx - $dx*$prev_dy;
if (abs($LSR) < 1e-10) { $LSR = 0; }
$LSR = ($LSR <=> 0); # 1,undef,-1
# print "path_n_to_LSR dxdy $prev_dx,$prev_dy then $dx,$dy is LSR=$LSR\n";
return $LSR;
}
exit 0;
Math-PlanePath-122/xt/0-Test-YAML-Meta.t 0000755 0001750 0001750 00000003455 12347217470 015240 0 ustar gg gg #!/usr/bin/perl -w
# 0-Test-YAML-Meta.t -- run Test::CPAN::Meta::YAML if available
# Copyright 2009, 2010, 2011, 2013, 2014 Kevin Ryde
# 0-Test-YAML-Meta.t is shared by several distributions.
#
# 0-Test-YAML-Meta.t is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# 0-Test-YAML-Meta.t is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
use 5.004;
use strict;
use Test::More;
my $meta_filename = 'META.yml';
unless (-e $meta_filename) {
plan skip_all => "$meta_filename doesn't exist -- assume this is a working directory not a dist";
}
plan tests => 3;
SKIP: {
eval { require CPAN::Meta::Validator; 1 }
or skip "due to CPAN::Meta::Validator not available -- $@";
eval { require YAML; 1 }
or skip "due to YAML module not available -- $@", 1;
diag "CPAN::Meta::Validator version ", CPAN::Meta::Validator->VERSION;
my $struct = YAML::LoadFile ($meta_filename);
my $cmv = CPAN::Meta::Validator->new($struct);
ok ($cmv->is_valid);
if (! $cmv->is_valid) {
diag "CPAN::Meta::Validator errors:";
foreach ($cmv->errors) { diag $_; }
}
}
{
# Test::CPAN::Meta::YAML version 0.15 for upper case "optional_features" names
#
eval 'use Test::CPAN::Meta::YAML 0.15; 1'
or plan skip_all => "due to Test::CPAN::Meta::YAML 0.15 not available -- $@";
Test::CPAN::Meta::YAML::meta_spec_ok('META.yml');
}
exit 0;
Math-PlanePath-122/xt/PixelRings-image.t 0000644 0001750 0001750 00000010613 12136177167 015677 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use Math::PlanePath::PixelRings;
my $test_count = (tests => 2)[1];
plan tests => $test_count;
if (! eval 'use Image::Base 1.09; 1') { # version 1.09 for ellipse fixes
MyTestHelpers::diag ('skip due to Image::Base 1.09 not available -- ',$@);
foreach (1 .. $test_count) {
skip ('due to no Image::Base 1.09', 1, 1);
}
exit 0;
}
# uncomment this to run the ### lines
#use Smart::Comments;
sub dump_coords {
my ($href) = @_;
my $x_min = 0;
my $y_min = 0;
foreach my $key (keys %$href) {
my ($x,$y) = split /,/, $key;
if ($x < $x_min) { $x_min = $x; }
if ($y < $y_min) { $y_min = $y; }
}
my @rows;
foreach my $key (keys %$href) {
my ($x,$y) = split /,/, $key;
$rows[$y-$y_min]->[$x-$x_min] = '*';
}
foreach my $row (reverse @rows) {
my $str = '';
if ($row) {
foreach my $char (@$row) {
if ($char) {
$str .= " $char";
} else {
$str .= " ";
}
}
}
MyTestHelpers::diag ($str);
}
}
my %image_coords;
my $offset = 100;
{
package MyImage;
use vars '@ISA';
@ISA = ('Image::Base');
sub new {
my $class = shift;
return bless {@_}, $class;
}
sub xy {
my ($self, $x, $y, $colour) = @_;
$x -= $offset;
$y -= $offset;
### image_coords: "$x,$y"
$image_coords{"$x,$y"} = 1;
}
}
#------------------------------------------------------------------------------
# _cumul_extend()
{
my $path = Math::PlanePath::PixelRings->new;
my $image = MyImage->new;
my $good = 1;
my $limit = 500;
foreach my $r (1 .. $limit) {
%image_coords = ();
$image->ellipse (-$r+$offset,-$r+$offset, $r+$offset,$r+$offset, 'white');
my $image_count = scalar(@{[keys %image_coords]});
Math::PlanePath::PixelRings::_cumul_extend($path);
my $got = $path->{'cumul'}->[$r+1];
my $want = $path->{'cumul'}->[$r] + $image_count;
if ($got != $want) {
$good = 0;
MyTestHelpers::diag ("_cumul_extend() r=$r wrong: want=$want got=$got");
}
}
ok ($good, 1, "_cumul_extend() to $limit");
}
#------------------------------------------------------------------------------
# coords
{
my $path = Math::PlanePath::PixelRings->new;
my $image = MyImage->new;
my $n = 1;
my $good = 1;
my $limit = 100;
foreach my $r (0 .. $limit) {
%image_coords = ();
$image->ellipse (-$r+$offset,-$r+$offset, $r+$offset,$r+$offset, 'white');
my $image_count = scalar(@{[keys %image_coords]});
### $image_count
### from n: $n
my %path_coords;
while ($image_count--) {
my ($x,$y) = $path->n_to_xy($n++);
# perl 5.6.0 through 5.6.2 ends up giving "-0" when stringizing (as of
# the code in PixelRings version 19), avoid that so the hash keys
# compare with "eq" successfully
$x = "$x";
$y = "$y";
if ($x eq '-0') { $x = '0'; }
if ($y eq '-0') { $y = '0'; }
### path_coords: "$x,$y"
$path_coords{"$x,$y"} = 1;
}
### %image_coords
### %path_coords
if (! eq_hash (\%path_coords, \%image_coords)) {
MyTestHelpers::diag ("Wrong coords at r=$r");
MyTestHelpers::diag ("image: ", join(',', sort keys %image_coords));
MyTestHelpers::diag ("path: ", join(',', sort keys %path_coords));
dump_coords (\%image_coords);
dump_coords (\%path_coords);
$good = 0;
}
}
ok ($good, 1, 'n_to_xy() compared to image->ellipse()');
}
sub eq_hash {
my ($x, $y) = @_;
foreach my $key (keys %$x) {
if (! exists $y->{$key}) {
return 0;
}
}
foreach my $key (keys %$y) {
if (! exists $x->{$key}) {
return 0;
}
}
return 1;
}
exit 0;
Math-PlanePath-122/xt/0-META-read.t 0000755 0001750 0001750 00000010715 12136177162 014330 0 ustar gg gg #!/usr/bin/perl -w
# 0-META-read.t -- check META.yml can be read by various YAML modules
# Copyright 2009, 2010, 2011, 2012, 2013 Kevin Ryde
# 0-META-read.t is shared among several distributions.
#
# 0-META-read.t is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# 0-META-read.t is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
use 5.005;
use strict;
use Test::More;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# When some of META.yml is generated by explicit text in Makefile.PL it can
# be easy to make a mistake in the syntax, or indentation, etc, so the idea
# here is to check it's readable from some of the YAML readers.
#
# The various readers differ in how strictly they look at the syntax.
# There's no attempt here to say one of them is best or tightest or
# whatever, just see that they all work.
#
# See 0-Test-YAML-Meta.t for Test::YAML::Meta which looks into field
# contents, as well as maybe the YAML formatting.
my $meta_filename;
# allow for ancient perl, maybe
eval { require FindBin; 1 } # new in 5.004
or plan skip_all => "FindBin not available -- $@";
eval { require File::Spec; 1 } # new in 5.005
or plan skip_all => "File::Spec not available -- $@";
diag "FindBin $FindBin::Bin";
$meta_filename = File::Spec->catfile
($FindBin::Bin, File::Spec->updir, 'META.yml');
-e $meta_filename
or plan skip_all => "$meta_filename doesn't exist -- assume this is a working directory not a dist";
plan tests => 5;
SKIP: {
eval { require YAML; 1 }
or skip "due to YAML module not available -- $@", 1;
my $ok = eval { YAML::LoadFile ($meta_filename); 1 }
or diag "YAML::LoadFile() error -- $@";
ok ($ok, "Read $meta_filename with YAML module");
}
# YAML 0.68 is in fact YAML::Old, or something weird -- don't think they can
# load together
#
# SKIP: {
# eval { require YAML::Old; 1 }
# or skip 'due to YAML::Old not available -- $@', 1;
#
# eval { YAML::Old::LoadFile ($meta_filename) };
# is ($@, '',
# "Read $meta_filename with YAML::Old");
# }
SKIP: {
eval { require YAML::Syck; 1 }
or skip "due to YAML::Syck not available -- $@", 1;
my $ok = eval { YAML::Syck::LoadFile ($meta_filename); 1 }
or diag "YAML::Syck::LoadFile() error -- $@";
ok ($ok, "Read $meta_filename with YAML::Syck");
}
SKIP: {
eval { require YAML::Tiny; 1 }
or skip "due to YAML::Tiny not available -- $@", 1;
my $ok = eval { YAML::Tiny->read ($meta_filename); 1 }
or diag "YAML::Tiny->read() error -- $@";
ok ($ok, "Read $meta_filename with YAML::Tiny");
}
SKIP: {
eval { require YAML::XS; 1 }
or skip "due to YAML::XS not available -- $@", 1;
my $ok = eval { YAML::XS::LoadFile ($meta_filename); 1 }
or diag "YAML::XS::LoadFile() error -- $@";
ok ($ok, "Read $meta_filename with YAML::XS");
}
# Parse::CPAN::Meta describes itself for use on "typical" META.yml, so not
# sure if demanding it works will more exercise its subset of yaml than the
# correctness of our META.yml. At any rate might like to know if it fails,
# so as to avoid tricky yaml for everyone's benefit, maybe.
#
SKIP: {
eval { require Parse::CPAN::Meta; 1 }
or skip "due to Parse::CPAN::Meta not available -- $@", 1;
my $ok = eval { Parse::CPAN::Meta::LoadFile ($meta_filename); 1 }
or diag "Parse::CPAN::Meta::LoadFile() error -- $@";
ok ($ok, "Read $meta_filename with Parse::CPAN::Meta::LoadFile");
}
# Data::YAML::Reader 0.06 doesn't like header "--- #YAML:1.0" with the #
# part produced by other YAML writers, so skip for now
#
# SKIP: {
# eval { require Data::YAML::Reader; 1 }
# or skip 'due to Data::YAML::Reader not available -- $@', 1;
#
# my $reader = Data::YAML::Reader->new;
# open my $fh, '<', $meta_filename
# or die "Cannot open $meta_filename";
# my $str = do { local $/=undef; <$fh> };
# close $fh or die;
#
# # if ($str !~ /\.\.\.$/) {
# # $str .= "...";
# # }
# my @lines = split /\n/, $str;
# push @lines, "...";
# use Data::Dumper;
# print Dumper(\@lines);
#
# # { local $,="\n"; print @lines,"\n"; }
exit 0;
Math-PlanePath-122/xt/ChanTree-slow.t 0000644 0001750 0001750 00000007170 12136177167 015212 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
plan tests => 22;;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use Math::PlanePath::CoprimeColumns;
*_coprime = \&Math::PlanePath::CoprimeColumns::_coprime;
use Math::PlanePath::GcdRationals;
*_gcd = \&Math::PlanePath::GcdRationals::_gcd;
# uncomment this to run the ### lines
#use Smart::Comments;
require Math::PlanePath::ChanTree;
#------------------------------------------------------------------------------
# n_to_xy() reversal
{
require Math::PlanePath::GcdRationals;
foreach my $k (3 .. 7) {
foreach my $reduced (0, 1) {
my $path = Math::PlanePath::ChanTree->new (k => $k,
reduced => $reduced);
foreach my $n ($path->n_start .. 500) {
my ($x,$y) = $path->n_to_xy($n);
my $rev = $path->xy_to_n($x,$y);
if (! defined $rev || $rev != $n) {
$rev = (defined $rev ? $rev : 'undef');
die "k=$k reduced=$reduced n_to_xy($n)=$x,$y but reverse xy_to_n($x,$y) is rev=$rev";
}
if ($reduced) {
my $gcd = Math::PlanePath::GcdRationals::_gcd($x,$y);
if ($gcd > 1) {
die "k=$k reduced=$reduced n_to_xy($n)=$x,$y common factor $gcd";
}
}
}
ok ($k, $k);
}
}
}
#------------------------------------------------------------------------------
# block of points
eval 'use Math::BigInt try=>q{GMP}; 1'
|| eval 'use Math::BigInt; 1'
|| die;
{
my $size = 100;
foreach my $k (2 .. 7) {
foreach my $reduced (0, 1) {
my $path = Math::PlanePath::ChanTree->new (k => $k,
reduced => $reduced);
my %seen_n;
foreach my $x (1 .. $size) {
foreach my $y (1 .. $size) {
my $n = $path->xy_to_n(Math::BigInt->new($x),
Math::BigInt->new($y));
if ($reduced) {
if (is_reduced_xy($k,$x,$y)) {
if (! defined $n) {
die "k=$k reduced=$reduced xy_to_n($x,$y) is reduced point but n=undef";
}
} else {
if (defined $n) {
my $gcd = Math::PlanePath::GcdRationals::_gcd($x,$y);
die "k=$k reduced=$reduced xy_to_n($x,$y) is not reduced point (gcd=$gcd) but still have n=$n";
}
}
}
if (defined $n) {
if ($seen_n{$n}) {
die "k=$k xy_to_n($x,$y) is n=$n, but previously xy_to_n($seen_n{$n}) was n=$n";
}
$seen_n{$n} = "$x,$y";
}
}
}
ok ($k, $k);
}
}
}
sub is_reduced_xy {
my ($k, $x, $y) = @_;
if (! _coprime($x,$y)) {
return 0;
}
if (($k & 1) && is_both_odd($x,$y)) {
return 0;
}
return 1;
}
sub is_both_odd {
my ($x, $y) = @_;
return ($x % 2) && ($y % 2);
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/ 0002755 0001750 0001750 00000000000 12641645163 013330 5 ustar gg gg Math-PlanePath-122/xt/slow/TerdragonCurve-slow.t 0000644 0001750 0001750 00000032650 12451351065 017427 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 339;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use lib 'xt';
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments;
use Memoize;
use Math::PlanePath::TerdragonCurve;
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh','round_down_pow';
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
#------------------------------------------------------------------------------
# left boundary samples
{
my $path = Math::PlanePath::TerdragonCurve->new;
# examples in terdragon paper
ok ($path->_UNDOCUMENTED__left_boundary_i_to_n(8),
50);
ok (!! $path->_UNDOCUMENTED__n_segment_is_left_boundary(0,0), 1);
ok (!! $path->_UNDOCUMENTED__n_segment_is_left_boundary(0,1), 1);
ok (!! $path->_UNDOCUMENTED__n_segment_is_left_boundary(0,-1), 1);
ok (!! $path->_UNDOCUMENTED__n_segment_is_left_boundary(2,0), '');
ok (!! $path->_UNDOCUMENTED__n_segment_is_left_boundary(2,1), 1);
ok (!! $path->_UNDOCUMENTED__n_segment_is_left_boundary(2,-1), 1);
}
#------------------------------------------------------------------------------
# left boundary infinite data
my @left_infinite = (0, 1, 5, 15, 16, 17, 45, 46, 50, 51, 52, 53);
my %left_infinite = map {$_=>1} @left_infinite;
{
my $path = Math::PlanePath::TerdragonCurve->new;
my $bad = 0;
foreach my $n (0 .. $left_infinite[-1]) {
my $want = $left_infinite{$n} ? 1 : 0;
foreach my $method ('_UNDOCUMENTED__n_segment_is_left_boundary',
sub {
my ($path, $n) = @_;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
return path_triangular_xyxy_is_left_boundary
($path, $x1,$y1, $x2,$y2);
}) {
my $got = $path->$method($n) ? 1 : 0;
if ($got != $want) {
MyTestHelpers::diag("oops, $method n=$n want=$want got=$got");
die;
last if $bad++ > 10;
}
}
}
ok ($bad, 0);
}
{
my $path = Math::PlanePath::TerdragonCurve->new;
foreach my $i (0 .. $#left_infinite) {
my $want = $left_infinite[$i];
my $got = $path->_UNDOCUMENTED__left_boundary_i_to_n($i);
ok ($got, $want,
"i=$i want=$want got=$got");
}
}
#------------------------------------------------------------------------------
# left boundary levels data
my @left_levels = ([0],
[0,1,2],
[0,1, 5,6,7,8],
[0,1,5, 15,16,17,18,19,23,24,25,26]);
my @left_levels_hash = map { my $h = {map {$_=>1} @$_};
$h } @left_levels;
{
my $path = Math::PlanePath::TerdragonCurve->new;
foreach my $level (0 .. $#left_levels) {
my $hash = $left_levels_hash[$level];
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
foreach my $n ($n_lo .. $n_hi-1) {
my $want = $hash->{$n} ? 1 : 0;
foreach my $method ('_UNDOCUMENTED__n_segment_is_left_boundary',
sub {
my ($path, $n, $level) = @_;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
return path_triangular_xyxy_is_left_boundary
($path, $x1,$y1, $x2,$y2, $level);
}) {
my $got = $path->$method($n,$level) ? 1 : 0;
ok ($got, $want,
"level=$level $method n=$n want=$want got=$got");
}
}
my $aref = $left_levels[$level];
foreach my $i (0 .. $#$aref) {
my $want = $aref->[$i];
my $got = $path->_UNDOCUMENTED__left_boundary_i_to_n($i,$level);
ok ($got, $want,
"i=$i want=$want got=".(defined $got ? $got : '[undef]'));
}
}
}
my %left_all_hash = map {map {$_=>1} @$_} @left_levels;
my @left_all = sort {$a<=>$b} keys %left_all_hash;
{
my $path = Math::PlanePath::TerdragonCurve->new;
foreach my $n (0 .. max(keys %left_all_hash)) {
my $want = $left_all_hash{$n} ? 1 : 0;
foreach my $method ('_UNDOCUMENTED__n_segment_is_left_boundary',
sub {
my ($path, $n, $level) = @_;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
return path_triangular_xyxy_is_left_boundary
($path, $x1,$y1, $x2,$y2, $level);
}) {
my $got = $path->$method($n,-1) ? 1 : 0;
ok ($got, $want,
"all $method n=$n want=$want got=$got");
}
}
# NOT WORKING YET
# foreach my $i (0 .. $#left_all) {
# my $want = $left_all[$i];
# my $got = $path->_UNDOCUMENTED__left_boundary_i_to_n($i,-1);
# ok ($got, $want,
# "i=$i want=$want got=".(defined $got ? $got : '[undef]'));
# }
}
#------------------------------------------------------------------------------
# left boundary vs xyxy func
{
my $path = Math::PlanePath::TerdragonCurve->new;
my $bad = 0;
OUTER: foreach my $level (-1,
0 .. 6,
undef) {
my $name = (! defined $level ? 'infinite'
: $level < 0 ? 'all'
: "level=$level");
my $i = 0;
my $ni = $path->_UNDOCUMENTED__left_boundary_i_to_n($i);
foreach my $n (0 .. 3**6-1) {
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
my $want_pred = path_triangular_xyxy_is_left_boundary($path, $x1,$y1, $x2,$y2, $level) ? 1 : 0;
my $got_pred = $path->_UNDOCUMENTED__n_segment_is_left_boundary($n,$level) ? 1 : 0;
if ($want_pred != $got_pred) {
MyTestHelpers::diag("oops, $name n=$n pred want $want_pred got $got_pred");
last if $bad++ > 10;
}
my $got_ni = (defined $ni && $n == $ni ? 1 : 0);
if ($got_ni != $want_pred) {
MyTestHelpers::diag("oops, $name n=$n ni=".(defined $ni ? $ni : '[undef]')." want_pred=$want_pred");
last OUTER if $bad++ > 10;
}
if (defined $ni && $n >= $ni) {
$i++;
$ni = $path->_UNDOCUMENTED__left_boundary_i_to_n($i, $level);
}
}
}
ok ($bad, 0);
}
# return true if line segment $x1,$y1 to $x2,$y2 is on the left boundary
# of triangular path $path
# use Smart::Comments;
sub path_triangular_xyxy_is_left_boundary {
my ($path, $x1,$y1, $x2,$y2, $level) = @_;
### path_triangular_xyxy_is_left_boundary(): "$x1,$y1 to $x2,$y2"
my $n = $path->xyxy_to_n ($x1,$y1, $x2,$y2);
my $n_hi;
if (defined $level) {
if ($level < 0) {
($n_hi) = round_down_pow($n,3);
$n_hi *= 3;
} else {
$n_hi = 3**$level;
if ($n >= $n_hi) {
### segment beyond level, so not boundary ...
return 0;
}
}
}
### $n_hi
my $dx = $x2-$x1;
my $dy = $y2-$y1;
my $x3 = $x1 + ($dx-3*$dy)/2; # dx,dy rotate +60
my $y3 = $y1 + ($dy+$dx)/2;
### points: "left side $x3,$y2"
foreach my $n1 ($path->xyxy_to_n_either ($x1,$y1, $x3,$y3),
$path->xyxy_to_n_either ($x2,$y2, $x3,$y3)) {
### $n1
if (! defined $n1) {
### never traversed, so boundary ...
return 1;
}
if ($n_hi && $n1 >= $n_hi) {
### traversed beyond our target level, so boundary ...
return 1;
}
}
return 0;
}
#------------------------------------------------------------------------------
# right boundary N
{
my $path = Math::PlanePath::TerdragonCurve->new;
my $i = 0;
my $ni = $path->_UNDOCUMENTED__right_boundary_i_to_n($i);
foreach my $n (0 .. 3**4-1) {
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
my $want_pred = path_triangular_xyxy_is_right_boundary($path, $x1,$y1, $x2,$y2) ? 1 : 0;
my $got_pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n) ? 1 : 0;
ok ($want_pred, $got_pred, "n=$n pred want $want_pred got $got_pred");
ok (($n == $ni) == $want_pred, 1);
if ($n >= $ni) {
$i++;
$ni = $path->_UNDOCUMENTED__right_boundary_i_to_n($i);
}
}
}
# return true if line segment $x1,$y1 to $x2,$y2 is on the right boundary
# of triangular path $path
sub path_triangular_xyxy_is_right_boundary {
my ($path, $x1,$y1, $x2,$y2) = @_;
my $dx = $x2-$x1;
my $dy = $y2-$y1;
my $x3 = $x1 + ($dx+3*$dy)/2; # dx,dy rotate -60 so right
my $y3 = $y1 + ($dy-$dx)/2;
### path_triangular_xyxy_is_right_boundary(): "$x1,$y1 $x2,$y2 $x3,$y3"
return (! defined ($path->xyxy_to_n_either ($x1,$y1, $x3,$y3))
|| ! defined ($path->xyxy_to_n_either ($x2,$y2, $x3,$y3)));
}
# MyOEIS triangular boundary bits broken
exit 0;
#------------------------------------------------------------------------------
# B
my $path = Math::PlanePath::TerdragonCurve->new;
{
# samples values from terdragon.tex
my @want = (2, 6, 12, 24, 48, 96);
foreach my $k (0 .. $#want) {
my $got = B_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# B[k+1] = R[k] + U[k]
foreach my $k (0 .. 5) {
my $r = R_from_path($path,$k);
my $u = U_from_path($path,$k);
my $b = B_from_path($path,$k+1);
ok ($r+$u, $b, "k=$k R+U=B");
}
}
{
# B[k] = 2, 3*2^k
foreach my $k (0 .. 10) {
my $want = b_from_path($path,$k);
my $got = B_from_formula($k);
ok ($got,$want);
}
sub B_from_formula {
my ($k) = @_;
return ($k==0 ? 2 : 3*2**$k);
}
}
#------------------------------------------------------------------------------
# R
{
# R[k] = B[k]/2
my $sum = 1;
foreach my $k (0 .. 8) {
my $b = B_from_path($path,$k);
my $r = R_from_path($path,$k);
ok ($r,$b/2);
}
}
{
# samples from terdragon.tex
my @want = (1, 3, 6, 12, 24, 48);
foreach my $k (0 .. $#want) {
my $got = R_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# R[k+1] = R[k] + U[k]
foreach my $k (1 .. 8) {
my $r0 = R_from_path($path,$k);
my $r1 = R_from_path($path,$k+1);
my $u = R_from_path($path,$k);
ok ($r0+$u, $r1);
}
}
#------------------------------------------------------------------------------
# Area
{
# A[k] = (2*3^k - B[k])/4
foreach my $k (0 .. 8) {
my $b = B_from_path($path,$k);
my $got = (2*3**$k - $b)/4;
my $want = A_from_path($path,$k);
ok ($got,$want);
}
}
{
# A[k] = if(k==0,0, 2*(3^(k-1)-2^(k-1)))
foreach my $k (0 .. 8) {
my $got = A_from_formula($k);
my $want = A_from_path($path,$k);
ok ($got,$want);
}
sub A_from_formula {
my ($k) = @_;
return ($k==0 ? 0 : 2*(3**($k-1) - 2**($k-1)));
}
}
#------------------------------------------------------------------------------
# boundary lengths
sub B_from_path {
my ($path, $k) = @_;
my $n_limit = 3**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit,
lattice_type => 'triangular');
return scalar(@$points);
}
BEGIN { memoize('B_from_path') }
sub L_from_path {
my ($path, $k) = @_;
my $n_limit = 3**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit,
lattice_type => 'triangular',
side => 'left');
return scalar(@$points) - 1;
}
BEGIN { memoize('L_from_path') }
sub R_from_path {
my ($path, $k) = @_;
my $n_limit = 3**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit,
lattice_type => 'triangular',
side => 'right');
return scalar(@$points) - 1;
}
BEGIN { memoize('R_from_path') }
sub U_from_path {
my ($path, $k) = @_;
my $n_limit = 3**$k;
my ($x,$y) = $path->n_to_xy($n_limit);
my ($to_x,$to_y) = $path->n_to_xy(0);
my $points = MyOEIS::path_boundary_points_ft($path, 3*$n_limit,
$x,$y, $to_x,$to_y,
lattice_type => 'triangular',
dir => 1);
return scalar(@$points) - 1;
}
BEGIN { memoize('U_from_path') }
sub A_from_path {
my ($path, $k) = @_;
return MyOEIS::path_enclosed_area($path, 3**$k,
lattice_type => 'triangular');
}
BEGIN { memoize('A_from_path') }
#------------------------------------------------------------------------------
# U
{
# samples from terdragon.tex
my @want = (2, 3, 6, 12, 24, 48);
foreach my $k (0 .. $#want) {
my $got = U_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# U[k+1] = R[k] + U[k]
foreach my $k (0 .. 10) {
my $u = U_from_path($path,$k);
my $r = R_from_path($path,$k);
my $got = $r + $u;
my $want = U_from_path($path,$k+1);
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/R5DragonCurve-slow.t 0000644 0001750 0001750 00000035636 12451431730 017130 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 218;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use lib 'xt';
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments;
use Memoize;
use Math::PlanePath::R5DragonCurve;
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh';
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
#------------------------------------------------------------------------------
# right boundary N
{
my $bad = 0;
foreach my $arms (1) {
my $path = Math::PlanePath::R5DragonCurve->new (arms => $arms);
my $i = 0;
foreach my $n (0 .. 5**5-1) {
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n + $arms);
my $want_pred = path_xyxy_is_right_boundary($path, $x1,$y1, $x2,$y2) ? 1 : 0;
foreach my $method
('_UNDOCUMENTED__n_segment_is_right_boundary',
'main::n_segment_is_right_boundary__by_digitpairs_allowed',
'main::n_segment_is_right_boundary__by_digitpairs_disallowed',
'main::n_segment_is_right_boundary_by_hightolow_states',
) {
my $got_pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n) ? 1 : 0;
unless ($want_pred == $got_pred) {
MyTestHelpers::diag ("oops, $method() arms=$arms n=$n pred traverse=$want_pred method=$got_pred");
last if $bad++ > 10;
}
}
}
}
ok ($bad, 0);
}
BEGIN {
my @table
= (undef,
[ 1, 1, 2, 3, 4 ], # R -> RRCDE
[ 1, 2 ], # C -> RC___
[undef, 3 ], # D -> _D___
[undef, 4, 2, 3, 4 ], # E -> _ECDE
);
sub n_segment_is_right_boundary_by_hightolow_states {
my ($self, $n) = @_;
my $state = 1;
foreach my $digit (reverse digit_split_lowtohigh($n,5)) { # high to low
$state = $table[$state][$digit] || return 0;
}
return 1;
}
}
BEGIN {
my @allowed_pairs
= ([ 1, '', 1, 1, 1 ], # 00, __, 02, 03, 04 0s all allowed
'', # 1s deleted
[ 1, '', 0, 0, 0 ], # 20, __, __, __, __
[ 0, '', 0, 0, 0 ], # __, __, __, __, __ 3s none allowed
[ 0, '', 1, 1, 1 ], # __, __, 42, 43, 44
);
my @disallowed_pairs
= ([ 0, '', 0, 0, 0 ], # __, __, __, __, __ 0s none disallowed
'', # 1s deleted
[ 0, '', 1, 1, 1 ], # __, __, 22, 23, 24
[ 1, '', 1, 1, 1 ], # 30, __, 32, 33, 34 3s all disallowed
[ 1, '', 0, 0, 0 ], # 40, __, __, __, __
);
sub n_segment_is_right_boundary__by_digitpairs_disallowed {
my ($self, $n) = @_;
### n_segment_is_right_boundary__by_digitpairs(): "n=$n"
my $prev = 0;
if (_divrem_mutate($n, $self->{'arms'})) {
# FIXME: is this right ?
$prev = 4;
}
foreach my $digit (reverse digit_split_lowtohigh($n,5)) { # high to low
next if $digit == 1;
### pair: "$prev $digit table=".($table[$prev][$digit] || 0)
if ($disallowed_pairs[$prev][$digit]) {
### no ...
return 0;
}
$prev = $digit;
}
### yes ...
return 1;
}
sub n_segment_is_right_boundary__by_digitpairs_allowed {
my ($self, $n) = @_;
### n_segment_is_right_boundary__by_digitpairs(): "n=$n"
my $prev = 0;
if (_divrem_mutate($n, $self->{'arms'})) {
# FIXME: is this right ?
$prev = 4;
}
foreach my $digit (reverse digit_split_lowtohigh($n,5)) { # high to low
next if $digit == 1;
### pair: "$prev $digit table=".($table[$prev][$digit] || 0)
if (! $allowed_pairs[$prev][$digit]) {
### no ...
return 0;
}
$prev = $digit;
}
### yes ...
return 1;
}
}
# return true if line segment $x1,$y1 to $x2,$y2 is on the right boundary
sub path_xyxy_is_right_boundary {
my ($path, $x1,$y1, $x2,$y2) = @_;
### path_xyxy_is_right_boundary() ...
my $dx = $x2-$x1;
my $dy = $y2-$y1;
($dx,$dy) = ($dy,-$dx); # rotate -90
### one: "$x1,$y1 to ".($x1+$dx).",".($y1+$dy)
### two: "$x2,$y2 to ".($x2+$dx).",".($y2+$dy)
return (! defined ($path->xyxy_to_n_either ($x1,$y1, $x1+$dx,$y1+$dy))
|| ! defined ($path->xyxy_to_n_either ($x2,$y2, $x2+$dx,$y2+$dy))
|| ! defined ($path->xyxy_to_n_either ($x1+$dx,$y1+$dy, $x2+$dx,$y2+$dy)));
}
#------------------------------------------------------------------------------
# left boundary N
{
my $bad = 0;
foreach my $arms (1) {
my $path = Math::PlanePath::R5DragonCurve->new (arms => $arms);
my $i = 0;
foreach my $level (0 .. 7) {
my ($n_start, $n_end) = $path->level_to_n_range($level);
foreach my $n ($n_start .. $n_end-1) {
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n + $arms);
my $want_pred = path_xyxy_is_left_boundary($path, $x1,$y1, $x2,$y2, $level) ? 1 : 0;
{
my $got_pred = $path->_UNDOCUMENTED__n_segment_is_left_boundary($n, $level) ? 1 : 0;
unless ($want_pred == $got_pred) {
MyTestHelpers::diag ("oops, _UNDOCUMENTED__n_segment_is_left_boundary() arms=$arms level=$level n=$n pred traverse=$want_pred method=$got_pred");
last if $bad++ > 10;
}
}
}
}
}
ok ($bad, 0);
exit 0;
}
{
my $bad = 0;
foreach my $arms (1) {
my $path = Math::PlanePath::R5DragonCurve->new (arms => $arms);
my $i = 0;
foreach my $n (0 .. 5**7-1) {
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n + $arms);
my $want_pred = path_xyxy_is_left_boundary($path, $x1,$y1, $x2,$y2) ? 1 : 0;
{
my $got_pred = $path->_UNDOCUMENTED__n_segment_is_left_boundary($n) ? 1 : 0;
unless ($want_pred == $got_pred) {
MyTestHelpers::diag ("oops, _UNDOCUMENTED__n_segment_is_left_boundary() arms=$arms n=$n pred traverse=$want_pred method=$got_pred");
last if $bad++ > 10;
}
}
# {
# my $got_pred = n_segment_is_left_boundary__by_digitpairs($path,$n) ? 1 : 0;
# unless ($want_pred == $got_pred) {
# MyTestHelpers::diag ("oops, n_segment_is_left_boundary__by_digitpairs() arms=$arms n=$n pred traverse=$want_pred method=$got_pred");
# last if $bad++ > 10;
# }
# }
# {
# my $got_pred = n_segment_is_left_boundary_by_hightolow_states($path,$n) ? 1 : 0;
# unless ($want_pred == $got_pred) {
# MyTestHelpers::diag ("n_segment_is_left_boundary_by_hightolow_states(), n_segment_is_left_boundary__by_digitpairs() arms=$arms n=$n pred traverse=$want_pred method=$got_pred");
# last if $bad++ > 10;
# }
# }
}
}
ok ($bad, 0);
}
BEGIN {
my @table
= (undef,
[ 1, 1, 2, 3, 4 ], # R -> RRCDE
[ 1, 2 ], # C -> RC___
[undef, 3 ], # D -> _D___
[undef, 4, 2, 3, 4 ], # E -> _ECDE
);
sub n_segment_is_left_boundary_by_hightolow_states {
my ($self, $n) = @_;
my $state = 1;
foreach my $digit (reverse digit_split_lowtohigh($n,5)) { # high to low
$state = $table[$state][$digit] || return 0;
}
return 1;
}
}
BEGIN {
my @table
= ([ 1, undef, 1, 1, 1 ], # 00, 02, 03, 04
undef,
[ 1 ], # 20
[ ], # 3 none
[ undef, undef, 1, 1, 1 ], # 4
);
sub n_segment_is_left_boundary__by_digitpairs {
my ($self, $n) = @_;
### n_segment_is_left_boundary__by_digitpairs(): "n=$n"
my $prev = 0;
{
my $arms = $self->{'arms'};
if (_divrem_mutate($n, $arms) != $arms-1) {
$prev = 1;
}
}
foreach my $digit (reverse digit_split_lowtohigh($n,5)) { # high to low
next if $digit == 1;
### pair: "$prev $digit table=".($table[$prev][$digit] || 0)
unless ($table[$prev][$digit]) {
### no ...
return 0;
}
$prev = $digit;
}
### yes ...
return 1;
}
}
# return true if line segment $x1,$y1 to $x2,$y2 is on the left boundary
sub path_xyxy_is_left_boundary {
my ($path, $x1,$y1, $x2,$y2, $level) = @_;
### path_xyxy_is_left_boundary() ...
my $dx = $x2-$x1;
my $dy = $y2-$y1;
($dx,$dy) = (-$dy,$dx); # rotate +90
### one: "$x1,$y1 to ".($x1+$dx).",".($y1+$dy)
### two: "$x2,$y2 to ".($x2+$dx).",".($y2+$dy)
return (! path_xyxy_is_traversed_in_level ($path, $x1,$y1, $x1+$dx,$y1+$dy, $level)
|| ! path_xyxy_is_traversed_in_level ($path, $x2,$y2, $x2+$dx,$y2+$dy, $level)
|| ! path_xyxy_is_traversed_in_level ($path, $x1+$dx,$y1+$dy, $x2+$dx,$y2+$dy, $level));
}
# return true if line segment $x1,$y1 to $x2,$y2 is traversed,
# ie. consecutive N goes from $x1,$y1 to $x2,$y2, in either direction.
sub path_xyxy_is_traversed_in_level {
my ($path, $x1,$y1, $x2,$y2, $level) = @_;
### path_xyxy_is_traversed_in_level(): "$x1,$y1, $x2,$y2"
my $arms = $path->arms_count;
my $n_limit;
if (defined $level) { $n_limit = 5**$level; }
foreach my $n1 ($path->xy_to_n_list($x1,$y1)) {
next if defined $n_limit && $n1 >= $n_limit;
foreach my $n2 ($path->xy_to_n_list($x2,$y2)) {
next if defined $n_limit && $n2 >= $n_limit;
if (abs($n1-$n2) == $arms) {
### yes: "$n1 to $n2"
return 1;
}
}
}
### no ...
return 0;
}
my $path = Math::PlanePath::R5DragonCurve->new;
#------------------------------------------------------------------------------
# B
{
# POD samples
my @want = (2, 10, 34, 106, 322, 970, 2914);
foreach my $k (0 .. $#want) {
my $got = B_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# B[k] = 4*R[k] + 2*U[k]
foreach my $k (0 .. 10) {
my $r = R_from_path($path,$k);
my $u = U_from_path($path,$k);
my $b = B_from_path($path,$k+1);
ok (4*$r+2*$u,$b);
}
}
{
# B[k+2] = 4*B[k+1] - 3*B[k]
foreach my $k (0 .. 10) {
my $b0 = B_from_path($path,$k);
my $b1 = B_from_path($path,$k+1);
my $got = 4*$b1 - 3*$b0;
my $want = B_from_path($path,$k+2);
ok ($got,$want);
}
}
{
# B[k] = 4*3^k - 2
foreach my $k (0 .. 10) {
my $want = b_from_path($path,$k);
my $got = 4*3**$k - 2;
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
# R
{
# R[k] = B[k]/2
my $sum = 1;
foreach my $k (0 .. 8) {
my $b = B_from_path($path,$k);
my $r = R_from_path($path,$k);
ok ($r,$b/2);
}
}
{
# POD samples
my @want = (1,5,17,53);
foreach my $k (0 .. $#want) {
my $got = R_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# R[k+1] = 2*R[k] + U[k]
foreach my $k (1 .. 8) {
my $r0 = R_from_path($path,$k);
my $r1 = R_from_path($path,$k+1);
my $u = R_from_path($path,$k);
ok (2*$r0+$u, $r1);
}
}
#------------------------------------------------------------------------------
# Area
sub A_recurrence {
my ($k) = @_;
if ($k <= 0) { return 0; }
if ($k == 1) { return 0; }
if ($k == 2) { return 4; }
if ($k == 3) { return 36; }
return (9*A_recurrence($k-1)
- 23*A_recurrence($k-2)
+ 15*A_recurrence($k-3));
}
BEGIN { memoize('A_recurrence') }
{
# A[k] = (2*5^k - B[k])/4
foreach my $k (0 .. 8) {
my $b = B_from_path($path,$k);
### $b
my $got = (2*5**$k - $b)/4;
my $want = A_from_path($path,$k);
ok ($got,$want);
}
}
{
# A[k] recurrence
foreach my $k (0 .. 8) {
my $n_limit = 5**$k;
my $got = A_recurrence($k);
my $want = A_from_path($path,$k);
ok ($got,$want, "k=$k");
}
}
{
# A[k] = (5^k - 2*3^k + 1)/2
foreach my $k (0 .. 8) {
my $got = (5**$k - 2*3**$k + 1)/2;
my $want = A_from_path($path,$k);
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
# boundary lengths
sub B_from_path {
my ($path, $k) = @_;
my $n_limit = 5**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit);
return scalar(@$points);
}
BEGIN { memoize('B_from_path') }
sub L_from_path {
my ($path, $k) = @_;
my $n_limit = 5**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'left');
return scalar(@$points) - 1;
}
BEGIN { memoize('L_from_path') }
sub R_from_path {
my ($path, $k) = @_;
my $n_limit = 5**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'right');
return scalar(@$points) - 1;
}
BEGIN { memoize('R_from_path') }
sub U_from_path {
my ($path, $k) = @_;
my $n_limit = 5**$k;
my ($x,$y) = $path->n_to_xy(3*$n_limit);
my ($to_x,$to_y) = $path->n_to_xy(0);
my $points = MyOEIS::path_boundary_points_ft($path, 5*$n_limit,
$x,$y, $to_x,$to_y,
dir => 1);
return scalar(@$points) - 1;
}
BEGIN { memoize('U_from_path') }
sub A_from_path {
my ($path, $k) = @_;
return MyOEIS::path_enclosed_area($path, 5**$k);
}
BEGIN { memoize('A_from_path') }
# #------------------------------------------------------------------------------
# # U
#
# {
# # POD samples
# my @want = (3, 6, 8, 12, 20, 32, 52, 88, 148, 248, 420, 712, 1204, 2040);
# foreach my $k (0 .. $#want) {
# my $got = U_from_path($path,$k);
# my $want = $want[$k];
# ok ($got,$want);
# }
# }
# {
# # U[k+1] = U[k] + V[k]
#
# foreach my $k (0 .. 10) {
# my $u = U_from_path($path,$k);
# my $v = V_from_path($path,$k);
# my $got = $u + $v;
# my $want = U_from_path($path,$k+1);
# ok ($got,$want);
# }
# }
# {
# # U[k+1] = U[k] + L[k] k>=1
# foreach my $k (1 .. 10) {
# my $u = U_from_path($path,$k);
# my $l = L_from_path($path,$k);
# my $got = $u + $l;
# my $want = U_from_path($path,$k+1);
# ok ($got,$want);
# }
# }
# {
# # U[k+4] = 2*U[k+3] - U[k+2] + 2*U[k+1] - 2*U[k] for k >= 1
#
# foreach my $k (1 .. 10) {
# my $u0 = U_from_path($path,$k);
# my $u1 = U_from_path($path,$k+1);
# my $u2 = U_from_path($path,$k+2);
# my $u3 = U_from_path($path,$k+3);
# my $got = 2*$u3 - $u2 + 2*$u1 - 2*$u0;
# my $want = U_from_path($path,$k+4);
# ok ($got,$want);
# }
# }
# {
# # U[k] = L[k+2] - R[k]
# foreach my $k (0 .. 10) {
# my $l = L_from_path($path,$k+2);
# my $r = R_from_path($path,$k);
# my $got = $l - $r;
# my $want = U_from_path($path,$k);
# ok ($got,$want);
# }
# }
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/ComplexMinus-slow.t 0000644 0001750 0001750 00000005463 12302552226 017117 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 218;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use lib 'xt';
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments;
use Math::PlanePath::ComplexMinus;
#------------------------------------------------------------------------------
# figure boundary
{
# _UNDOCUMENTED_level_to_figure_boundary()
foreach my $realpart (1 .. 10) {
my $path = Math::PlanePath::ComplexMinus->new (realpart => $realpart);
my $norm = $realpart*$realpart + 1;
foreach my $level (0 .. 14) {
my $n_level_end = $norm**$level - 1;
last if $n_level_end > 10_000;
my $got = $path->_UNDOCUMENTED_level_to_figure_boundary($level);
my $want = path_n_to_figure_boundary($path, $n_level_end);
ok ($got, $want, "_UNDOCUMENTED_level_to_figure_boundary() realpart=$realpart level=$level n_level_end=$n_level_end");
### $got
### $want
}
}
}
# Return the boundary of unit squares at Nstart to N inclusive.
sub path_n_to_figure_boundary {
my ($path, $n) = @_;
### path_n_to_figure_boundary(): $n
my $boundary = 4;
foreach my $n ($path->n_start() .. $n-1) {
### "n=$n dboundary=".(path_n_to_dboundary($path,$n))
$boundary += path_n_to_dboundary($path,$n);
}
return $boundary;
}
BEGIN {
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
# return the change in figure boundary from N to N+1
sub path_n_to_dboundary {
my ($path, $n) = @_;
$n += 1;
my ($x,$y) = $path->n_to_xy($n) or do {
if ($n == $path->n_start - 1) {
return 4;
} else {
return undef;
}
};
### N+1 at: "n=$n xy=$x,$y"
my $dboundary = 4;
foreach my $i (0 .. $#dir4_to_dx) {
my $an = $path->xy_to_n($x+$dir4_to_dx[$i], $y+$dir4_to_dy[$i]);
### consider: "xy=".($x+$dir4_to_dx[$i]).",".($y+$dir4_to_dy[$i])." is an=".($an||'false')
$dboundary -= 2*(defined $an && $an < $n);
}
### $dboundary
return $dboundary;
}
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/DragonCurve-slow.t 0000644 0001750 0001750 00000036216 12321135263 016712 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 218;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use lib 'xt';
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments;
use Memoize;
use Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my $midpath = Math::PlanePath::DragonMidpoint->new;
#------------------------------------------------------------------------------
# MB = midpoint square figures boundary
{
my @want = (4, 6, 10, 18, 30, 50, 86, 146, 246, 418, 710, 1202); # per POD
foreach my $k (0 .. $#want) {
my $got = MB_from_path($path,$k);
ok ($want[$k],$got);
}
}
{
# MB[k] = B[k] + 4
foreach my $k (0 .. 10) {
my $mb = MB_from_path($path,$k);
my $b2 = B_from_path($path,$k) + 4;
ok ($mb,$b2, "k=$k");
}
}
sub MB_from_path {
my ($path, $k) = @_;
return MyOEIS::path_n_to_figure_boundary($midpath, 2**$k-1);
}
BEGIN { memoize('MB_from_path'); }
#------------------------------------------------------------------------------
# P = points visited
ok ($path->_UNDOCUMENTED_level_to_visited(4), 16);
ok ($path->_UNDOCUMENTED_level_to_visited(5), 29);
ok ($path->_UNDOCUMENTED_level_to_visited(6), 54);
{
foreach my $k (0 .. 10) {
my $got = $path->_UNDOCUMENTED_level_to_visited($k);
my $want = P_from_path($path,$k);
ok ($got,$want, "k=$k");
}
}
sub P_from_path {
my ($path, $k) = @_;
return MyOEIS::path_n_to_visited($path, 2**$k);
}
BEGIN { memoize('P_from_path'); }
#------------------------------------------------------------------------------
# RU = right U
{
foreach my $k (0 .. 10) {
my $got = $path->_UNDOCUMENTED_level_to_u_right_line_boundary($k);
my $want = RU_from_path($path,$k);
ok ($got,$want);
}
}
sub RU_from_path {
my ($path, $k) = @_;
return MyOEIS::path_boundary_length($path, 3 * 2**$k,
side => 'right');
}
BEGIN { memoize('RU_from_path'); }
#------------------------------------------------------------------------------
# BU = total U
{
foreach my $k (0 .. 10) {
my $got = $path->_UNDOCUMENTED_level_to_u_line_boundary($k);
my $want = BU_from_path($path,$k);
ok ($got,$want);
}
}
sub BU_from_path {
my ($path, $k) = @_;
return MyOEIS::path_boundary_length($path, 3 * 2**$k);
}
BEGIN { memoize('BU_from_path'); }
#------------------------------------------------------------------------------
# U
{
foreach my $k (0 .. 10) {
my $got = $path->_UNDOCUMENTED_level_to_u_left_line_boundary($k);
my $want = U_from_path($path,$k);
ok ($got,$want);
}
}
{
# POD samples
my @want = (3, 6, 8, 12, 20, 32, 52, 88, 148, 248, 420, 712, 1204, 2040);
foreach my $k (0 .. $#want) {
my $got = U_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# U[k+1] = U[k] + V[k]
foreach my $k (0 .. 10) {
my $u = U_from_path($path,$k);
my $v = V_from_path($path,$k);
my $got = $u + $v;
my $want = U_from_path($path,$k+1);
ok ($got,$want);
}
}
{
# U[k+1] = U[k] + L[k] k>=1
foreach my $k (1 .. 10) {
my $u = U_from_path($path,$k);
my $l = L_from_path($path,$k);
my $got = $u + $l;
my $want = U_from_path($path,$k+1);
ok ($got,$want);
}
}
{
# U[k+4] = 2*U[k+3] - U[k+2] + 2*U[k+1] - 2*U[k] for k >= 1
foreach my $k (1 .. 10) {
my $u0 = U_from_path($path,$k);
my $u1 = U_from_path($path,$k+1);
my $u2 = U_from_path($path,$k+2);
my $u3 = U_from_path($path,$k+3);
my $got = 2*$u3 - $u2 + 2*$u1 - 2*$u0;
my $want = U_from_path($path,$k+4);
ok ($got,$want);
}
}
{
# U[k] = L[k+2] - R[k]
foreach my $k (0 .. 10) {
my $l = L_from_path($path,$k+2);
my $r = R_from_path($path,$k);
my $got = $l - $r;
my $want = U_from_path($path,$k);
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
# B
{
MyOEIS::poly_parse('1 - 2*x^3');
my $num = MyOEIS::poly_parse('2 + 2*x^2');
my $den = MyOEIS::poly_parse('1 - x - 2*x^3')*MyOEIS::poly_parse('1-x');
print MyOEIS::poly_parse('2 + 2*x^2'),"\n";
print MyOEIS::poly_parse('1 - x - 2*x^3'),"\n";
print MyOEIS::poly_parse('1-x'),"\n";
print $den,"\n";
exit;
}
{
# _UNDOCUMENTED_level_to_line_boundary()
foreach my $k (0 .. 14) {
my $got = $path->_UNDOCUMENTED_level_to_line_boundary($k);
my $want = B_from_path($path,$k);
ok ($got, $want, "_UNDOCUMENTED_level_to_line_boundary() k=$k");
}
}
{
# POD samples
my @want = (2, 4, 8, 16, 28, 48, 84, 144, 244, 416, 708, 1200, 2036);
foreach my $k (0 .. $#want) {
my $got = B_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# B[k+4] = 2*B[k+3] - B[k+2] + 2*B[k+1] - 2*B[k] for k >= 0
foreach my $k (0 .. 10) {
my $b0 = B_from_path($path,$k);
my $b1 = B_from_path($path,$k+1);
my $b2 = B_from_path($path,$k+2);
my $b3 = B_from_path($path,$k+3);
my $got = 2*$b3 - $b2 + 2*$b1 - 2*$b0;
my $want = B_from_path($path,$k+4);
ok ($got,$want);
}
}
{
# B[k] = L[k] + R[k]
foreach my $k (0 .. 10) {
my $l = L_from_path($path,$k);
my $r = R_from_path($path,$k);
my $got = $l + $r;
my $want = B_from_path($path,$k);
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
# S = Singles
{
# S[k] = 1 + B[k]/2
foreach my $k (0 .. 10) {
my $got = 1 + B_from_path($path,$k)/2;
my $want = MyOEIS::path_n_to_singles($path, 2**$k);
ok ($got,$want);
}
}
{
# Single[N] = N+1 - 2*Doubled[N] points 0 to N inclusive
my $n_start = $path->n_start;
for (my $length = 0; $length < 128; $length++) {
my $n_end = $n_start + $length;
my $singles = MyOEIS::path_n_to_singles($path, $n_end);
my $doubles = MyOEIS::path_n_to_doubles($path, $n_end);
### $n_start
### $n_end
### $singles
### $doubles
my $got = $singles + 2*$doubles;
ok ($got, $length+1);
}
}
{
# S[k] recurrence
foreach my $k (0 .. 10) {
my $got = S_recurrence($k);
my $want = MyOEIS::path_n_to_singles($path, 2**$k);
ok ($got,$want);
}
sub S_recurrence {
my ($k) = @_;
if ($k < 0) { die; }
if ($k == 0) { return 2; }
if ($k == 1) { return 3; }
if ($k == 2) { return 5; }
if ($k == 3) { return 9; }
return (S_recurrence($k-1) + 2*S_recurrence($k-3));
}
BEGIN { memoize('S_recurrence'); }
}
#------------------------------------------------------------------------------
# Doubles
{
foreach my $k (0 .. 10) {
my $n_limit = 2**$k;
my $got = $path->_UNDOCUMENTED_level_to_doubled_points($k);
my $want = MyOEIS::path_n_to_doubles($path, $n_limit);
ok ($got,$want);
}
}
# Doubles[N] = Area[N] for all N
{
foreach my $k (0 .. 10) {
my $n_limit = 2**$k;
my $got = A_recurrence($k);
my $want = MyOEIS::path_n_to_doubles($path, $n_limit);
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
# L
{
# _UNDOCUMENTED_level_to_left_line_boundary()
foreach my $k (0 .. 14) {
my $got = $path->_UNDOCUMENTED_level_to_left_line_boundary($k);
my $want = L_from_path($path,$k);
ok ($got, $want, "_UNDOCUMENTED_level_to_left_line_boundary() k=$k");
}
}
{
# POD samples
my @want = (1, 2, 4, 8, 12, 20, 36, 60, 100, 172, 292, 492, 836, 1420);
foreach my $k (0 .. $#want) {
my $got = L_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# L[k+1] = T[k]
foreach my $k (0 .. 10) {
my $l = L_from_path($path,$k+1);
my $t = T_from_path($path,$k);
ok ($l,$t);
}
}
#------------------------------------------------------------------------------
# R
{
# _UNDOCUMENTED_level_to_right_line_boundary()
foreach my $k (0 .. 14) {
my $got = $path->_UNDOCUMENTED_level_to_right_line_boundary($k);
my $want = R_from_path($path,$k);
ok ($got, $want, "_UNDOCUMENTED_level_to_right_line_boundary() k=$k");
}
}
{
# R[k] = L[k-1] + L[k-2] + ... + L[0] + 1
my $sum = 1;
foreach my $k (0 .. 14) {
my $r = R_from_path($path,$k);
ok ($sum,$r);
$sum += L_from_path($path,$k);
}
}
{
# POD samples
my @want = (1, 2, 4, 8, 16, 28, 48, 84, 144, 244, 416, 708, 1200, 2036);
foreach my $k (0 .. $#want) {
my $got = R_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# R[k+4] = 2*R[k+3] - R[k+2] + 2*R[k+1] - 2*R[k] for k >= 1
foreach my $k (1 .. 10) {
my $r0 = R_from_path($path,$k);
my $r1 = R_from_path($path,$k+1);
my $r2 = R_from_path($path,$k+2);
my $r3 = R_from_path($path,$k+3);
my $got = 2*$r3 - $r2 + 2*$r1 - 2*$r0;
my $want = R_from_path($path,$k+4);
ok ($got,$want);
}
}
{
# R[k+1] = L[k] + R[k]
foreach my $k (0 .. 10) {
my $l = L_from_path($path,$k);
my $r = R_from_path($path,$k);
my $got = $l + $r;
my $want = R_from_path($path,$k+1);
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
# 4^k extents in the POD
{
foreach my $k (1 .. 12) {
next unless $k & 1;
my $n_end = 4**$k;
my ($xmin,$ymin, $xmax,$ymax) = path_n_to_extents_rect($path,$n_end);
$xmin < $xmax or die;
$ymin < $ymax or die;
my $wmin = $xmin;
my $wmax = $xmax;
my $lmin = $ymin;
my $lmax = $ymax;
foreach (-2 .. $k) {
($wmax,$wmin, $lmax,$lmin) = ($lmax,$lmin, -$wmin,-$wmax);
}
$wmin < $wmax or die;
$lmin < $lmax or die;
my ($f_lmin,$f_lmax, $f_wmin,$f_wmax) = formula_k_to_lw_extents($k);
$f_wmin < $f_wmax or die;
$f_lmin < $f_lmax or die;
### $k
### xy extents: "$xmin to $xmax $ymin to $ymax"
### lw extents: "$lmin to $lmax $wmin to $wmax"
### lw f exts : "$f_lmin to $f_lmax $f_wmin to $f_wmax"
ok ($f_lmin, $lmin, "k=$k");
ok ($f_lmax, $lmax, "k=$k");
ok ($f_wmin, $wmin, "k=$k");
ok ($f_wmax, $wmax, "k=$k");
}
}
# return ($xmin,$xmax, $ymin,$ymax)
sub formula_k_to_lw_extents {
my ($k) = @_;
my $lmax = ($k % 2 == 0
? (7*2**$k - 4)/6
: (7*2**$k - 2)/6);
my $lmin = ($k % 2 == 0
? - (2**$k - 1)/3
: - (2**$k - 2)/3);
my $wmax = ($k % 2 == 0
? (2*2**$k - 2) / 3
: (2*2**$k - 1) / 3);
my $wmin = $lmin;
return ($lmin,$lmax, $wmin,$wmax);
}
# return ($xmin,$ymin, $xmax,$ymax)
# which is rectangle containing all points n_start() to $n inclusive
sub path_n_to_extents_rect {
my ($path, $n) = @_;
my $xmin = 0;
my $xmax = 0;
my $ymin = 0;
my $ymax = 0;
for my $i ($path->n_start .. $n) {
my ($x,$y) = $path->n_to_xy($i);
$xmin = min($xmin,$x);
$xmax = max($xmax,$x);
$ymin = min($ymin,$y);
$ymax = max($ymax,$y);
}
return ($xmin,$ymin, $xmax,$ymax);
}
#------------------------------------------------------------------------------
# path calculations
sub B_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit);
return scalar(@$points);
}
BEGIN { memoize('B_from_path'); }
sub L_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'left');
return scalar(@$points) - 1;
}
BEGIN { memoize('L_from_path'); }
sub R_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'right');
return scalar(@$points) - 1;
}
BEGIN { memoize('R_from_path'); }
sub T_from_path {
my ($path, $k) = @_;
# 2 to 4
my $n_limit = 2**$k;
my ($x,$y) = $path->n_to_xy(2*$n_limit);
my ($to_x,$to_y) = $path->n_to_xy(4*$n_limit);
my $points = MyOEIS::path_boundary_points_ft($path, 4*$n_limit,
$x,$y, $to_x,$to_y,
dir => 2);
return scalar(@$points) - 1;
}
BEGIN { memoize('T_from_path'); }
sub U_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my ($x,$y) = $path->n_to_xy(3*$n_limit);
my ($to_x,$to_y) = $path->n_to_xy(0);
my $points = MyOEIS::path_boundary_points_ft($path, 3*$n_limit,
$x,$y, $to_x,$to_y,
dir => 1);
return scalar(@$points) - 1;
}
BEGIN { memoize('U_from_path'); }
sub V_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my ($x,$y) = $path->n_to_xy(6*$n_limit);
my ($to_x,$to_y) = $path->n_to_xy(3*$n_limit);
my $points = MyOEIS::path_boundary_points_ft($path, 8*$n_limit,
$x,$y, $to_x,$to_y,
dir => 0);
return scalar(@$points) - 1;
}
BEGIN { memoize('V_from_path'); }
sub A_from_path {
my ($path, $k) = @_;
return MyOEIS::path_enclosed_area($path, 2**$k);
}
BEGIN { memoize('A_from_path'); }
#------------------------------------------------------------------------------
# Area
sub A_recurrence {
my ($k) = @_;
if ($k <= 0) { return 0; }
if ($k == 1) { return 0; }
if ($k == 2) { return 0; }
if ($k == 3) { return 0; }
if ($k == 4) { return 1; }
return (4*A_recurrence($k-1)
- 5*A_recurrence($k-2)
+ 4*A_recurrence($k-3)
- 6*A_recurrence($k-4)
+ 4*A_recurrence($k-5));
}
memoize('A_from_path');
{
# A[k] recurrence
foreach my $k (0 .. 10) {
my $got = A_recurrence($k);
my $want = A_from_path($path,$k);
ok ($got,$want);
}
}
{
# A[k] = 2^k - B[k]/2
foreach my $k (0 .. 10) {
my $b = B_from_path($path,$k);
my $got = 2**($k-1) - $b/4;
my $want = A_from_path($path,$k);
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
# subst eliminating U
{
# L[k+3]-R[k+1] = L[k+2]-R[k] + L[k] k >= 1
foreach my $k (1 .. 10) {
my $lhs = L_from_path($path,$k+3) - R_from_path($path,$k+1);
my $rhs = (L_from_path($path,$k+2) - R_from_path($path,$k)
+ L_from_path($path,$k));
ok ($lhs,$rhs);
}
}
#------------------------------------------------------------------------------
# T
{
# T[k+1] = U[k] + R[k]
foreach my $k (0 .. 10) {
my $r = R_from_path($path,$k);
my $u = U_from_path($path,$k);
my $got = $r + $u;
my $want = T_from_path($path,$k+1);
ok ($got,$want, "k=$k");
}
}
#------------------------------------------------------------------------------
# V
{
# V[k+1] = T[k]
foreach my $k (0 .. 10) {
my $v = V_from_path($path,$k+1);
my $t = T_from_path($path,$k);
ok ($v,$t);
}
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/HilbertCurve-slow.t 0000644 0001750 0001750 00000005611 12342460401 017062 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 87;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use lib 'xt';
use MyOEIS;
use Memoize;
# uncomment this to run the ### lines
# use Smart::Comments;
use Math::PlanePath::HilbertCurve;
my $path = Math::PlanePath::HilbertCurve->new;
#------------------------------------------------------------------------------
# count of segments by direction claimed in the POD
{
my %want = ('0,1' => [ 0, 1, 4, 19, 64, 271, 1024, 4159, 16384, ], # dir=1=N
'1,0' => [ 0, 1, 5, 16, 71, 256, 1055, 4096, 16511, ], # dir=2=E
'0,-1' => [ 0, 0, 4, 12, 64, 240, 1024, 4032, 16384, ], # dir=3=S
'-1,0' => [ 0, 1, 2, 16, 56, 256, 992, 4096, 16256, ], # dir=4=W
);
my %count = ('0,1' => 0,
'1,0' => 0,
'0,-1' => 0,
'-1,0' => 0);
my $n = 0;
foreach my $k (0 .. $#{$want{'0,1'}}) {
my $n_end = 4**$k-1;
while ($n < $n_end) {
my ($dx,$dy) = $path->n_to_dxdy($n++);
$count{"$dx,$dy"}++;
### count: "n=$n $dx,$dy"
}
### count now: "$count{'0,1'}, $count{'1,0'} $count{'0,-1'} $count{'-1,0'}"
foreach my $dxdy (keys %want) {
my $pod = $want{$dxdy}->[$k];
my $count = $count{$dxdy};
ok ($pod, $count, "$dxdy samples");
my $func = c_func($dxdy,$k);
ok ($func, $count, "$dxdy func=$func count=$count");
}
}
}
sub c_func {
my ($dxdy, $k) = @_;
if ($dxdy eq '0,1') { # dir=1=N
if ($k == 0) { return 0; }
if ($k % 2) { return 4**($k-1) + 2**($k-1) - 1; }
return 4**($k-1);
}
if ($dxdy eq '1,0') { # dir=2=E
if ($k == 0) { return 0; }
if ($k % 2) { return 4**($k-1); }
return 4**($k-1) + 2**($k-1) - 1;
}
if ($dxdy eq '0,-1') { # dir=3=S
if ($k == 0) { return 0; }
if ($k % 2) { return 4**($k-1) - 2**($k-1); }
return 4**($k-1);
}
if ($dxdy eq '-1,0') { # dir=4=W
if ($k == 0) { return 0; }
if ($k % 2) { return 4**($k-1); }
return 4**($k-1) - 2**($k-1);
}
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/NumSeq-PlanePathCoord.t 0000644 0001750 0001750 00000216574 12563217176 017605 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Test;
use Data::Float 'pos_infinity';
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use Math::PlanePath::Base::Generic
'is_infinite';
# uncomment this to run the ### lines
# use Smart::Comments '###';
my $test_count = (tests => 1045)[1];
plan tests => $test_count;
if (! eval { require Math::NumSeq; 1 }) {
MyTestHelpers::diag ('skip due to Math::NumSeq not available -- ',$@);
foreach (1 .. $test_count) {
skip ('due to no Math::NumSeq', 1, 1);
}
exit 0;
}
require Math::NumSeq::PlanePathCoord;
sub want_planepath {
my ($planepath) = @_;
# return 0 unless $planepath =~ /HTree/;
# return 0 unless $planepath =~ /DiagonalRationals/;
# return 0 unless $planepath =~ /FactorRationals/;
# return 0 unless $planepath =~ /MultipleRings/;
# return 0 unless $planepath =~ /Anvil/;
return 1;
}
sub want_coordinate {
my ($type) = @_;
# return 0 unless $type =~ /sumabs|absdiff/i;
# return 0 unless $type =~ /d[XY]/;
# return 0 unless $type =~ /^dAbsDiff/;
# return 0 unless $type =~ /TR/;
# return 0 unless $type =~ /RSquared|Radius/;
# return 0 unless $type =~ /Left|Right|LSR|SLR|SRL/;
# return 0 unless $type =~ /Dir4|Dir6/;
# return 0 unless $type =~ /LeafDistance/;
# return 0 unless $type =~ /Min|Max/;
# return 0 unless $type =~ /dSum|dDiffXY|Absd|d[XY]/;
# return 0 unless $type =~ /^(X|Y|Sum|DiffXY|dX|dY|AbsdX|AbsdY|dSum|dDiffXY|Dir4)$/;
# return 0 unless $type =~ /^(X|Y|Sum|DiffXY|DiffYX)$/;
return 0 unless $type =~ /^(Left|Right|Straight|S..|.S.)$/;
return 1;
}
#------------------------------------------------------------------------------
# characteristic()
foreach my $elem
(['increasing',0 ], # default SquareSpiral X not monotonic
['non_decreasing', 1, planepath => 'Hypot', coordinate_type => 'Radius' ],
['non_decreasing', 1, planepath => 'Hypot', coordinate_type => 'Radius' ],
['non_decreasing', 1, planepath => 'HypotOctant', coordinate_type => 'Radius' ],
['non_decreasing', 1, planepath => 'HypotOctant', coordinate_type => 'RSquared' ],
['smaller', 1, planepath => 'SquareSpiral', coordinate_type => 'X' ],
['smaller', 1, planepath => 'SquareSpiral', coordinate_type => 'RSquared' ],
['smaller', 0, planepath => 'MultipleRings,step=0', coordinate_type => 'RSquared' ],
['smaller', 0, planepath => 'MultipleRings,step=1', coordinate_type => 'RSquared' ],
['smaller', 1, planepath => 'MultipleRings,step=2', coordinate_type => 'RSquared' ],
['increasing', 1, planepath => 'TheodorusSpiral', coordinate_type => 'Radius' ],
['increasing', 1, planepath => 'TheodorusSpiral', coordinate_type => 'RSquared' ],
['non_decreasing', 1, planepath => 'TheodorusSpiral', coordinate_type => 'Radius' ],
['non_decreasing', 1, planepath => 'TheodorusSpiral', coordinate_type => 'RSquared' ],
['smaller', 1, planepath => 'TheodorusSpiral', coordinate_type => 'Radius' ],
['smaller', 0, planepath => 'TheodorusSpiral', coordinate_type => 'RSquared' ],
['increasing', 1, planepath => 'VogelFloret', coordinate_type => 'Radius' ],
['increasing', 1, planepath => 'VogelFloret', coordinate_type => 'RSquared' ],
['non_decreasing', 1, planepath => 'VogelFloret', coordinate_type => 'Radius' ],
['non_decreasing', 1, planepath => 'VogelFloret', coordinate_type => 'RSquared' ],
['smaller', 1, planepath => 'VogelFloret', coordinate_type => 'Radius' ],
['smaller', 0, planepath => 'VogelFloret', coordinate_type => 'RSquared' ],
['increasing', 1, planepath => 'SacksSpiral', coordinate_type => 'Radius' ],
['increasing', 1, planepath => 'SacksSpiral', coordinate_type => 'RSquared' ],
['non_decreasing', 1, planepath => 'SacksSpiral', coordinate_type => 'Radius' ],
['non_decreasing', 1, planepath => 'SacksSpiral', coordinate_type => 'RSquared' ],
['smaller', 1, planepath => 'SacksSpiral', coordinate_type => 'Radius' ],
['smaller', 0, planepath => 'SacksSpiral', coordinate_type => 'RSquared' ],
) {
my ($key, $want, @parameters) = @$elem;
my $seq = Math::NumSeq::PlanePathCoord->new (@parameters);
ok ($seq->characteristic($key) ? 1 : 0, $want,
"characteristic($key) on ".join(', ',@parameters));
}
#------------------------------------------------------------------------------
# values_min(), values_max()
foreach my $elem
([undef,undef, planepath => 'SquareSpiral' ], # default coordinate_type=>X
[0,undef, planepath => 'SquareSpiral', coordinate_type => 'Radius' ],
[0,undef, planepath => 'SquareSpiral', coordinate_type => 'RSquared' ],
[0,undef, planepath => 'HilbertCurve', coordinate_type => 'X' ],
[0,undef, planepath => 'HilbertCurve', coordinate_type => 'Y' ],
[0,undef, planepath => 'HilbertCurve', coordinate_type => 'Sum' ],
[0,undef, planepath => 'HilbertCurve', coordinate_type => 'Product' ],
[undef,undef, planepath => 'CellularRule54', coordinate_type => 'X' ],
[0,undef, planepath => 'CellularRule54', coordinate_type => 'Y' ],
[0,undef, planepath => 'CellularRule54', coordinate_type => 'Sum' ],
[undef,undef, planepath => 'CellularRule54', coordinate_type => 'Product' ],
[0,undef, planepath => 'CellularRule54', coordinate_type => 'Radius' ],
[0,undef, planepath => 'CellularRule54', coordinate_type => 'RSquared' ],
[undef,0, planepath => 'CellularRule54', coordinate_type => 'DiffXY' ],
[0,undef, planepath => 'CellularRule54', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'CellularRule54', coordinate_type => 'AbsDiff' ],
[undef,undef, planepath => 'CellularRule190', coordinate_type => 'X' ],
[0,undef, planepath => 'CellularRule190', coordinate_type => 'Y' ],
[0,undef, planepath => 'CellularRule190', coordinate_type => 'Sum' ],
[undef,undef, planepath => 'CellularRule190', coordinate_type => 'Product' ],
[0,undef, planepath => 'CellularRule190', coordinate_type => 'Radius' ],
[0,undef, planepath => 'CellularRule190', coordinate_type => 'RSquared' ],
[undef,undef, planepath => 'UlamWarburton', coordinate_type => 'X' ],
[undef,undef, planepath => 'UlamWarburton', coordinate_type => 'Y' ],
[undef,undef, planepath => 'UlamWarburton', coordinate_type => 'Sum' ],
[undef,undef, planepath => 'UlamWarburton', coordinate_type => 'Product' ],
[0,undef, planepath => 'UlamWarburton', coordinate_type => 'Radius' ],
[0,undef, planepath => 'UlamWarburton', coordinate_type => 'RSquared' ],
[0,undef, planepath => 'UlamWarburtonQuarter', coordinate_type => 'X' ],
[0,undef, planepath => 'UlamWarburtonQuarter', coordinate_type => 'Y' ],
[0,undef, planepath => 'UlamWarburtonQuarter', coordinate_type => 'Sum' ],
[0,undef, planepath => 'UlamWarburtonQuarter', coordinate_type => 'Product' ],
[0,undef, planepath => 'UlamWarburtonQuarter', coordinate_type => 'Radius' ],
[0,undef, planepath => 'UlamWarburtonQuarter', coordinate_type => 'RSquared' ],
[3,undef, planepath => 'PythagoreanTree', coordinate_type => 'X' ],
[4,undef, planepath => 'PythagoreanTree', coordinate_type => 'Y' ],
[7,undef, planepath => 'PythagoreanTree', coordinate_type => 'Sum' ],
[3*4,undef, planepath => 'PythagoreanTree', coordinate_type => 'Product' ],
[5,undef, planepath => 'PythagoreanTree', coordinate_type => 'Radius' ],
[25,undef, planepath => 'PythagoreanTree', coordinate_type => 'RSquared' ],
[undef,undef, planepath => 'PythagoreanTree', coordinate_type => 'DiffXY' ],
[undef,undef, planepath => 'PythagoreanTree', coordinate_type => 'DiffYX' ],
[1,undef, planepath => 'PythagoreanTree', coordinate_type => 'AbsDiff' ],
[2,undef, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'X' ],
[1,undef, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'Y' ],
[3,undef, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'Sum' ],
[2,undef, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'Product' ],
#[sqrt(5),undef, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'Radius' ],
[5,undef, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'RSquared' ],
[1,undef, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'DiffXY' ],
[undef,-1, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'DiffYX' ],
[1,undef, planepath => 'PythagoreanTree,coordinates=PQ', coordinate_type => 'AbsDiff' ],
[0,undef, planepath => 'HypotOctant', coordinate_type => 'X' ],
[0,undef, planepath => 'HypotOctant', coordinate_type => 'Y' ],
[0,undef, planepath => 'HypotOctant', coordinate_type => 'Sum' ],
[0,undef, planepath => 'HypotOctant', coordinate_type => 'Product' ],
[0,undef, planepath => 'HypotOctant', coordinate_type => 'Radius' ],
[0,undef, planepath => 'HypotOctant', coordinate_type => 'RSquared' ],
[0,undef, planepath => 'HypotOctant', coordinate_type => 'DiffXY' ],
[undef,0, planepath => 'HypotOctant', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'HypotOctant', coordinate_type => 'AbsDiff' ],
[2,undef, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'X' ],
[1,undef, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'Y' ],
[3,undef, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'Sum' ],
[2,undef, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'Product' ],
# [sqrt(5),undef, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'Radius' ],
[5,undef, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'RSquared' ],
[1,undef, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'DiffXY' ],
[undef,-1, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'DiffYX' ],
[1,undef, planepath => 'DivisibleColumns,divisor_type=proper', coordinate_type => 'AbsDiff' ],
[1,undef, planepath => 'DivisibleColumns', coordinate_type => 'X' ],
[1,undef, planepath => 'DivisibleColumns', coordinate_type => 'Y' ],
[2,undef, planepath => 'DivisibleColumns', coordinate_type => 'Sum' ],
[1,undef, planepath => 'DivisibleColumns', coordinate_type => 'Product' ],
# [sqrt(2),undef, planepath => 'DivisibleColumns', coordinate_type => 'Radius' ],
[2,undef, planepath => 'DivisibleColumns', coordinate_type => 'RSquared' ],
[0,undef, planepath => 'DivisibleColumns', coordinate_type => 'DiffXY' ],
[undef,0, planepath => 'DivisibleColumns', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'DivisibleColumns', coordinate_type => 'AbsDiff' ],
[1,undef, planepath => 'CoprimeColumns', coordinate_type => 'X' ],
[1,undef, planepath => 'CoprimeColumns', coordinate_type => 'Y' ],
[2,undef, planepath => 'CoprimeColumns', coordinate_type => 'Sum' ],
[1,undef, planepath => 'CoprimeColumns', coordinate_type => 'Product' ],
# [sqrt(2),undef, planepath => 'CoprimeColumns', coordinate_type => 'Radius' ],
[2,undef, planepath => 'CoprimeColumns', coordinate_type => 'RSquared' ],
[0,undef, planepath => 'CoprimeColumns', coordinate_type => 'DiffXY' ],
[undef,0, planepath => 'CoprimeColumns', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'CoprimeColumns', coordinate_type => 'AbsDiff' ],
[1,undef, planepath => 'RationalsTree', coordinate_type => 'X' ],
[1,undef, planepath => 'RationalsTree', coordinate_type => 'Y' ],
# X>=1 and Y>=1 always so Sum>=2
[2,undef, planepath => 'RationalsTree', coordinate_type => 'Sum' ],
[1,undef, planepath => 'RationalsTree', coordinate_type => 'Product' ],
# [sqrt(2),undef, planepath => 'RationalsTree', coordinate_type => 'Radius' ],
[2,undef, planepath => 'RationalsTree', coordinate_type => 'RSquared' ],
# whole first quadrant so diff positive and negative
[undef,undef, planepath => 'RationalsTree', coordinate_type => 'DiffXY' ],
[undef,undef, planepath => 'RationalsTree', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'RationalsTree', coordinate_type => 'AbsDiff' ],
[0,undef, planepath => 'QuadricCurve', coordinate_type => 'X' ],
[undef,undef, planepath => 'QuadricCurve', coordinate_type => 'Y' ],
[0,undef, planepath => 'QuadricCurve', coordinate_type => 'Sum' ],
[undef,undef, planepath => 'QuadricCurve', coordinate_type => 'Product' ],
[0,undef, planepath => 'QuadricCurve', coordinate_type => 'Radius' ],
[0,undef, planepath => 'QuadricCurve', coordinate_type => 'RSquared' ],
[0,undef, planepath => 'QuadricCurve', coordinate_type => 'DiffXY' ],
[undef,0, planepath => 'QuadricCurve', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'QuadricCurve', coordinate_type => 'AbsDiff' ],
[0,5, planepath => 'Rows,width=6', coordinate_type => 'X' ],
[0,undef, planepath => 'Rows,width=6', coordinate_type => 'Y' ],
[0,undef, planepath => 'Rows,width=6', coordinate_type => 'Sum' ],
[0,undef, planepath => 'Rows,width=6', coordinate_type => 'Product' ],
[0,undef, planepath => 'Rows,width=6', coordinate_type => 'Radius' ],
[0,undef, planepath => 'Rows,width=6', coordinate_type => 'RSquared' ],
[undef,5, planepath => 'Rows,width=6', coordinate_type => 'DiffXY' ],
[-5,undef, planepath => 'Rows,width=6', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'Rows,width=6', coordinate_type => 'AbsDiff' ],
[0,undef, planepath => 'Columns,height=6', coordinate_type => 'X' ],
[0,5, planepath => 'Columns,height=6', coordinate_type => 'Y' ],
[0,undef, planepath => 'Columns,height=6', coordinate_type => 'Sum' ],
[0,undef, planepath => 'Columns,height=6', coordinate_type => 'Product' ],
[0,undef, planepath => 'Columns,height=6', coordinate_type => 'Radius' ],
[0,undef, planepath => 'Columns,height=6', coordinate_type => 'RSquared' ],
[-5,undef, planepath => 'Columns,height=6', coordinate_type => 'DiffXY' ],
[undef,5, planepath => 'Columns,height=6', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'Columns,height=6', coordinate_type => 'AbsDiff' ],
# step=0 vertical on Y axis only
[0,0, planepath=>'PyramidRows,step=0', coordinate_type => 'X' ],
[0,undef, planepath=>'PyramidRows,step=0', coordinate_type => 'Y' ],
[0,undef, planepath=>'PyramidRows,step=0', coordinate_type => 'Sum' ],
[0,0, planepath=>'PyramidRows,step=0', coordinate_type => 'Product' ],
[0,undef, planepath=>'PyramidRows,step=0', coordinate_type => 'Radius' ],
[0,undef, planepath=>'PyramidRows,step=0', coordinate_type => 'RSquared' ],
[undef,0, planepath=>'PyramidRows,step=0', coordinate_type => 'DiffXY' ],
[0,undef, planepath=>'PyramidRows,step=0', coordinate_type => 'DiffYX' ],
[0,undef, planepath=>'PyramidRows,step=0', coordinate_type => 'AbsDiff' ],
[0,undef, planepath=>'PyramidRows,step=1', coordinate_type => 'X' ],
[0,undef, planepath=>'PyramidRows,step=1', coordinate_type => 'Y' ],
[0,undef, planepath=>'PyramidRows,step=1', coordinate_type => 'Sum' ],
[0,undef, planepath=>'PyramidRows,step=1', coordinate_type => 'Product' ],
[0,undef, planepath=>'PyramidRows,step=1', coordinate_type => 'Radius' ],
[0,undef, planepath=>'PyramidRows,step=1', coordinate_type => 'RSquared' ],
[undef,0, planepath=>'PyramidRows,step=1', coordinate_type => 'DiffXY' ],
[0,undef, planepath=>'PyramidRows,step=1', coordinate_type => 'DiffYX' ],
[0,undef, planepath=>'PyramidRows,step=1', coordinate_type => 'AbsDiff' ],
[undef,undef, planepath=>'PyramidRows,step=2', coordinate_type=>'X' ],
[0,undef, planepath=>'PyramidRows,step=2', coordinate_type=>'Y' ],
[0,undef, planepath=>'PyramidRows,step=2', coordinate_type=>'Sum' ],
[undef,undef, planepath=>'PyramidRows,step=2', coordinate_type=>'Product' ],
[0,undef, planepath=>'PyramidRows,step=2', coordinate_type=>'Radius' ],
[0,undef, planepath=>'PyramidRows,step=2', coordinate_type=>'RSquared'],
[undef,0, planepath=>'PyramidRows,step=2', coordinate_type=>'DiffXY' ],
[0,undef, planepath=>'PyramidRows,step=2', coordinate_type=>'DiffYX' ],
[0,undef, planepath=>'PyramidRows,step=2', coordinate_type=>'AbsDiff' ],
[undef,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'X' ],
[0,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'Y' ],
[0,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'Sum' ],
[undef,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'Product' ],
[0,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'Radius' ],
[0,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'RSquared' ],
[undef,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'DiffXY' ],
[undef,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'PyramidRows,step=3', coordinate_type => 'AbsDiff' ],
# Y <= X-1, so X-Y >= 1
# Y-X <= -1
[1,undef, planepath => 'SierpinskiCurve', coordinate_type => 'DiffXY' ],
[undef,-1, planepath => 'SierpinskiCurve', coordinate_type => 'DiffYX' ],
[1,undef, planepath => 'SierpinskiCurve', coordinate_type => 'AbsDiff' ],
[0,undef, planepath => 'HIndexing', coordinate_type => 'X' ],
[0,undef, planepath => 'HIndexing', coordinate_type => 'Y' ],
[0,undef, planepath => 'HIndexing', coordinate_type => 'Sum' ],
[0,undef, planepath => 'HIndexing', coordinate_type => 'Product' ],
[0,undef, planepath => 'HIndexing', coordinate_type => 'Radius' ],
[0,undef, planepath => 'HIndexing', coordinate_type => 'RSquared' ],
[undef,0, planepath => 'HIndexing', coordinate_type => 'DiffXY' ],
[0,undef, planepath => 'HIndexing', coordinate_type => 'DiffYX' ],
[0,undef, planepath => 'HIndexing', coordinate_type => 'AbsDiff' ],
# right line
[0,undef, planepath=>'CellularRule,rule=16', coordinate_type=>'X' ],
[0,undef, planepath=>'CellularRule,rule=16', coordinate_type=>'Y' ],
[0,undef, planepath=>'CellularRule,rule=16', coordinate_type=>'Sum' ],
[0,undef, planepath=>'CellularRule,rule=16', coordinate_type=>'Product' ],
[0,undef, planepath=>'CellularRule,rule=16', coordinate_type=>'Radius' ],
[0,undef, planepath=>'CellularRule,rule=16', coordinate_type=>'RSquared' ],
[0,0, planepath=>'CellularRule,rule=16', coordinate_type=>'DiffXY' ],
[0,0, planepath=>'CellularRule,rule=16', coordinate_type=>'DiffYX' ],
[0,0, planepath=>'CellularRule,rule=16', coordinate_type=>'AbsDiff' ],
# centre line Y axis only
[0,0, planepath=>'CellularRule,rule=4', coordinate_type => 'X' ],
[0,undef, planepath=>'CellularRule,rule=4', coordinate_type => 'Y' ],
[0,undef, planepath=>'CellularRule,rule=4', coordinate_type => 'Sum' ],
[0,0, planepath=>'CellularRule,rule=4', coordinate_type => 'Product' ],
[0,undef, planepath=>'CellularRule,rule=4', coordinate_type => 'Radius' ],
[0,undef, planepath=>'CellularRule,rule=4', coordinate_type => 'RSquared' ],
[undef,0, planepath=>'CellularRule,rule=4', coordinate_type => 'DiffXY' ],
[0,undef, planepath=>'CellularRule,rule=4', coordinate_type => 'DiffYX' ],
[0,undef, planepath=>'CellularRule,rule=4', coordinate_type => 'AbsDiff' ],
# left line
[undef,0, planepath=>'CellularRule,rule=2', coordinate_type=>'X' ],
[0,undef, planepath=>'CellularRule,rule=2', coordinate_type=>'Y' ],
[0,0, planepath=>'CellularRule,rule=2', coordinate_type=>'Sum' ],
[undef,0, planepath=>'CellularRule,rule=2', coordinate_type=>'Product' ],
[0,undef, planepath=>'CellularRule,rule=2', coordinate_type=>'Radius' ],
[0,undef, planepath=>'CellularRule,rule=2', coordinate_type=>'RSquared' ],
[undef,0, planepath=>'CellularRule,rule=2', coordinate_type=>'DiffXY' ],
[0,undef, planepath=>'CellularRule,rule=2', coordinate_type=>'DiffYX' ],
[0,undef, planepath=>'CellularRule,rule=2', coordinate_type=>'AbsDiff' ],
# left solid
[undef,0, planepath=>'CellularRule,rule=206', coordinate_type=>'X' ],
[0,undef, planepath=>'CellularRule,rule=206', coordinate_type=>'Y' ],
[0,undef, planepath=>'CellularRule,rule=206', coordinate_type=>'Sum' ],
[undef,0, planepath=>'CellularRule,rule=206', coordinate_type=>'Product' ],
[0,undef, planepath=>'CellularRule,rule=206', coordinate_type=>'Radius' ],
[0,undef, planepath=>'CellularRule,rule=206', coordinate_type=>'RSquared' ],
[undef,0, planepath=>'CellularRule,rule=206', coordinate_type=>'DiffXY' ],
[0,undef, planepath=>'CellularRule,rule=206', coordinate_type=>'DiffYX' ],
[0,undef, planepath=>'CellularRule,rule=206', coordinate_type=>'AbsDiff' ],
# odd solid
[undef,undef, planepath=>'CellularRule,rule=50',coordinate_type=>'X' ],
[0,undef, planepath=>'CellularRule,rule=50',coordinate_type=>'Y' ],
[0,undef, planepath=>'CellularRule,rule=50',coordinate_type=>'Sum' ],
[undef,undef, planepath=>'CellularRule,rule=50',coordinate_type=>'Product'],
[0,undef, planepath=>'CellularRule,rule=50',coordinate_type=>'Radius' ],
[0,undef, planepath=>'CellularRule,rule=50',coordinate_type=>'RSquared'],
[undef,0, planepath=>'CellularRule,rule=50',coordinate_type=>'DiffXY' ],
[0,undef, planepath=>'CellularRule,rule=50',coordinate_type=>'DiffYX' ],
[0,undef, planepath=>'CellularRule,rule=50',coordinate_type=>'AbsDiff' ],
) {
my ($want_min,$want_max, @parameters) = @$elem;
### @parameters
### $want_min
### $want_max
my $seq = Math::NumSeq::PlanePathCoord->new (@parameters);
ok ($seq->values_min, $want_min,
"values_min() ".join(',',@parameters));
ok ($seq->values_max, $want_max,
"values_max() ".join(',',@parameters));
}
#------------------------------------------------------------------------------
# values_min(), values_max() by running values
my @modules = (
# 'FourReplicate',
# module list begin
'VogelFloret',
'VogelFloret,rotation_type=sqrt2',
'VogelFloret,rotation_type=sqrt3',
'VogelFloret,rotation_type=sqrt5',
'SacksSpiral',
'TheodorusSpiral',
'ArchimedeanChords',
'MultipleRings,step=0',
'MultipleRings,ring_shape=polygon,step=0',
'MultipleRings,step=1',
'MultipleRings,ring_shape=polygon,step=1',
'MultipleRings,step=2',
'MultipleRings,ring_shape=polygon,step=2',
'MultipleRings,step=3',
'MultipleRings,step=5',
'MultipleRings,step=6',
'MultipleRings,step=7',
'MultipleRings,step=8',
'MultipleRings,step=37',
'MultipleRings,ring_shape=polygon,step=3',
'MultipleRings,ring_shape=polygon,step=4',
'MultipleRings,ring_shape=polygon,step=5',
'MultipleRings,ring_shape=polygon,step=6',
'MultipleRings,ring_shape=polygon,step=7',
'MultipleRings,ring_shape=polygon,step=8',
'MultipleRings,ring_shape=polygon,step=9',
'MultipleRings,ring_shape=polygon,step=10',
'MultipleRings,ring_shape=polygon,step=11',
'MultipleRings,ring_shape=polygon,step=12',
'MultipleRings,ring_shape=polygon,step=13',
'MultipleRings,ring_shape=polygon,step=14',
'MultipleRings,ring_shape=polygon,step=15',
'MultipleRings,ring_shape=polygon,step=16',
'MultipleRings,ring_shape=polygon,step=17',
'MultipleRings,ring_shape=polygon,step=18',
'MultipleRings,ring_shape=polygon,step=37',
'SquareSpiral',
'SquareSpiral,wider=1',
'SquareSpiral,wider=2',
'SquareSpiral,wider=3',
'SquareSpiral,wider=4',
'SquareSpiral,wider=5',
'SquareSpiral,wider=6',
'SquareSpiral,wider=37',
'SquareSpiral,n_start=37',
'SquareSpiral,n_start=37,wider=1',
'SquareSpiral,n_start=37,wider=2',
'SquareSpiral,n_start=37,wider=3',
'SquareSpiral,n_start=37,wider=4',
'SquareSpiral,n_start=37,wider=5',
'SquareSpiral,n_start=37,wider=6',
'SquareSpiral,n_start=37,wider=37',
'GreekKeySpiral',
'GreekKeySpiral,turns=0',
'GreekKeySpiral,turns=1',
'GreekKeySpiral,turns=3',
'GreekKeySpiral,turns=4',
'GreekKeySpiral,turns=5',
'GreekKeySpiral,turns=6',
'GreekKeySpiral,turns=7',
'GreekKeySpiral,turns=8',
'GreekKeySpiral,turns=37',
'ChanTree,k=2',
'ChanTree',
'ChanTree,k=4',
'ChanTree,k=5',
'ChanTree,k=6',
'ChanTree,k=7',
'ChanTree,k=2,n_start=1',
'ChanTree,n_start=1',
'ChanTree,k=4,n_start=1',
'ChanTree,k=5,n_start=1',
'Rows,width=1',
'Rows,width=2',
'Rows,width=3',
'Rows,width=4',
'Rows,width=6',
'Rows,width=15',
'Rows',
'Columns,height=1',
'Columns,height=2',
'Columns,height=3',
'Columns,height=4',
'Columns,height=6',
'Columns,height=15',
'Columns',
'TriangularHypot',
'TriangularHypot,points=odd',
'TriangularHypot,points=all',
'TriangularHypot,points=hex',
'TriangularHypot,points=hex_rotated',
'TriangularHypot,points=hex_centred',
'Corner',
'Corner,wider=1',
'Corner,wider=2',
'Corner,wider=5',
'Corner,wider=37',
'PythagoreanTree,tree_type=UMT',
'PythagoreanTree,tree_type=UMT,coordinates=AC',
'PythagoreanTree,tree_type=UMT,coordinates=BC',
'PythagoreanTree,tree_type=UMT,coordinates=PQ',
'PythagoreanTree,tree_type=UMT,coordinates=SM',
'PythagoreanTree,tree_type=UMT,coordinates=SC',
'PythagoreanTree,tree_type=UMT,coordinates=MC',
'PythagoreanTree',
'PythagoreanTree,coordinates=AC',
'PythagoreanTree,coordinates=BC',
'PythagoreanTree,coordinates=PQ',
'PythagoreanTree,coordinates=SM',
'PythagoreanTree,coordinates=SC',
'PythagoreanTree,coordinates=MC',
'PythagoreanTree,tree_type=FB',
'PythagoreanTree,tree_type=FB,coordinates=AC',
'PythagoreanTree,tree_type=FB,coordinates=BC',
'PythagoreanTree,tree_type=FB,coordinates=PQ',
'PythagoreanTree,tree_type=FB,coordinates=SM',
'PythagoreanTree,tree_type=FB,coordinates=SC',
'PythagoreanTree,tree_type=FB,coordinates=MC',
'LTiling',
'LTiling,L_fill=left',
'LTiling,L_fill=upper',
'LTiling,L_fill=ends',
'LTiling,L_fill=all',
'HilbertSides',
'HilbertCurve',
'HilbertSpiral',
'DekkingCurve',
'DekkingCurve,arms=2',
'DekkingCurve,arms=3',
'DekkingCurve,arms=4',
'DekkingCentres',
'UlamWarburton,parts=octant',
'UlamWarburton,parts=octant_up',
'UlamWarburton',
'UlamWarburton,parts=2',
'UlamWarburton,parts=1',
'UlamWarburtonQuarter',
'UlamWarburtonQuarter,parts=octant_up',
'UlamWarburtonQuarter,parts=octant',
'WythoffPreliminaryTriangle',
'WythoffArray',
'WythoffArray,x_start=1',
'WythoffArray,y_start=1',
'WythoffArray,x_start=1,y_start=1',
'WythoffArray,x_start=5,y_start=7',
'MPeaks',
'MPeaks,n_start=0',
'AztecDiamondRings',
'AztecDiamondRings,n_start=0',
'AnvilSpiral',
'AnvilSpiral,wider=1',
'AnvilSpiral,wider=2',
'AnvilSpiral,wider=9',
'AnvilSpiral,wider=17',
'AnvilSpiral,n_start=0',
'AnvilSpiral,wider=1,n_start=0',
'AnvilSpiral,wider=2,n_start=0',
'AnvilSpiral,wider=9,n_start=0',
'AnvilSpiral,wider=17,n_start=0',
'Diagonals',
'Diagonals,direction=up',
#
'Diagonals,x_start=1',
'Diagonals,y_start=1',
'Diagonals,x_start=1,direction=up',
'Diagonals,y_start=1,direction=up',
#
'Diagonals,x_start=-1',
'Diagonals,y_start=-1',
'Diagonals,x_start=-1,direction=up',
'Diagonals,y_start=-1,direction=up',
#
'Diagonals,x_start=2',
'Diagonals,y_start=2',
'Diagonals,x_start=2,direction=up',
'Diagonals,y_start=2,direction=up',
#
'Diagonals,x_start=-2',
'Diagonals,y_start=-2',
'Diagonals,x_start=-2,direction=up',
'Diagonals,y_start=-2,direction=up',
#
'Diagonals,x_start=6',
'Diagonals,y_start=6',
'Diagonals,x_start=6,direction=up',
'Diagonals,y_start=6,direction=up',
#
'Diagonals,x_start=-6',
'Diagonals,y_start=-6',
'Diagonals,x_start=-6,direction=up',
'Diagonals,y_start=-6,direction=up',
#
'Diagonals,x_start=3,y_start=6',
'Diagonals,x_start=-3,y_start=0',
'Diagonals,x_start=0,y_start=-6',
'Diagonals,x_start=5,y_start=-2',
'Diagonals,x_start=-5,y_start=2',
'Diagonals,x_start=-5,y_start=2',
'Diagonals,x_start=-5,y_start=-2',
'Diagonals,x_start=3,y_start=-5',
'Diagonals,x_start=-3,y_start=5',
'Diagonals,x_start=-3,y_start=5',
'Diagonals,x_start=-3,y_start=-5',
#
'Diagonals,x_start=3,y_start=6,direction=up',
'Diagonals,x_start=-3,y_start=0,direction=up',
'Diagonals,x_start=0,y_start=-6,direction=up',
'Diagonals,x_start=5,y_start=-2,direction=up',
'Diagonals,x_start=-5,y_start=2,direction=up',
'Diagonals,x_start=-5,y_start=2,direction=up',
'Diagonals,x_start=-5,y_start=-2,direction=up',
'Diagonals,x_start=3,y_start=-5,direction=up',
'Diagonals,x_start=-3,y_start=5,direction=up',
'Diagonals,x_start=-3,y_start=5,direction=up',
'Diagonals,x_start=-3,y_start=-5,direction=up',
# 'Diagonals,x_start=20,y_start=10',
# 'Diagonals,x_start=20,y_start=10
# 'Diagonals,x_start=3,y_start=6,direction=up',
# 'Diagonals,x_start=3,y_start=-6,direction=up',
# 'Diagonals,x_start=-3,y_start=6,direction=up',
# 'Diagonals,x_start=-3,y_start=-6,direction=up',
'SierpinskiArrowhead',
'SierpinskiArrowhead,align=right',
'SierpinskiArrowhead,align=left',
'SierpinskiArrowhead,align=diagonal',
'SierpinskiArrowheadCentres',
'SierpinskiArrowheadCentres,align=right',
'SierpinskiArrowheadCentres,align=left',
'SierpinskiArrowheadCentres,align=diagonal',
'KochCurve',
'KochPeaks',
'KochSnowflakes',
'KochSquareflakes',
'KochSquareflakes,inward=>1',
'CellularRule,rule=84', # right 2 cell line
'CellularRule,rule=84,n_start=0',
'CellularRule,rule=84,n_start=37',
'CellularRule,rule=14', # left 2 cell line
'CellularRule,rule=14,n_start=0',
'CellularRule,rule=14,n_start=37',
'CellularRule,rule=20', # right 1,2 line
'CellularRule,rule=20,n_start=0',
'CellularRule,rule=20,n_start=37',
'CellularRule,rule=6', # left 1,2 line
'CellularRule,rule=6,n_start=0',
'CellularRule,rule=6,n_start=37',
'PyramidRows',
'PyramidRows,step=0',
'PyramidRows,step=1',
'PyramidRows,step=3',
'PyramidRows,step=4',
'PyramidRows,step=5',
'PyramidRows,step=6',
'PyramidRows,step=7',
'PyramidRows,step=37',
'PyramidRows,align=right',
'PyramidRows,align=right,step=0',
'PyramidRows,align=right,step=1',
'PyramidRows,align=right,step=3',
'PyramidRows,align=right,step=4',
'PyramidRows,align=right,step=5',
'PyramidRows,align=right,step=6',
'PyramidRows,align=right,step=7',
'PyramidRows,align=right,step=37',
'PyramidRows,align=left',
'PyramidRows,align=left,step=0',
'PyramidRows,align=left,step=1',
'PyramidRows,align=left,step=3',
'PyramidRows,align=left,step=4',
'PyramidRows,align=left,step=5',
'PyramidRows,align=left,step=6',
'PyramidRows,align=left,step=7',
'PyramidRows,align=left,step=37',
'OctagramSpiral',
'OctagramSpiral,n_start=0',
'OctagramSpiral,n_start=37',
'Staircase',
'Staircase,n_start=0',
'Staircase,n_start=37',
'StaircaseAlternating',
'StaircaseAlternating,n_start=0',
'StaircaseAlternating,n_start=37',
'StaircaseAlternating,end_type=square',
'StaircaseAlternating,end_type=square,n_start=0',
'StaircaseAlternating,end_type=square,n_start=37',
'R5DragonCurve',
'R5DragonCurve,arms=2',
'R5DragonCurve,arms=3',
'R5DragonCurve,arms=4',
'R5DragonMidpoint',
'R5DragonMidpoint,arms=2',
'R5DragonMidpoint,arms=3',
'R5DragonMidpoint,arms=4',
'PyramidSides',
'CornerReplicate',
'DragonCurve',
'DragonCurve,arms=2',
'DragonCurve,arms=3',
'DragonCurve,arms=4',
'DragonRounded',
'DragonRounded,arms=2',
'DragonRounded,arms=3',
'DragonRounded,arms=4',
'DragonMidpoint',
'DragonMidpoint,arms=2',
'DragonMidpoint,arms=3',
'DragonMidpoint,arms=4',
'TerdragonCurve',
'TerdragonCurve,arms=2',
'TerdragonCurve,arms=3',
'TerdragonCurve,arms=4',
'TerdragonCurve,arms=5',
'TerdragonCurve,arms=6',
'TerdragonRounded',
'TerdragonRounded,arms=2',
'TerdragonRounded,arms=3',
'TerdragonRounded,arms=4',
'TerdragonRounded,arms=5',
'TerdragonRounded,arms=6',
'TerdragonMidpoint',
'TerdragonMidpoint,arms=2',
'TerdragonMidpoint,arms=3',
'TerdragonMidpoint,arms=4',
'TerdragonMidpoint,arms=5',
'TerdragonMidpoint,arms=6',
'HexSpiral',
'HexSpiral,wider=1',
'HexSpiral,wider=2',
'HexSpiral,wider=3',
'HexSpiral,wider=4',
'HexSpiral,wider=5',
'HexSpiral,wider=37',
'HexSpiralSkewed',
'HexSpiralSkewed,wider=1',
'HexSpiralSkewed,wider=2',
'HexSpiralSkewed,wider=3',
'HexSpiralSkewed,wider=4',
'HexSpiralSkewed,wider=5',
'HexSpiralSkewed,wider=37',
'Hypot',
'Hypot,points=even',
'Hypot,points=odd',
'HypotOctant',
'HypotOctant,points=even',
'HypotOctant,points=odd',
'DiamondArms',
'SquareArms',
'HexArms',
'PentSpiral',
'PentSpiral,n_start=0',
'PentSpiral,n_start=37',
'PentSpiralSkewed',
'PentSpiralSkewed,n_start=0',
'PentSpiralSkewed,n_start=37',
'CellularRule,rule=16', # right line
'CellularRule,rule=16,n_start=0',
'CellularRule,rule=16,n_start=37',
'CellularRule,rule=24', # right line
'CellularRule,rule=48', # right line
'CellularRule,rule=2', # left line
'CellularRule,rule=2,n_start=0',
'CellularRule,rule=2,n_start=37',
'CellularRule,rule=10', # left line
'CellularRule,rule=34', # left line
'CellularRule,rule=4', # centre line
'CellularRule,rule=4,n_start=0',
'CellularRule,rule=4,n_start=37',
'CellularRule,rule=12', # centre line
'CellularRule,rule=36', # centre line
'CellularRule,rule=206', # left solid
'CellularRule,rule=206,n_start=0',
'CellularRule,rule=206,n_start=37',
'CellularRule,rule=18', # Sierpinski
'CellularRule,rule=18,n_start=0',
'CellularRule,rule=18,n_start=37',
'CellularRule,rule=60',
'CellularRule,rule=18,n_start=0',
'CellularRule,rule=18,n_start=37',
'CellularRule,rule=220', # right half solid
'CellularRule,rule=220,n_start=0',
'CellularRule,rule=220,n_start=37',
'CellularRule,rule=222', # solid
'CoprimeColumns',
'DivisibleColumns',
'DivisibleColumns,divisor_type=proper',
'FractionsTree',
'SierpinskiTriangle',
'SierpinskiTriangle,align=right',
'SierpinskiTriangle,align=left',
'SierpinskiTriangle,align=diagonal',
'SierpinskiTriangle,n_start=37',
'SierpinskiTriangle,n_start=37,align=right',
'SierpinskiTriangle,n_start=37,align=left',
'SierpinskiTriangle,n_start=37,align=diagonal',
'*ToothpickUpist',
'*HTree',
'FlowsnakeCentres',
'FlowsnakeCentres,arms=2',
'FlowsnakeCentres,arms=3',
'Flowsnake',
'Flowsnake,arms=2',
'Flowsnake,arms=3',
'ImaginaryBase',
'ImaginaryBase,radix=3',
'ImaginaryBase,radix=4',
'ImaginaryBase,radix=5',
'ImaginaryBase,radix=6',
'ImaginaryBase,radix=37',
'ImaginaryHalf',
'ImaginaryHalf,digit_order=XXY',
'ImaginaryHalf,digit_order=YXX',
'ImaginaryHalf,digit_order=XnXY',
'ImaginaryHalf,digit_order=XnYX',
'ImaginaryHalf,digit_order=YXnX',
'ImaginaryHalf,digit_order=XXY,radix=3',
'ImaginaryHalf,radix=37',
'ImaginaryHalf,radix=3',
'ImaginaryHalf,radix=4',
'ImaginaryHalf,radix=5',
'ImaginaryHalf,radix=6',
'FactorRationals',
'FactorRationals,sign_encoding=odd/even',
'FactorRationals,sign_encoding=negabinary',
'FactorRationals,sign_encoding=revbinary',
'FactorRationals,sign_encoding=spread',
'PowerArray',
'PowerArray,radix=3',
'PowerArray,radix=4',
'*ToothpickTree',
'*ToothpickTree,parts=1',
'*ToothpickTree,parts=2',
'*ToothpickTree,parts=3',
'*ToothpickTree,parts=octant',
'*ToothpickTree,parts=octant_up',
'*ToothpickTree,parts=wedge',
'*ToothpickReplicate',
'*ToothpickReplicate,parts=1',
'*ToothpickReplicate,parts=2',
'*ToothpickReplicate,parts=3',
'*LCornerReplicate',
'*LCornerTree',
'*LCornerTree,parts=3',
'*LCornerTree,parts=2',
'*LCornerTree,parts=1',
'*LCornerTree,parts=octant',
'*LCornerTree,parts=octant+1',
'*LCornerTree,parts=octant_up',
'*LCornerTree,parts=octant_up+1',
'*LCornerTree,parts=wedge',
'*LCornerTree,parts=wedge+1',
'*LCornerTree,parts=diagonal-1',
'*LCornerTree,parts=diagonal',
'ZOrderCurve',
'ZOrderCurve,radix=3',
'ZOrderCurve,radix=9',
'ZOrderCurve,radix=37',
'DiagonalRationals',
'DiagonalRationals,direction=up',
'HeptSpiralSkewed',
'HeptSpiralSkewed,n_start=0',
'HeptSpiralSkewed,n_start=37',
'*OneOfEight,parts=wedge',
'*OneOfEight,parts=octant_up',
'*OneOfEight',
'*OneOfEight,parts=4',
'*OneOfEight,parts=1',
'*OneOfEight,parts=octant',
'*OneOfEight,parts=3mid',
'*OneOfEight,parts=3side',
'*ToothpickSpiral',
'*ToothpickSpiral,n_start=0',
'*ToothpickSpiral,n_start=37',
'ComplexPlus',
'ComplexPlus,realpart=2',
'ComplexPlus,realpart=3',
'ComplexPlus,realpart=4',
'ComplexPlus,realpart=5',
'PyramidSpiral',
'PyramidSpiral,n_start=0',
'PyramidSpiral,n_start=37',
'GrayCode,apply_type=TsF',
'GrayCode,apply_type=FsT',
'GrayCode,apply_type=Ts',
'GrayCode,apply_type=Fs',
'GrayCode,apply_type=sT',
'GrayCode,apply_type=sF',
'GrayCode,radix=3,apply_type=TsF',
'GrayCode,radix=3,apply_type=FsT',
'GrayCode,radix=3,apply_type=Ts',
'GrayCode,radix=3,apply_type=Fs',
'GrayCode,radix=3,apply_type=sT',
'GrayCode,radix=3,apply_type=sF',
'GrayCode,radix=3,gray_type=modular,apply_type=TsF',
'GrayCode,radix=3,gray_type=modular,apply_type=Ts',
'GrayCode,radix=3,gray_type=modular,apply_type=Fs',
'GrayCode,radix=3,gray_type=modular,apply_type=FsT',
'GrayCode,radix=3,gray_type=modular,apply_type=sT',
'GrayCode,radix=3,gray_type=modular,apply_type=sF',
'GrayCode,radix=4,apply_type=TsF',
'GrayCode,radix=4,apply_type=FsT',
'GrayCode,radix=4,apply_type=Ts',
'GrayCode,radix=4,apply_type=Fs',
'GrayCode,radix=4,apply_type=sT',
'GrayCode,radix=4,apply_type=sF',
'GrayCode,radix=4,gray_type=modular,apply_type=TsF',
'GrayCode,radix=4,gray_type=modular,apply_type=Ts',
'GrayCode,radix=4,gray_type=modular,apply_type=Fs',
'GrayCode,radix=4,gray_type=modular,apply_type=FsT',
'GrayCode,radix=4,gray_type=modular,apply_type=sT',
'GrayCode,radix=4,gray_type=modular,apply_type=sF',
'GrayCode,radix=5,apply_type=TsF',
'GrayCode,radix=5,apply_type=FsT',
'GrayCode,radix=5,apply_type=Ts',
'GrayCode,radix=5,apply_type=Fs',
'GrayCode,radix=5,apply_type=sT',
'GrayCode,radix=5,apply_type=sF',
'GrayCode,radix=5,gray_type=modular,apply_type=TsF',
'GrayCode,radix=5,gray_type=modular,apply_type=Ts',
'GrayCode,radix=5,gray_type=modular,apply_type=Fs',
'GrayCode,radix=5,gray_type=modular,apply_type=FsT',
'GrayCode,radix=5,gray_type=modular,apply_type=sT',
'GrayCode,radix=5,gray_type=modular,apply_type=sF',
'GrayCode,radix=6,apply_type=TsF',
'GrayCode,radix=6,apply_type=FsT',
'GrayCode,radix=6,apply_type=Ts',
'GrayCode,radix=6,apply_type=Fs',
'GrayCode,radix=6,apply_type=sT',
'GrayCode,radix=6,apply_type=sF',
'GrayCode,radix=6,gray_type=modular,apply_type=TsF',
'GrayCode,radix=6,gray_type=modular,apply_type=Ts',
'GrayCode,radix=6,gray_type=modular,apply_type=Fs',
'GrayCode,radix=6,gray_type=modular,apply_type=FsT',
'GrayCode,radix=6,gray_type=modular,apply_type=sT',
'GrayCode,radix=6,gray_type=modular,apply_type=sF',
'CellularRule',
'CellularRule,rule=0', # single cell
'CellularRule,rule=8', # single cell
'CellularRule,rule=32', # single cell
'CellularRule,rule=40', # single cell
'CellularRule,rule=64', # single cell
'CellularRule,rule=72', # single cell
'CellularRule,rule=96', # single cell
'CellularRule,rule=104', # single cell
'CellularRule,rule=128', # single cell
'CellularRule,rule=136', # single cell
'CellularRule,rule=160', # single cell
'CellularRule,rule=168', # single cell
'CellularRule,rule=192', # single cell
'CellularRule,rule=200', # single cell
'CellularRule,rule=224', # single cell
'CellularRule,rule=232', # single cell
'CellularRule,rule=50', # solid every second cell
'CellularRule,rule=50,n_start=0',
'CellularRule,rule=50,n_start=37',
'CellularRule,rule=58', # solid every second cell
'CellularRule54',
'CellularRule54,n_start=0',
'CellularRule54,n_start=37',
'CellularRule57',
'CellularRule57,n_start=0',
'CellularRule57,n_start=37',
'CellularRule57,mirror=1',
'CellularRule190,n_start=0',
'CellularRule190',
'CellularRule190',
'CellularRule190,mirror=1',
'CellularRule190,mirror=1,n_start=0',
'AlternatePaper',
'AlternatePaper,arms=2',
'AlternatePaper,arms=3',
'AlternatePaper,arms=4',
'AlternatePaper,arms=5',
'AlternatePaper,arms=6',
'AlternatePaper,arms=7',
'AlternatePaper,arms=8',
'AlternatePaperMidpoint',
'AlternatePaperMidpoint,arms=2',
'AlternatePaperMidpoint,arms=3',
'AlternatePaperMidpoint,arms=4',
'AlternatePaperMidpoint,arms=5',
'AlternatePaperMidpoint,arms=6',
'AlternatePaperMidpoint,arms=7',
'AlternatePaperMidpoint,arms=8',
'GosperReplicate',
'GosperSide',
'GosperIslands',
'CubicBase',
'PeanoCurve',
'PeanoCurve,radix=2',
'PeanoCurve,radix=4',
'PeanoCurve,radix=5',
'PeanoCurve,radix=17',
'KnightSpiral',
'DiagonalsAlternating',
'GcdRationals',
'GcdRationals,pairs_order=rows_reverse',
'GcdRationals,pairs_order=diagonals_down',
'GcdRationals,pairs_order=diagonals_up',
'CCurve',
'ComplexMinus',
'ComplexMinus,realpart=2',
'ComplexMinus,realpart=3',
'ComplexMinus,realpart=4',
'ComplexMinus,realpart=5',
'ComplexRevolving',
'SierpinskiCurve',
'SierpinskiCurve,arms=2',
'SierpinskiCurve,arms=3',
'SierpinskiCurve,diagonal_spacing=5',
'SierpinskiCurve,straight_spacing=5',
'SierpinskiCurve,diagonal_spacing=3,straight_spacing=7',
'SierpinskiCurve,diagonal_spacing=3,straight_spacing=7,arms=7',
'SierpinskiCurve,arms=4',
'SierpinskiCurve,arms=5',
'SierpinskiCurve,arms=6',
'SierpinskiCurve,arms=7',
'SierpinskiCurve,arms=8',
'TriangleSpiralSkewed',
'TriangleSpiralSkewed,n_start=37',
'TriangleSpiralSkewed,skew=right',
'TriangleSpiralSkewed,skew=right,n_start=37',
'TriangleSpiralSkewed,skew=up',
'TriangleSpiralSkewed,skew=up,n_start=37',
'TriangleSpiralSkewed,skew=down',
'TriangleSpiralSkewed,skew=down,n_start=37',
'DiagonalsOctant',
'DiagonalsOctant,direction=up',
'HIndexing',
'SierpinskiCurveStair',
'SierpinskiCurveStair,diagonal_length=2',
'SierpinskiCurveStair,diagonal_length=3',
'SierpinskiCurveStair,diagonal_length=4',
'SierpinskiCurveStair,arms=2',
'SierpinskiCurveStair,arms=3,diagonal_length=2',
'SierpinskiCurveStair,arms=4',
'SierpinskiCurveStair,arms=5',
'SierpinskiCurveStair,arms=6,diagonal_length=5',
'SierpinskiCurveStair,arms=7',
'SierpinskiCurveStair,arms=8',
'QuadricCurve',
'QuadricIslands',
'CfracDigits,radix=1',
'CfracDigits',
'CfracDigits,radix=3',
'CfracDigits,radix=4',
'CfracDigits,radix=37',
'RationalsTree,tree_type=L',
'RationalsTree,tree_type=HCS',
'RationalsTree',
'RationalsTree,tree_type=CW',
'RationalsTree,tree_type=AYT',
'RationalsTree,tree_type=Bird',
'RationalsTree,tree_type=Drib',
'WunderlichSerpentine,radix=2',
'WunderlichSerpentine',
'WunderlichSerpentine,serpentine_type=100_000_000',
'WunderlichSerpentine,serpentine_type=000_000_001',
'WunderlichSerpentine,radix=4',
'WunderlichSerpentine,radix=5,serpentine_type=coil',
'DigitGroups',
'DigitGroups,radix=3',
'DigitGroups,radix=4',
'DigitGroups,radix=5',
'DigitGroups,radix=37',
'QuintetReplicate',
'QuintetCurve',
'QuintetCurve,arms=2',
'QuintetCurve,arms=3',
'QuintetCurve,arms=4',
'QuintetCentres',
'QuintetCentres,arms=2',
'QuintetCentres,arms=3',
'QuintetCentres,arms=4',
'TriangleSpiral',
'TriangleSpiral,n_start=37',
# 'File',
'PixelRings',
'FilledRings',
'CretanLabyrinth',
'AR2W2Curve',
'AR2W2Curve,start_shape=D2',
'AR2W2Curve,start_shape=B2',
'AR2W2Curve,start_shape=B1rev',
'AR2W2Curve,start_shape=D1rev',
'AR2W2Curve,start_shape=A2rev',
'BetaOmega',
'KochelCurve',
'CincoCurve',
'WunderlichMeander',
'FibonacciWordFractal',
'DiamondSpiral',
'SquareReplicate',
# module list end
# cellular 0 to 255
(map {("CellularRule,rule=$_",
"CellularRule,rule=$_,n_start=0",
"CellularRule,rule=$_,n_start=37")} 0..255),
);
foreach (@modules) { s/^\*// }
{
require Math::NumSeq::PlanePathDelta;
require Math::NumSeq::PlanePathTurn;
require Math::NumSeq::PlanePathN;
foreach my $mod (@modules) {
next unless want_planepath($mod);
my $bad = 0;
foreach my $elem (
['Math::NumSeq::PlanePathDelta','delta_type'],
['Math::NumSeq::PlanePathCoord','coordinate_type'],
['Math::NumSeq::PlanePathTurn','turn_type'],
['Math::NumSeq::PlanePathN','line_type'],
) {
my ($class, $pname) = @$elem;
foreach my $param (@{$class->parameter_info_hash
->{$pname}->{'choices'}}) {
next unless want_coordinate($param);
MyTestHelpers::diag ("$mod $param");
### $mod
### $param
my $seq = $class->new (planepath => $mod,
$pname => $param);
my $planepath_object = $seq->{'planepath_object'};
### planepath_object: ref $planepath_object
my $i_start = $seq->i_start;
if (! defined $i_start) {
die "Oops, i_start=undef";
}
my $characteristic_integer = $seq->characteristic('integer') || 0;
my $saw_characteristic_integer = 1;
my $saw_characteristic_integer_at = '';
my $saw_values_min = 999999999;
my $saw_values_max = -999999999;
my $saw_values_min_at = 'sentinel';
my $saw_values_max_at = 'sentinel';
my $saw_increasing = 1;
my $saw_non_decreasing = 1;
my $saw_increasing_at = '[default]';
my $saw_non_decreasing_at = '[default]';
my $prev_value;
my $count = 0;
my $i_limit = 800;
if ($mod =~ /Vogel|Theod|Archim/
&& $param =~ /axis|[XY]_neg|diagonal/i) {
$i_limit = 20;
}
if ($mod =~ /Hypot|PixelRings|FilledRings/
&& $param =~ /axis|[XY]_neg|diagonal/i) {
$i_limit = 50;
}
if ($mod =~ /CellularRule/
&& $param =~ /axis|[XY]_neg|diagonal/i) {
$i_limit = 80;
}
my $i_end = $i_start + $i_limit;
### $i_limit
my @i_extra;
if (my $delta_type = $seq->{'delta_type'}) {
foreach my $m ('min','max') {
if (my $coderef = $planepath_object->can("_NumSeq_Delta_${delta_type}_${m}_n")) {
push @i_extra, $planepath_object->$coderef();
}
}
}
foreach my $i ($i_start .. $i_end, @i_extra) {
my $value = $seq->ith($i);
### $i
### $value
next if ! defined $value;
$count++;
if ($saw_characteristic_integer) {
if ($value != int($value)) {
$saw_characteristic_integer = 0;
$saw_characteristic_integer_at = "i=$i value=$value";
}
}
if ($value < $saw_values_min) {
$saw_values_min = $value;
if (my ($x,$y) = $seq->{'planepath_object'}->n_to_xy($i)) {
$saw_values_min_at = "i=$i xy=$x,$y";
} else {
$saw_values_min_at = "i=$i";
}
}
if ($value > $saw_values_max) {
$saw_values_max = $value;
$saw_values_max_at = "i=$i";
}
# ### $value
# ### $prev_value
if (defined $prev_value) {
if (abs($value - $prev_value) < 0.0000001) {
$prev_value = $value;
}
if ($value <= $prev_value
&& ! is_nan($prev_value)
&& ! ($value==pos_infinity() && $prev_value==pos_infinity())) {
# ### not increasing ...
if ($saw_increasing) {
$saw_increasing = 0;
$saw_increasing_at = "i=$i value=$value prev_value=$prev_value";
}
if ($value < $prev_value) {
if ($saw_non_decreasing) {
$saw_non_decreasing = 0;
$saw_non_decreasing_at = "i=$i";
}
}
}
}
$prev_value = $value;
}
### $count
next if $count == 0;
### $saw_values_min
### $saw_values_min_at
### $saw_values_max
### $saw_values_max_at
my $values_min = $seq->values_min;
my $values_max = $seq->values_max;
if (! defined $values_min) {
if ($saw_values_min >= -3 && $count >= 3) {
MyTestHelpers::diag ("$mod $param values_min=undef vs saw_values_min=$saw_values_min apparent lower bound at $saw_values_min_at");
}
$values_min = $saw_values_min;
}
if (! defined $values_max) {
if ($saw_values_max <= 3 && $count >= 3) {
MyTestHelpers::diag ("$mod $param values_max=undef vs saw_values_max=$saw_values_max apparent upper bound at $saw_values_max_at");
}
$values_max = $saw_values_max;
}
if (my $coderef = $planepath_object->can("_NumSeq_${param}_max_is_supremum")) {
if ($planepath_object->$coderef) {
if ($saw_values_max == $values_max) {
MyTestHelpers::diag ("$mod $param values_max=$values_max vs saw_values_max=$saw_values_max at $saw_values_max_at supposed to be supremum only");
MyTestHelpers::diag (" (planepath_object ",ref $seq->{'planepath_object'},")");
$bad++;
}
if ($saw_values_max < $values_max) {
$saw_values_max = $values_max;
$saw_values_max_at = 'supremum';
}
}
}
if (my $coderef = $planepath_object->can("_NumSeq_${param}_min_is_infimum")) {
if ($planepath_object->$coderef()) {
if ($saw_values_min == $values_min) {
MyTestHelpers::diag ("$mod $param values_min=$values_min vs saw_values_min=$saw_values_min at $saw_values_min_at supposed to be infimum only");
MyTestHelpers::diag (" (planepath_object ",ref $seq->{'planepath_object'},")");
}
if ($saw_values_min > $values_min) {
$saw_values_min = $values_min;
$saw_values_min_at = 'infimum';
}
}
}
# these come arbitrarily close to dX==dY, in general, probably
if (($mod eq 'MultipleRings,step=2'
|| $mod eq 'MultipleRings,step=3'
|| $mod eq 'MultipleRings,step=5'
|| $mod eq 'MultipleRings,step=7'
|| $mod eq 'MultipleRings,step=37'
)
&& $param eq 'AbsDiff'
&& $saw_values_min > 0 && $saw_values_min < 0.3) {
$saw_values_min = 0;
$saw_values_min_at = 'override';
}
# supremum +/- 1 without ever actually reaching
if (($mod eq 'MultipleRings'
)
&& ($param eq 'dX'
|| $param eq 'dY'
)) {
$saw_values_min = -1;
$saw_values_min_at = 'override';
}
# if (($mod eq 'MultipleRings,step=1'
# || $mod eq 'MultipleRings,step=2'
# || $mod eq 'MultipleRings,step=3'
# || $mod eq 'MultipleRings,step=4'
# || $mod eq 'MultipleRings,step=5'
# || $mod eq 'MultipleRings,step=6'
# || $mod eq 'MultipleRings'
# )
# && ($param eq 'dX'
# || $param eq 'dY'
# || $param eq 'Dist'
# )) {
# my ($step) = ($mod =~ /MultipleRings,step=(\d+)/);
# $step ||= 6;
# if (-$saw_values_min > 2*PI()/$step*0.85
# && -$saw_values_min < 2*PI()/$step) {
# $saw_values_min = -2*PI() / $step;
# $saw_values_min_at = 'override';
# }
# if ($saw_values_max > 2*PI()/$step*0.85
# && $saw_values_max < 2*PI()/$step) {
# $saw_values_max = 2*PI() / $step;
# $saw_values_max_at = 'override';
# }
# }
if (($mod eq 'MultipleRings,step=7'
|| $mod eq 'MultipleRings,step=8'
)
&& ($param eq 'dY'
)) {
if (-$saw_values_min > 0.9
&& -$saw_values_min < 1) {
$saw_values_min = -1;
$saw_values_min_at = 'override';
}
if ($saw_values_max > 0.9
&& $saw_values_max < 1) {
$saw_values_max = 1;
$saw_values_max_at = 'override';
}
}
if (($mod eq 'MultipleRings,step=7'
|| $mod eq 'MultipleRings,step=8'
)
&& ($param eq 'dX'
)) {
if (-$saw_values_min > 0.9
&& -$saw_values_min < 1) {
$saw_values_min = -1;
$saw_values_min_at = 'override';
}
}
# approach 360 without ever actually reaching
if (($mod eq 'SacksSpiral'
|| $mod eq 'TheodorusSpiral'
|| $mod eq 'Hypot'
|| $mod eq 'MultipleRings,step=8'
|| $mod eq 'MultipleRings,step=37'
)
&& ($param eq 'Dir4'
)
&& $saw_values_max > 3.7 && $saw_values_max < 4
) {
$saw_values_max = 4;
$saw_values_max_at = 'override';
}
if (($mod eq 'SacksSpiral'
|| $mod eq 'TheodorusSpiral'
|| $mod eq 'Hypot'
|| $mod eq 'MultipleRings,step=8'
|| $mod eq 'MultipleRings,step=37'
)
&& ($param eq 'TDir6'
)
&& $saw_values_max > 5.55 && $saw_values_max < 6) {
$saw_values_max = 6;
$saw_values_max_at = 'override';
}
# approach 0 without ever actually reaching
if (($mod eq 'MultipleRings,step=8'
|| $mod eq 'MultipleRings,step=37'
)
&& ($param eq 'Dir4'
)) {
$saw_values_min = 0;
$saw_values_min_at = 'override';
}
if (($mod eq 'MultipleRings,step=8'
|| $mod eq 'MultipleRings,step=37'
)
&& ($param eq 'TDir6'
)) {
$saw_values_min = 0;
$saw_values_min_at = 'override';
}
# not enough values to see these decreasing
if (($mod eq 'SquareSpiral,wider=37'
)
&& ($param eq 'dY')) {
$saw_values_min = -1;
$saw_values_min_at = 'override';
}
if (($mod eq 'SquareSpiral,wider=37'
)
&& ($param eq 'Dir4')) {
$saw_values_max = 3;
$saw_values_max_at = 'override';
}
if (($mod eq 'SquareSpiral,wider=37'
)
&& ($param eq 'TDir6')) {
$saw_values_max = 4.5;
$saw_values_max_at = 'override';
}
# not enough values to see near supremum
if (($mod eq 'ZOrderCurve,radix=37'
)
&& ($param eq 'Dir4'
|| $param eq 'TDir6'
)) {
$saw_values_max = $values_max;
$saw_values_max_at = 'override';
}
# Turn4 maximum is at N=radix*radix-1
if (($mod eq 'ZOrderCurve,radix=37'
&& $param eq 'Turn4'
&& $i_end < 37*37-1
)) {
$saw_values_max = $values_max;
$saw_values_max_at = 'override';
}
# Turn4 maximum is at N=8191
if (($mod eq 'LCornerReplicate'
&& $param eq 'Turn4'
&& $i_end < 8191
)) {
$saw_values_max = $values_max;
$saw_values_max_at = 'override';
}
if (abs ($values_min - $saw_values_min) > 0.001) {
MyTestHelpers::diag ("$mod $param values_min=$values_min vs saw_values_min=$saw_values_min at $saw_values_min_at (to i_end=$i_end)");
MyTestHelpers::diag (" (planepath_object ",ref $seq->{'planepath_object'},")");
$bad++;
}
if (abs ($values_max - $saw_values_max) > 0.001) {
MyTestHelpers::diag ("$mod $param values_max=$values_max vs saw_values_max=$saw_values_max at $saw_values_max_at (to i_end=$i_end)");
MyTestHelpers::diag (" (planepath_object ",ref $seq->{'planepath_object'},")");
$bad++;
}
#-------------------
my $increasing = $seq->characteristic('increasing');
my $non_decreasing = $seq->characteristic('non_decreasing');
$increasing ||= 0;
$non_decreasing ||= 0;
# not enough values to see these decreasing
if ($mod eq 'DigitGroups,radix=37'
&& $param eq 'Radius'
&& $i_end < 37*37) {
$saw_characteristic_integer = 0;
}
# not enough values to see these decreasing
if (($mod eq 'ZOrderCurve,radix=9'
|| $mod eq 'ZOrderCurve,radix=37'
|| $mod eq 'PeanoCurve,radix=17'
|| $mod eq 'DigitGroups,radix=37'
|| $mod eq 'SquareSpiral,wider=37'
|| $mod eq 'HexSpiral,wider=37'
|| $mod eq 'HexSpiralSkewed,wider=37'
|| $mod eq 'ComplexPlus,realpart=2'
|| $mod eq 'ComplexPlus,realpart=3'
|| $mod eq 'ComplexPlus,realpart=4'
|| $mod eq 'ComplexPlus,realpart=5'
|| $mod eq 'ComplexMinus,realpart=3'
|| $mod eq 'ComplexMinus,realpart=4'
|| $mod eq 'ComplexMinus,realpart=5'
)
&& ($param eq 'Y'
|| $param eq 'Product')) {
$saw_increasing_at = 'override';
$saw_increasing = 0;
$saw_non_decreasing = 0;
}
# not enough values to see these decreasing
if (($mod eq 'ComplexPlus,realpart=2'
|| $mod eq 'ComplexPlus,realpart=3'
|| $mod eq 'ComplexPlus,realpart=4'
|| $mod eq 'ComplexPlus,realpart=5'
|| $mod eq 'ComplexMinus,realpart=5'
|| $mod eq 'TerdragonMidpoint'
|| $mod eq 'TerdragonMidpoint,arms=2'
|| $mod eq 'TerdragonMidpoint,arms=3'
|| $mod eq 'TerdragonCurve'
|| $mod eq 'TerdragonCurve,arms=2'
|| $mod eq 'TerdragonCurve,arms=3'
|| $mod eq 'TerdragonRounded'
|| $mod eq 'Flowsnake'
|| $mod eq 'Flowsnake,arms=2'
|| $mod eq 'FlowsnakeCentres'
|| $mod eq 'FlowsnakeCentres,arms=2'
|| $mod eq 'GosperSide'
|| $mod eq 'GosperIslands'
|| $mod eq 'QuintetCentres'
|| $mod eq 'QuintetCentres,arms=2'
|| $mod eq 'QuintetCentres,arms=3'
)
&& ($param eq 'X_axis'
|| $param eq 'Y_axis'
|| $param eq 'X_neg'
|| $param eq 'Y_neg'
|| $param =~ /Diagonal/
)) {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
if ($mod eq 'QuintetCurve'
&& $i_end < 5938 # first decrease
&& $param eq 'Diagonal_SE') {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
if ($mod eq 'QuintetCentres'
&& $i_end < 5931 # first decreasing
&& $param eq 'Diagonal_SE') {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
if ($mod eq 'ImaginaryBase,radix=37'
&& $i_end < 1369 # N of first Y coordinate decrease
&& $param eq 'Y') {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
# if ($mod eq 'ImaginaryBase,radix=37'
# $param eq 'Diagonal_NW'
# || $param eq 'Diagonal_NW'
# || $param eq 'Diagonal_SS'
# || $param eq 'Diagonal_SE')
# && $i_end < 74) {
# $saw_increasing = 0;
# $saw_increasing_at = 'override';
# $saw_non_decreasing = 0;
# }
if ($mod eq 'ImaginaryHalf,radix=37'
&& $i_end < 1369 # N of first Y coordinate decrease
&& $param eq 'Y') {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
if ($mod eq 'ImaginaryHalf,radix=37'
&& $i_end < 99974 # first decrease
&& $param eq 'Diagonal') {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
if ($mod eq 'ImaginaryHalf,radix=37'
&& $i_end < 2702 # first decreasing
&& $param eq 'Diagonal_NW') {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
# not enough values to see these decreasing
if (($mod eq 'DigitGroups,radix=37'
)
&& ($param eq 'X_axis'
|| $param eq 'Y_axis'
)) {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
# not enough values to see these decreasing
if (($mod eq 'PeanoCurve,radix=2'
|| $mod eq 'PeanoCurve,radix=4'
|| $mod eq 'PeanoCurve,radix=5'
|| $mod eq 'PeanoCurve,radix=17'
)
&& ($param eq 'Diagonal'
)) {
$saw_increasing = 0;
$saw_increasing_at = 'override';
$saw_non_decreasing = 0;
}
if (($mod eq 'SquareSpiral,wider=37'
)
&& ($param eq 'Dir4'
|| $param eq 'TDir6')) {
$saw_non_decreasing = 0;
}
if ($count > 1 && $increasing ne $saw_increasing) {
MyTestHelpers::diag ("$mod $param increasing=$increasing vs saw_increasing=$saw_increasing at $saw_increasing_at (to i_end=$i_end)");
MyTestHelpers::diag (" (planepath_object ",ref $seq->{'planepath_object'},")");
$bad++;
}
if ($count > 1 && $non_decreasing ne $saw_non_decreasing) {
MyTestHelpers::diag ("$mod $param non_decreasing=$non_decreasing vs saw_non_decreasing=$saw_non_decreasing at $saw_non_decreasing_at (to i_end=$i_end)");
MyTestHelpers::diag (" (planepath_object ",ref $seq->{'planepath_object'},")");
$bad++;
}
if ($characteristic_integer != $saw_characteristic_integer) {
MyTestHelpers::diag ("$mod $param characteristic_integer=$characteristic_integer vs saw_characteristic_integer=$saw_characteristic_integer at $saw_characteristic_integer_at");
MyTestHelpers::diag (" (planepath_object ",ref $seq->{'planepath_object'},")");
$bad++;
}
}
}
ok ($bad, 0);
}
}
#------------------------------------------------------------------------------
sub is_nan {
my ($x) = @_;
return !($x==$x);
}
exit 0;
Math-PlanePath-122/xt/slow/AlternatePaper-slow.t 0000644 0001750 0001750 00000015556 12451431554 017414 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 87;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use lib 'xt';
use MyOEIS;
use Memoize;
# uncomment this to run the ### lines
# use Smart::Comments;
use Math::PlanePath::AlternatePaper;
my $path = Math::PlanePath::AlternatePaper->new;
#------------------------------------------------------------------------------
# right boundary N
{
my $bad = 0;
foreach my $arms (1 .. 8) {
my $path = Math::PlanePath::AlternatePaper->new (arms => $arms);
my $i = 0;
foreach my $n (0 .. 4**6-1) {
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n + $arms);
my $want_pred = path_xyxy_is_right_boundary($path, $x1,$y1, $x2,$y2) ? 1 : 0;
my $got_pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n) ? 1 : 0;
unless ($want_pred == $got_pred) {
MyTestHelpers::diag ("oops, _UNDOCUMENTED__n_segment_is_right_boundary() arms=$arms n=$n pred traverse=$want_pred method=$got_pred");
last if $bad++ > 10;
}
}
}
ok ($bad, 0);
}
# Return true if line segment $x1,$y1 to $x2,$y2 is on the right boundary.
# Assumes a square grid and every enclosed unit square has all 4 sides.
sub path_xyxy_is_right_boundary {
my ($path, $x1,$y1, $x2,$y2) = @_;
### path_xyxy_is_right_boundary() ...
my $dx = $x2-$x1;
my $dy = $y2-$y1;
($dx,$dy) = ($dy,-$dx); # rotate -90
### one: "$x1,$y1 to ".($x1+$dx).",".($y1+$dy)
### two: "$x2,$y2 to ".($x2+$dx).",".($y2+$dy)
return (! defined $path->xyxy_to_n_either ($x1,$y1, $x1+$dx,$y1+$dy)
|| ! defined $path->xyxy_to_n_either ($x2,$y2, $x2+$dx,$y2+$dy)
|| ! defined $path->xyxy_to_n_either ($x1+$dx,$y1+$dy, $x2+$dx,$y2+$dy));
}
#------------------------------------------------------------------------------
# left boundary N
{
my $bad = 0;
foreach my $arms (4 .. 8) {
my $path = Math::PlanePath::AlternatePaper->new (arms => $arms);
my $i = 0;
foreach my $n (0 .. 4**6-1) {
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n + $arms);
my $want_pred = path_xyxy_is_left_boundary($path, $x1,$y1, $x2,$y2) ? 1 : 0;
my $got_pred = $path->_UNDOCUMENTED__n_segment_is_left_boundary($n) ? 1 : 0;
unless ($want_pred == $got_pred) {
MyTestHelpers::diag ("oops, _UNDOCUMENTED__n_segment_is_left_boundary() arms=$arms n=$n pred traverse=$want_pred method=$got_pred");
last if $bad++ > 10;
}
}
}
ok ($bad, 0);
}
# Return true if line segment $x1,$y1 to $x2,$y2 is on the left boundary.
# Assumes a square grid and every enclosed unit square has all 4 sides.
sub path_xyxy_is_left_boundary {
my ($path, $x1,$y1, $x2,$y2) = @_;
my $dx = $x2-$x1;
my $dy = $y2-$y1;
($dx,$dy) = (-$dy,$dx); # rotate +90
return (! defined ($path->xyxy_to_n_either ($x1,$y1, $x1+$dx,$y1+$dy))
|| ! defined ($path->xyxy_to_n_either ($x2,$y2, $x2+$dx,$y2+$dy))
|| ! defined ($path->xyxy_to_n_either ($x1+$dx,$y1+$dy, $x2+$dx,$y2+$dy)));
}
#------------------------------------------------------------------------------
# boundary lengths
sub B_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit);
return scalar(@$points);
}
memoize('B_from_path');
sub L_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'left');
return scalar(@$points) - 1;
}
memoize('L_from_path');
sub R_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'right');
return scalar(@$points) - 1;
}
BEGIN { memoize('R_from_path'); }
#------------------------------------------------------------------------------
# B boundary
{
# _UNDOCUMENTED_level_to_line_boundary()
# is sum left and right
foreach my $k (0 .. 14) {
my $got = $path->_UNDOCUMENTED_level_to_line_boundary($k);
my $want = ($path->_UNDOCUMENTED_level_to_right_line_boundary($k)
+ $path->_UNDOCUMENTED_level_to_left_line_boundary($k));
ok ($got, $want, "boundary sum k=$k");
}
}
{
# _UNDOCUMENTED_level_to_line_boundary()
foreach my $k (0 .. 14) {
my $got = $path->_UNDOCUMENTED_level_to_line_boundary($k);
my $want = B_from_path($path,$k);
ok ($got, $want, "_UNDOCUMENTED_level_to_line_boundary() k=$k");
}
}
#------------------------------------------------------------------------------
# L
{
# _UNDOCUMENTED_level_to_left_line_boundary()
foreach my $k (0 .. 14) {
my $got = $path->_UNDOCUMENTED_level_to_left_line_boundary($k);
my $want = L_from_path($path,$k);
ok ($got, $want, "_UNDOCUMENTED_level_to_left_line_boundary() k=$k");
}
}
#------------------------------------------------------------------------------
# R
{
# _UNDOCUMENTED_level_to_right_line_boundary()
foreach my $k (0 .. 14) {
my $got = $path->_UNDOCUMENTED_level_to_right_line_boundary($k);
my $want = R_from_path($path,$k);
ok ($got, $want, "_UNDOCUMENTED_level_to_right_line_boundary() k=$k");
}
}
#------------------------------------------------------------------------------
# convex hull area
{
require Math::Geometry::Planar;
my @points;
my $n = $path->n_start;
foreach my $k (0 .. 14) {
my $n_end = 2**$k;
while ($n <= $n_end) {
push @points, [ $path->n_to_xy($n) ];
$n++;
}
my ($want_area, $want_boundary);
if ($k == 0) {
# N=0 to N=1
$want_area = 0;
} else {
my $polygon = Math::Geometry::Planar->new;
$polygon->points([@points]);
if (@points > 3) {
$polygon = $polygon->convexhull2;
### convex: $polygon
}
$want_area = $polygon->area;
}
my $got_area = $path->_UNDOCUMENTED_level_to_hull_area($k);
ok ($got_area, $want_area, "k=$k");
}
}
sub to_sqrt2_parts {
my ($x) = @_;
if (! defined $x) { return $x; }
foreach my $b (0 .. int($x)) {
my $a = $x - $b*sqrt(2);
my $a_int = int($a+.5);
if (abs($a - $a_int) < 0.00000001) {
return $a_int, $b;
}
}
return (undef,undef);
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/GcdRationals-slow.t 0000644 0001750 0001750 00000007176 12136177164 017062 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 637;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# uncomment this to run the ### lines
#use Smart::Comments;
require Math::PlanePath::GcdRationals;
my @pairs_order_choices
= @{Math::PlanePath::GcdRationals->parameter_info_hash
->{'pairs_order'}->{'choices'}};
#------------------------------------------------------------------------------
# rect_to_n_range()
my $bad = 0;
my $y_min = 1;
my $y_max = 50;
my $x_min = 1;
my $x_max = 50;
foreach my $pairs_order (@pairs_order_choices) {
my $path = Math::PlanePath::GcdRationals->new (pairs_order => $pairs_order);
my $n_start = $path->n_start;
my $report = sub {
MyTestHelpers::diag("$pairs_order ",@_);
$bad++;
};
my %data;
my $data_count;
foreach my $x ($x_min .. $x_max) {
foreach my $y ($y_min .. $y_max) {
my $n = $path->xy_to_n ($x, $y);
$data{$y}{$x} = $n;
$data_count += defined $n;
}
}
MyTestHelpers::diag("$pairs_order data_count ",$data_count);
foreach my $y1 ($y_min .. $y_max) {
foreach my $y2 ($y1 .. $y_max) {
foreach my $x1 ($x_min .. $x_max) {
my $min;
my $max;
foreach my $x2 ($x1 .. $x_max) {
my @col = map {$data{$_}{$x2}} $y1 .. $y2;
@col = grep {defined} @col;
$min = min (grep {defined} $min, @col);
$max = max (grep {defined} $max, @col);
my $want_min = (defined $min ? $min : 1);
my $want_max = (defined $max ? $max : 0);
### @col
### rect: "$x1,$y1 $x2,$y2 expect N=$want_min..$want_max"
my ($got_min, $got_max)
= $path->rect_to_n_range ($x1,$y1, $x2,$y2);
defined $got_min
or &$report ("rect_to_n_range($x1,$y1, $x2,$y2) got_min undef");
defined $got_max
or &$report ("rect_to_n_range($x1,$y1, $x2,$y2) got_max undef");
$got_min >= $n_start
or &$report ("rect_to_n_range() got_min=$got_min is before n_start=$n_start");
if (! defined $min || ! defined $max) {
next; # outside
}
unless ($got_min <= $want_min) {
### $x1
### $y1
### $x2
### $y2
### got: $path->rect_to_n_range ($x1,$y1, $x2,$y2)
### $want_min
### $want_max
### $got_min
### $got_max
### @col
### $data
&$report ("rect_to_n_range($x1,$y1, $x2,$y2) bad min got_min=$got_min want_min=$want_min".(defined $min ? '' : '[nomin]')
);
}
unless ($got_max >= $want_max) {
&$report ("rect_to_n_range($x1,$y1, $x2,$y2 ) bad max got $got_max want $want_max".(defined $max ? '' : '[nomax]'));
}
}
}
}
}
}
ok ($bad, 0);
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/CellularRule-slow.t 0000644 0001750 0001750 00000010671 12272073126 017067 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 637;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# uncomment this to run the ### lines
#use Smart::Comments;
require Math::PlanePath::CellularRule;
#------------------------------------------------------------------------------
# rules_are_equiv()
sub paths_are_equiv {
my ($path1, $path2) = @_;
foreach my $y (0 .. 6) {
foreach my $x (-$y .. $y) {
if ((!! $path1->xy_is_visited($x,$y))
!= (!! $path2->xy_is_visited($x,$y))) {
return 0;
}
}
}
return 1;
}
foreach my $rule1 (0 .. 255) {
my $path1 = Math::PlanePath::CellularRule->new (rule => $rule1);
foreach my $rule2 (0 .. 255) {
my $path2 = Math::PlanePath::CellularRule->new (rule => $rule2);
my $got = Math::PlanePath::CellularRule->_NOTWORKING__rules_are_equiv($rule1,$rule2) ? 1 : 0;
my $want = paths_are_equiv($path1,$path2);
ok ($got, $want, "rules_are_equiv($rule1,$rule2)");
if ($got != $want) {
MyTestHelpers::diag(path_str($path1));
MyTestHelpers::diag(path_str($path2));
}
}
}
#------------------------------------------------------------------------------
# rule_to_mirror()
sub paths_are_mirror {
my ($path1, $path2) = @_;
foreach my $y (0 .. 6) {
foreach my $x (-$y .. $y) {
if ((!!$path1->xy_is_visited($x,$y))
!= (!!$path2->xy_is_visited(-$x,$y))) {
return 0;
}
}
}
return 1;
}
foreach my $rule (0 .. 255) {
my $mirror_rule = Math::PlanePath::CellularRule->_UNDOCUMENTED__rule_to_mirror($rule);
my $path1 = Math::PlanePath::CellularRule->new (rule => $rule);
my $path2 = Math::PlanePath::CellularRule->new (rule => $mirror_rule);
my $are_mirror = paths_are_mirror($path1,$path2);
ok ($are_mirror, 1, "rule_to_mirror() rule=$rule got_rule=$mirror_rule");
if (! $are_mirror) {
MyTestHelpers::diag(path_str($path1));
MyTestHelpers::diag(path_str($path2));
}
}
#------------------------------------------------------------------------------
# rule_is_finite()
sub path_is_finite {
my ($path) = @_;
foreach my $y (4 .. 6) {
foreach my $x (-$y .. $y) {
if ($path->xy_is_visited($x,$y)) {
return 0;
}
}
}
return 1;
}
foreach my $rule (0 .. 255) {
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my $got = Math::PlanePath::CellularRule->_UNDOCUMENTED__rule_is_finite($rule) ? 1 : 0;
my $want = path_is_finite($path) ? 1 : 0;
ok ($got, $want, "rule_is_finite() rule=$rule");
if ($got != $want) {
MyTestHelpers::diag (path_str($path));
}
}
#------------------------------------------------------------------------------
# rule_is_symmetric()
sub path_is_symmetric {
my ($path) = @_;
foreach my $y (1 .. 8) {
foreach my $x (1 .. $y) {
if ((!!$path->xy_is_visited($x,$y)) != (!!$path->xy_is_visited(-$x,$y))) {
return 0;
}
}
}
return 1;
}
foreach my $rule (0 .. 255) {
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my $got_symmetric = Math::PlanePath::CellularRule->_NOTWORKING__rule_is_symmetric($rule) ? 1 : 0;
my $want_symmetric = path_is_symmetric($path) ? 1 : 0;
ok ($got_symmetric, $want_symmetric, "rule_is_symmetric() rule=$rule");
if ($got_symmetric != $want_symmetric) {
MyTestHelpers::diag (path_str($path));
}
}
sub path_str {
my ($path) = @_;
my $str = '';
foreach my $y (reverse 0 .. 6) {
$str .= "$y ";
foreach my $x (-6 .. 6) {
$str .= $path->xy_is_visited($x,$y) ? ' *' : ' ';
}
if ($y == 6) {
$str .= " rule=$path->{'rule'} = ".sprintf('%08b',$path->{'rule'});
}
$str .= "\n";
}
return $str;
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/slow/CCurve-slow.t 0000644 0001750 0001750 00000011100 12303231756 015647 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min','max';
use Test;
plan tests => 87;
use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use lib 'xt';
use MyOEIS;
use Memoize;
# uncomment this to run the ### lines
# use Smart::Comments;
use Math::PlanePath::CCurve;
my $path = Math::PlanePath::CCurve->new;
#------------------------------------------------------------------------------
# convex hull
{
require Math::Geometry::Planar;
my @points;
my $n = $path->n_start;
foreach my $k (0 .. 14) {
my $n_end = 2**$k;
while ($n <= $n_end) {
push @points, [ $path->n_to_xy($n) ];
$n++;
}
my ($want_area, $want_boundary);
if ($k == 0) {
# N=0 to N=1
$want_area = 0;
$want_boundary = 2;
} else {
my $polygon = Math::Geometry::Planar->new;
$polygon->points([@points]);
if (@points > 3) {
$polygon = $polygon->convexhull2;
### convex: $polygon
}
$want_area = $polygon->area;
$want_boundary = $polygon->perimeter;
}
my ($want_a,$want_b) = to_sqrt2_parts($want_boundary);
my $got_boundary = $path->_UNDOCUMENTED_level_to_hull_boundary($k);
my ($got_a,$got_b) = $path->_UNDOCUMENTED_level_to_hull_boundary_sqrt2($k);
ok ($got_a, $want_a, "k=$k");
ok ($got_b, $want_b, "k=$k");
ok (abs($got_boundary - $want_boundary) < 0.00001, 1);
my $got_area = $path->_UNDOCUMENTED_level_to_hull_area($k);
ok ($got_area, $want_area, "k=$k");
}
}
sub to_sqrt2_parts {
my ($x) = @_;
if (! defined $x) { return $x; }
foreach my $b (0 .. int($x)) {
my $a = $x - $b*sqrt(2);
my $a_int = int($a+.5);
if (abs($a - $a_int) < 0.00000001) {
return $a_int, $b;
}
}
return (undef,undef);
}
#------------------------------------------------------------------------------
# boundary lengths
sub B_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit);
return scalar(@$points);
}
memoize('B_from_path');
sub L_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'left');
return scalar(@$points) - 1;
}
memoize('L_from_path');
sub R_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'right');
return scalar(@$points) - 1;
}
memoize('R_from_path');
# R[k] = 2*R[k-1] + R[k-2] - 4*R[k-3] + 2*R[k-4]
sub R_recurrence {
my ($recurrence, $k) = @_;
if ($k <= 0) { return 1; }
if ($k == 1) { return 2; }
if ($k == 2) { return 4; }
if ($k == 3) { return 8; }
return (2*R_recurrence($k-4)
- 4*R_recurrence($k-3)
+ R_recurrence($k-2)
+ 2*R_recurrence($k-1));
}
memoize('R_from_path');
#------------------------------------------------------------------------------
# R
{
# POD samples
my @want = (1, 2, 4, 8, 14, 24, 38, 60, 90, 136, 198, 292, 418);
foreach my $k (0 .. $#want) {
my $got = R_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
{
# recurrence
my @want = (1, 2, 4, 8, 14, 24, 38, 60, 90, 136, 198, 292, 418);
foreach my $k (0 .. $#want) {
my $got = R_from_path($path,$k);
my $want = $want[$k];
ok ($got,$want);
}
}
#------------------------------------------------------------------------------
# claimed in the pod N overlaps always have different count 1-bits mod 4
{
foreach my $n (0 .. 100_000) {
my ($x,$y) = $path->n_to_xy($n);
my @n_list = $path->xy_to_n_list($x,$y);
my @seen;
foreach my $n (@n_list) {
my $c = count_1_bits($n) % 4;
if ($seen[$c]++) {
die;
}
}
}
ok (1,1);
}
sub count_1_bits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += ($n & 1);
$n >>= 1;
}
return $count;
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/GrayCode-oseq.t 0000644 0001750 0001750 00000027377 12201357501 015175 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::Prime::XS 0.23 'is_prime'; # version 0.23 fix for 1928099
use Test;
plan tests => 13;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh',
'digit_join_lowtohigh';
use Math::PlanePath::GrayCode;
use Math::PlanePath::Diagonals;
# uncomment this to run the ### lines
#use Smart::Comments '###';
sub numeq_array {
my ($a1, $a2) = @_;
if (! ref $a1 || ! ref $a2) {
return 0;
}
my $i = 0;
while ($i < @$a1 && $i < @$a2) {
if ($a1->[$i] ne $a2->[$i]) {
return 0;
}
$i++;
}
return (@$a1 == @$a2);
}
sub to_binary_gray {
my ($n, $radix) = @_;
my $digits = [ digit_split_lowtohigh($n,2) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,2);
return digit_join_lowtohigh($digits,2);
}
#------------------------------------------------------------------------------
# A048641 - binary gray cumulative sum
{
my $anum = 'A048641';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
my $cumulative = 0;
for (my $n = 0; @got < @$bvalues; $n++) {
$cumulative += to_binary_gray($n);
push @got, $cumulative;
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - binary gray cumulative sum");
}
#------------------------------------------------------------------------------
# A048644 - binary gray cumulative sum difference from triangular(n)
{
my $anum = 'A048644';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
my $cumulative = 0;
for (my $n = 0; @got < @$bvalues; $n++) {
$cumulative += to_binary_gray($n);
push @got, $cumulative - triangular($n);
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - binary gray cumulative sum");
}
sub triangular {
my ($n) = @_;
return $n*($n+1)/2;
}
#------------------------------------------------------------------------------
# A048642 - binary gray cumulative product
{
my $anum = 'A048642';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
require Math::BigInt;
my $product = Math::BigInt->new(1);
for (my $n = 0; @got < @$bvalues; $n++) {
$product *= (to_binary_gray($n) || 1);
push @got, $product;
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - binary gray cumulative product");
}
#------------------------------------------------------------------------------
# A048643 - binary gray cumulative product, diff to factorial(n)
{
my $anum = 'A048643';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
require Math::BigInt;
my $product = Math::BigInt->new(1);
my $factorial = Math::BigInt->new(1);
for (my $n = 0; @got < @$bvalues; $n++) {
$product *= (to_binary_gray($n) || 1);
$factorial *= ($n||1);
push @got, $product - $factorial;
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - binary gray cumulative product");
}
#------------------------------------------------------------------------------
# A143329 - gray(prime(n)) which is prime too
{
my $anum = 'A143329';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
my $diff;
if ($bvalues) {
for (my $n = 0; @got < @$bvalues; $n++) {
next unless is_prime($n);
my $gray = to_binary_gray($n);
next unless is_prime($gray);
push @got, $gray;
}
$diff = MyOEIS::diff_nums(\@got, $bvalues);
if ($diff) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..45]));
MyTestHelpers::diag ("got: ",join(',',@got[0..45]));
}
}
skip (! $bvalues,
$diff, undef,
"$anum - gray(prime(n)) which is prime too");
}
#------------------------------------------------------------------------------
# A143292 - binary gray of primes
{
my $anum = 'A143292';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
for (my $n = 0; @got < @$bvalues; $n++) {
next unless is_prime($n);
push @got, to_binary_gray($n);
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - binary gray of primes");
}
#------------------------------------------------------------------------------
# A005811 - count 1 bits in gray(n), is num runs
{
my $anum = 'A005811';
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
for (my $n = 0; @got < @$bvalues; $n++) {
my $gray = to_binary_gray($n);
push @got, count_1_bits($gray);
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - primes for which binary gray is also prime");
}
sub count_1_bits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += ($n & 1);
$n >>= 1;
}
return $count;
}
#------------------------------------------------------------------------------
# A173318 - cumulative count 1 bits in gray(n) ie. of A005811
{
my $anum = 'A173318';
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
my $cumulative = 0;
for (my $n = 0; @got < @$bvalues; $n++) {
$cumulative += count_1_bits(to_binary_gray($n));
push @got, $cumulative;
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - primes for which binary gray is also prime");
}
#------------------------------------------------------------------------------
# A099891 -- triangle cumulative XOR
#
{
my $anum = 'A099891';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
my @array;
for (my $y = 0; @got < @$bvalues; $y++) {
my $gray = to_binary_gray($y,$radix);
push @array, [ $gray ];
for (my $x = 1; $x <= $y; $x++) {
$array[$y][$x] = $array[$y-1][$x-1] ^ $array[$y][$x-1];
}
for (my $x = 0; $x <= $y && @got < @$bvalues; $x++) {
push @got, $array[$y][$x];
}
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..10]));
MyTestHelpers::diag ("got: ",join(',',@got[0..10]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1);
}
#------------------------------------------------------------------------------
# A195467 -- diagonals powered permutation, starting from perm^0=identity
#
{
my $anum = 'A195467';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
require Math::PlanePath::Diagonals;
my $diagonal_path = Math::PlanePath::Diagonals->new;
for (my $n = $diagonal_path->n_start; @got < @$bvalues; $n++) {
my ($x, $y) = $diagonal_path->n_to_xy ($n);
my $digits = [ digit_split_lowtohigh($y,$radix) ];
foreach (1 .. $x) { # x=0 unpermuted
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,$radix);
}
push @got, digit_join_lowtohigh($digits,$radix);
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..10]));
MyTestHelpers::diag ("got: ",join(',',@got[0..10]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1);
}
#------------------------------------------------------------------------------
# A064706 - binary gray reflected permutation applied twice
{
my $anum = 'A064706';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
for (my $n = 0; @got < @$bvalues; $n++) {
push @got, to_binary_gray(to_binary_gray($n));
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - binary gray applied twice");
}
#------------------------------------------------------------------------------
# A055975 - binary gray first diffs
{
my $anum = 'A055975';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
my $prev = 0;
for (my $n = 1; @got < @$bvalues; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,$radix);
my $gray = digit_join_lowtohigh($digits,$radix);
push @got, $gray - $prev;
$prev = $gray;
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - binary gray first diffs");
}
#------------------------------------------------------------------------------
# A055975 - binary gray first diffs
{
my $anum = 'A055975';
my $radix = 2;
my ($bvalues, $lo, $filename) = MyOEIS::read_values($anum);
my @got;
if ($bvalues) {
my $prev = 0;
for (my $n = 1; @got < @$bvalues; $n++) {
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,$radix);
my $gray = digit_join_lowtohigh($digits,$radix);
push @got, $gray - $prev;
$prev = $gray;
}
if (! numeq_array(\@got, $bvalues)) {
MyTestHelpers::diag ("bvalues: ",join(',',@{$bvalues}[0..20]));
MyTestHelpers::diag ("got: ",join(',',@got[0..20]));
}
}
skip (! $bvalues,
numeq_array(\@got, $bvalues),
1, "$anum - binary gray first diffs");
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/DragonCurve-more.t 0000644 0001750 0001750 00000005424 12136177170 015710 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::DragonCurve;
use Test;
plan tests => 28;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
use MyOEIS;
# uncomment this to run the ### lines
#use Smart::Comments '###';
#------------------------------------------------------------------------------
# Lmin,Lmax Wmin,Wmax claimed in the pod
{
my $path = Math::PlanePath::DragonCurve->new;
my $xmax = 0;
my $xmin = 0;
my $ymax = 0;
my $ymin = 0;
my $n = 0;
foreach my $level (2, 4, 8, 10, 12, 14, 16) {
my $k = $level / 2;
my $Nlevel = 2**$level;
for ( ; $n <= $Nlevel; $n++) {
my ($x,$y) = $path->n_to_xy($n);
$xmax = max ($xmax, $x);
$xmin = min ($xmin, $x);
$ymax = max ($ymax, $y);
$ymin = min ($ymin, $y);
}
my $Lmax = $ymax;
my $Lmin = $ymin;
my $Wmax = $xmax;
my $Wmin = $xmin;
foreach (2 .. $k) {
( $Lmax, $Lmin, $Wmax, $Wmin)
= (-$Wmin, -$Wmax, $Lmax, $Lmin); # rotate -90
}
my $calc_Lmax = calc_Lmax($k);
my $calc_Lmin = calc_Lmin($k);
my $calc_Wmax = calc_Wmax($k);
my $calc_Wmin = calc_Wmin($k);
ok ($calc_Lmax, $Lmax, "Lmax k=$k");
ok ($calc_Lmin, $Lmin, "Lmin k=$k");
ok ($calc_Wmax, $Wmax, "Wmax k=$k");
ok ($calc_Wmin, $Wmin, "Wmin k=$k");
}
}
sub calc_Lmax {
my ($k) = @_;
# Lmax = (7*2^k - 4)/6 if k even
# (7*2^k - 2)/6 if k odd
if ($k & 1) {
return (7*2**$k - 2) / 6;
} else {
return (7*2**$k - 4) / 6;
}
}
sub calc_Lmin {
my ($k) = @_;
# Lmin = - (2^k - 1)/3 if k even
# - (2^k - 2)/3 if k odd
if ($k & 1) {
return - (2**$k - 2) / 3;
} else {
return - (2**$k - 1) / 3;
}
}
sub calc_Wmax {
my ($k) = @_;
# Wmax = (2*2^k - 1) / 3 if k even
# (2*2^k - 2) / 3 if k odd
if ($k & 1) {
return (2*2**$k - 1) / 3;
} else {
return (2*2**$k - 2) / 3;
}
}
sub calc_Wmin {
my ($k) = @_;
return calc_Lmin($k);
}
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/xt/0-Test-Pod.t 0000755 0001750 0001750 00000001751 11655356337 014340 0 ustar gg gg #!/usr/bin/perl -w
# 0-Test-Pod.t -- run Test::Pod if available
# Copyright 2009, 2010, 2011 Kevin Ryde
# 0-Test-Pod.t is shared by several distributions.
#
# 0-Test-Pod.t is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# 0-Test-Pod.t is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this file. If not, see .
use 5.004;
use strict;
use Test::More;
# all_pod_files_ok() is new in Test::Pod 1.00
#
eval 'use Test::Pod 1.00; 1'
or plan skip_all => "due to Test::Pod 1.00 not available -- $@";
Test::Pod::all_pod_files_ok();
exit 0;
Math-PlanePath-122/xt/oeis-xrefs.t 0000755 0001750 0001750 00000013003 12563465610 014613 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Check that OEIS A-numbers listed in lib/Math/PlanePath/Foo.pm files have
# code exercising them in one of the xt/oeis/*-oeis.t scripts.
#
# Check that A-numbers are not duplicated among the .pm files, since that's
# often a cut-and-paste mistake.
#
# Check that A-numbers are not duplicated among xt/oeis/*-oeis.t scripts,
# since normally only need to exercise a claimed path sequence once. Except
# often that's not true since the same sequence can arise in separate ways.
# But for now demand duplication is explicitly listed here.
#
use 5.005;
use strict;
use FindBin;
use ExtUtils::Manifest;
use File::Spec;
use File::Slurp;
use Test::More;
use List::MoreUtils;
use lib 't','xt';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }
# uncomment this to run the ### lines
#use Smart::Comments;
# new in 5.6, so unless got it separately with 5.005
plan tests => 1;
my $toplevel_dir = File::Spec->catdir ($FindBin::Bin, File::Spec->updir);
my $manifest_file = File::Spec->catfile ($toplevel_dir, 'MANIFEST');
my $manifest = ExtUtils::Manifest::maniread ($manifest_file);
my $bad = 0;
my $RE_OEIS_anum = qr/A\d{6,7}/;
#------------------------------------------------------------------------------
my %path_seq_anums;
foreach my $seq_filename ('lib/Math/NumSeq/PlanePathCoord.pm',
'lib/Math/NumSeq/PlanePathN.pm',
'lib/Math/NumSeq/PlanePathDelta.pm',
'lib/Math/NumSeq/PlanePathTurn.pm',
) {
open my $fh, '<', $seq_filename or die "Cannot open $seq_filename";
while (<$fh>) {
if (/^\s*# OEIS-(Catalogue|Other): +(A\d+)([^#]+)/) {
my $anum = $2;
my @args = split /\s/, $3;
my %args = map { split /=/, $_, 2 } @args;
### %args
my $planepath = $args{'planepath'} || die "Oops, no planepath parameter";
my ($path_name, @path_args) = split /,/, $planepath;
push @{$path_seq_anums{$path_name}}, $anum;
}
}
}
foreach (values %path_seq_anums) {
$_ = [ List::MoreUtils::uniq(@$_) ];
}
#------------------------------------------------------------------------------
my @module_filenames
= grep {m{^lib/Math/PlanePath/[^/]+\.pm$}} keys %$manifest;
@module_filenames = sort @module_filenames;
diag "module count ",scalar(@module_filenames);
my @path_names = map {m{([^/]+)\.pm$}
or die "Oops, unmatched module filename $_";
$1} @module_filenames;
sub path_pod_anums {
my ($path_name) = @_;
my $filename = "lib/Math/PlanePath/$path_name.pm";
open my $fh, '<', $filename
or die "Oops, cannot open module filename $filename";
my @ret;
while (<$fh>) {
if (/^ +($RE_OEIS_anum)/) {
push @ret, $1;
}
}
return @ret;
}
sub path_checked_anums {
my ($path_name) = @_;
return (path_xt_anums ($path_name),
@{$path_seq_anums{$path_name} || []});
}
sub path_xt_anums {
my ($path_name) = @_;
my @ret;
if (open my $fh, '<', "xt/oeis/$path_name-oeis.t") {
while (<$fh>) {
if (/^[^#]*\$anum = '($RE_OEIS_anum)'/mg) {
push @ret, $1;
}
if (/^[^#]*anum => '($RE_OEIS_anum)'/mg) {
push @ret, $1;
}
}
}
return @ret;
}
sub str_duplicates {
my %seen;
return map {$seen{$_}++ == 1 ? ($_) : ()} @_;
}
foreach my $path_name (@path_names) {
my @pod_anums = path_pod_anums ($path_name);
my @checked_anums = path_checked_anums ($path_name);
my %pod_anums = map {$_=>1} @pod_anums;
my %checked_anums = map {$_=>1} @checked_anums;
foreach my $anum (str_duplicates(@pod_anums)) {
diag "Math::PlanePath::$path_name duplicate pod $anum";
}
@pod_anums = List::MoreUtils::uniq(@pod_anums);
foreach my $anum (str_duplicates(@checked_anums)) {
next if $anum eq 'A000012'; # all ones
next if $anum eq 'A000027'; # 1,2,3 naturals
next if $anum eq 'A005408'; # odd 2n+1
diag "Math::PlanePath::$path_name duplicate check $anum";
}
@checked_anums = List::MoreUtils::uniq(@checked_anums);
diag "";
foreach my $anum (@pod_anums) {
next if $anum eq 'A191689'; # CCurve fractal dimension
if (! exists $checked_anums{$anum}) {
diag "Math::PlanePath::$path_name pod anum $anum not checked";
}
}
foreach my $anum (@checked_anums) {
next if $anum eq 'A000004'; # all zeros
next if $anum eq 'A000012'; # all ones
next if $anum eq 'A001477'; # integers 0,1,2,3
next if $anum eq 'A001489'; # negative integers 0,-1,-2,-3
next if $anum eq 'A081274'; # oeis duplicate
next if $anum eq 'A000035'; # 0,1 reps
next if $anum eq 'A059841'; # 1,0 reps
next if $anum eq 'A165211'; # 0,1,0,1, 1,0,1,0, repeating
if (! exists $pod_anums{$anum}) {
diag "Math::PlanePath::$path_name checked anum $anum not in pod";
}
}
}
is ($bad, 0);
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/Makefile.PL 0000755 0001750 0001750 00000005177 12641634711 013673 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use ExtUtils::MakeMaker;
WriteMakefile
(NAME => 'Math::PlanePath',
ABSTRACT => 'Mathematical paths through the 2-D plane.',
VERSION_FROM => 'lib/Math/PlanePath.pm',
PREREQ_PM => {
'Math::Libm' => 0, # for hypot() mainly
'List::Util' => 0,
'constant' => '1.02', # 1.02 for leading underscore
'constant::defer' => 5, # v.5 for Perl 5.6 fixes
},
TEST_REQUIRES => {
'Test' => 0,
},
AUTHOR => 'Kevin Ryde ',
LICENSE => 'gpl_3',
SIGN => 1,
MIN_PERL_VERSION => '5.004',
META_MERGE =>
{ 'meta-spec' => { version => 2 },
resources =>
{ homepage => 'http://user42.tuxfamily.org/math-planepath/index.html',
license => 'http://www.gnu.org/licenses/gpl.html',
},
no_index => { directory=>['devel','xt'],
# these are in Math-PlanePath-Toothpick but added to by
# Math::NumSeq::PlanePathCoord here
package => [ 'Math::PlanePath::ToothpickTree',
'Math::PlanePath::ToothpickReplicate',
'Math::PlanePath::ToothpickUpist',
'Math::PlanePath::LCornerTree',
'Math::PlanePath::LCornerReplicate',
'Math::PlanePath::OneOfEight',
],
},
prereqs =>
{ test =>
{ suggests =>
{
# have "make test" do as much as possible
'Data::Float' => 0,
'Math::BigInt' => 0,
'Math::BigInt::Lite' => 0,
'Math::BigFloat' => '1.993',
'Math::BigRat' => 0,
},
},
},
},
);
Math-PlanePath-122/examples/ 0002755 0001750 0001750 00000000000 12641645163 013527 5 ustar gg gg Math-PlanePath-122/examples/knights-oeis.pl 0000755 0001750 0001750 00000003560 12041154023 016455 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl knights-oeis.pl
#
# This spot of code prints sequence A068608 of Sloane's On-Line Encyclopedia
# of Integer Sequences
#
# http://oeis.org/A068608
#
# which is the infinite knight's tour path of Math::PlanePath::KnightSpiral
# with the X,Y positions numbered according to the SquareSpiral and thus
# giving an integer sequence
#
# 1, 10, 3, 16, 19, 22, 9, 12, 15, 18, 7, 24, 11, 14, ...
#
# All points in the first quadrant are reached by both paths, so this is a
# permutation of the integers.
#
# There's eight variations on the sequence. 2 directions clockwise and
# anti-clockwise and 4 sides to start from relative to the side the square
# spiral numbering starts from.
#
# A068608
# A068609
# A068610
# A068611
# A068612
# A068613
# A068614
# A068615
#
use 5.004;
use strict;
use Math::PlanePath::KnightSpiral;
use Math::PlanePath::SquareSpiral;
my $knights = Math::PlanePath::KnightSpiral->new;
my $square = Math::PlanePath::SquareSpiral->new;
foreach my $n ($knights->n_start .. 20) {
my ($x, $y) = $knights->n_to_xy ($n);
my $sq_n = $square->xy_to_n ($x, $y);
print "$sq_n, ";
}
print "...\n";
exit 0;
Math-PlanePath-122/examples/cellular-rules.pl 0000755 0001750 0001750 00000006361 12041153426 017014 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl cellular-rules.pl
#
# Print the patterns from the CellularRule paths with "*"s.
# Rules with the same output are listed together.
#
# Implementation:
#
# Points are plotted by looping $n until its $y coordinate is beyond the
# desired maximum rows. @rows is an array of strings of length 2*size+1
# spaces each in which "*"s are applied to plot points.
#
# Another way to plot would be to loop over $x,$y for the desired rectangle
# and look at $n=$path->xy_to_n($x,$y) to see which cells have defined($n).
# Characters could be appended or join(map{}) to make an output $str in that
# case. Going by $n should be fastest for sparse patterns, though
# CellularRule is not blindingly quick either way.
#
# See Cellular::Automata::Wolfram for the same but with more options and a
# graphics file output.
#
use 5.004;
use strict;
use Math::PlanePath::CellularRule;
my $numrows = 15; # size of each printout
my %seen;
my $count = 0;
my $mirror_count = 0;
my $finite_count = 0;
my @strs;
my @rules_list;
my @mirror_of;
foreach my $rule (0 .. 255) {
my $path = Math::PlanePath::CellularRule->new (rule => $rule);
my @rows = (' ' x (2*$numrows+1)) x ($numrows+1); # strings of spaces
for (my $n = $path->n_start; ; $n++) {
my ($x,$y) = $path->n_to_xy($n)
or last; # some patterns are only finitely many N values
last if $y > $numrows; # stop at $numrows+1 many rows
substr($rows[$y], $x+$numrows, 1) = '*';
}
@rows = reverse @rows; # print rows going up the page
my $str = join("\n",@rows); # string of all rows
my $seen_rule = $seen{$str}; # possible previous rule giving this $str
if (defined $seen_rule) {
# $str is a repeat of an output already seen, note this $rule with that
$rules_list[$seen_rule] .= ",$rule";
next;
}
my $mirror_str = join("\n", map {scalar(reverse)} @rows);
my $mirror_rule = $seen{$mirror_str};
if (defined $mirror_rule) {
$mirror_of[$mirror_rule] = " (mirror image is rule $rule)";
$mirror_of[$rule] = " (mirror image of rule $mirror_rule)";
$mirror_count++;
}
$strs[$rule] = $str;
$rules_list[$rule] = $rule;
$seen{$str} = $rule;
$count++;
if ($rows[0] =~ /^ *$/) {
$finite_count++;
}
}
foreach my $rule (0 .. 255) {
my $str = $strs[$rule] || next;
print "rule=$rules_list[$rule]", $mirror_of[$rule]||'', "\n";
print "\n$strs[$rule]\n\n";
}
my $unmirrored_count = $count - $mirror_count;
print "Total $count different rule patterns\n";
print "$mirror_count are mirror images of another\n";
print "$finite_count stop after a few cells\n";
exit 0;
Math-PlanePath-122/examples/koch-svg.pl 0000644 0001750 0001750 00000005310 12041154170 015565 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl koch-svg.pl >output.svg
# perl koch-svg.pl LEVEL >output.svg
#
# Print SVG format graphics to standard output for a Koch snowflake curve of
# given LEVEL fineness. The default level is 4.
#
# The range of N values to plot follows the formulas in the
# Math::PlanePath::KochSnowflakes module POD.
#
# The svg output size is a fixed 300x300, but of course the point of svg is
# that it can be resized by a graphics viewer program.
use 5.006;
use strict;
use warnings;
use List::Util 'min';
use Math::PlanePath::KochSnowflakes;
my $path = Math::PlanePath::KochSnowflakes->new;
my $level = $ARGV[0] || 4;
my $width = 300;
my $height = 300;
# use the svg transform="translate()" to centre the origin in the viewport,
# but don't use its scale() to shrink the path X,Y coordinates, just in case
# the factor 1/4^level becomes very small
my $xcentre = $width / 2;
my $ycentre = $height / 2;
print <<"HERE";
HERE
Math-PlanePath-122/examples/ulam-spiral-xpm.pl 0000755 0001750 0001750 00000006005 12041155744 017111 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl ulam-spiral-xpm.pl >/tmp/foo.xpm # write image file
# xzgv /tmp/foo.xpm # view file
#
# This is a bit of fun drawing Ulam's spiral of primes in the SquareSpiral
# path. The output is XPM format (which is plain text) and any good image
# viewer program should display it.
#
# Optional args
#
# perl ulam-spiral-xpm.pl SIZE
# or
# perl ulam-spiral-xpm.pl SIZE SCALE
#
# make the image SIZExSIZE pixels, and SCALE to expand each point to a
# SCALExSCALE square instead of a single pixel.
#
use 5.004;
use strict;
use Math::PlanePath::SquareSpiral;
my $size = 200;
my $scale = 1;
if (@ARGV >= 2) {
$scale = $ARGV[1];
}
if (@ARGV >= 1) {
$size = $ARGV[0];
}
my $path = Math::PlanePath::SquareSpiral->new;
my $x_origin = int($size / 2);
my $y_origin = int($size / 2);
my ($n_lo, $n_hi)
= $path->rect_to_n_range (-$x_origin, -$y_origin,
-$x_origin+$size, -$y_origin+$size);
# Find the prime numbers 2 to $n_hi by sieve of Eratosthenes.
# Could also use Math::Prime::TiedArray or Math::Prime::XS.
#
my @primes = (0, # 0
0, # 1
1, # 2 prime
1, # 3 prime
(0,1) x ($n_hi/2)); # rest alternately even/odd
my $i = 3;
foreach my $i (3 .. int(sqrt($n_hi)) + 1) {
next unless $primes[$i];
foreach (my $j = 2*$i; $j <= $n_hi; $j += $i) {
$primes[$j] = 0;
}
}
# Draw the primes into an array of rows strings.
#
my @rows = (' ' x $size) x $size;
foreach my $n ($n_lo .. $n_hi) {
next unless $primes[$n];
my ($x, $y) = $path->n_to_xy ($n);
$x = $x + $x_origin;
$y = $y_origin - $y; # inverted
# $n_hi is an over-estimate in general, check x,y actually in desired size
if ($x >= 0 && $x < $size && $y >= 0 && $y < $size) {
substr ($rows[$y], $x,1) = '*';
}
}
# Expand @rows points by $scale, horizontally and vertically.
#
if ($scale > 1) {
foreach (@rows) {
s{(.)}{$1 x $scale}eg; # expand horizontally
}
@rows = map { ($_) x $scale} @rows; # expand vertically
$size *= $scale;
}
# XPM format is easy to print.
# Output is about 1 byte per pixel.
#
print <<"HERE";
/* XPM */
static char *ulam_spiral_xpm_pl[] = {
"$size $size 2 1",
" c black",
"* c white",
HERE
foreach my $row (@rows) {
print "\"$row\",\n";
}
print "};\n";
exit 0;
Math-PlanePath-122/examples/sacks-xpm.pl 0000755 0001750 0001750 00000003627 12041155624 015773 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl sacks-xpm.pl >/tmp/foo.xpm # write image file
# xgzv /tmp/foo.xpm # view file
#
# This spot of code generates a big .xpm file showing all points of the
# SacksSpiral. XPM is a text format and can be generated quite easily as
# row strings. Use a graphics viewer program to look at it.
#
use 5.004;
use strict;
use POSIX ();
use Math::PlanePath::SacksSpiral;
my $width = 800;
my $height = 600;
my $spacing = 10;
my $path = Math::PlanePath::SacksSpiral->new;
my $x_origin = int($width / 2);
my $y_origin = int($height / 2);
my $n_max = ($x_origin/$spacing+2)**2 + ($y_origin/$spacing+2)**2;
my @rows = (' ' x $width) x $height;
foreach my $n ($path->n_start .. $n_max) {
my ($x, $y) = $path->n_to_xy ($n);
$x *= $spacing;
$y *= $spacing;
$x = $x + $x_origin;
$y = $y_origin - $y; # inverted
$x = POSIX::floor ($x + 0.5); # round
$y = POSIX::floor ($y + 0.5);
if ($x >= 0 && $x < $width && $y >= 0 && $y < $height) {
substr ($rows[$y], $x,1) = '*';
}
}
print <<"HERE";
/* XPM */
static char *sacks_xpm_pl[] = {
"$width $height 2 1",
" c black",
"* c white",
HERE
foreach my $row (@rows) {
print "\"$row\",\n";
}
print "};\n";
exit 0;
Math-PlanePath-122/examples/hilbert-path.pl 0000755 0001750 0001750 00000005032 12041154004 016427 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl hilbert-lines.pl
#
# This is a bit of fun printing the HilbertCurve path in ascii. It follows
# the terminal width if you've got Term::Size, otherwise 79x23.
#
# Enough curve is drawn to fill the whole output size, clipped when the path
# goes outside the output bounds. You could instead stop at say
#
# $n_hi = 2**6;
#
# to see just a square portion of the curve.
#
# The $scale variable spaces out the points. 3 apart is good, or tighten it
# up to 2 to fit more on the screen.
#
# The output has Y increasing down the screen. It could be instead printed
# up the screen in the final output by going $y from $height-1 down to 0.
#
use 5.004;
use strict;
use Math::PlanePath::HilbertCurve;
my $width = 79;
my $height = 23;
my $scale = 3;
if (eval { require Term::Size }) {
my ($w, $h) = Term::Size::chars();
if ($w) { $width = $w - 1; }
if ($h) { $height = $h - 1; }
}
my $x = 0;
my $y = 0;
my %grid;
# write $char at $x,$y in %grid
sub plot {
my ($char) = @_;
if ($x < $width && $y < $height) {
$grid{$x}{$y} = $char;
}
}
# at the origin 0,0
plot('+');
my $path = Math::PlanePath::HilbertCurve->new;
my $path_width = int($width / $scale) + 1;
my $path_height = int($height / $scale) + 1;
my ($n_lo, $n_hi) = $path->rect_to_n_range (0,0, $path_width,$path_height);
foreach my $n (1 .. $n_hi) {
my ($next_x, $next_y) = $path->n_to_xy ($n);
$next_x *= $scale;
$next_y *= $scale;
while ($x > $next_x) { # draw to left
$x--;
plot ('-');
}
while ($x < $next_x) { # draw to right
$x++;
plot ('-');
}
while ($y > $next_y) { # draw up
$y--;
plot ('|');
}
while ($y < $next_y) { # draw down
$y++;
plot ('|');
}
plot ('+');
}
foreach my $y (0 .. $height-1) {
foreach my $x (0 .. $width-1) {
print $grid{$x}{$y} || ' ';
}
print "\n";
}
exit 0;
Math-PlanePath-122/examples/rationals-tree.pl 0000644 0001750 0001750 00000010675 12136175114 017015 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl rationals-tree.pl
#
# Print the RationalsTree paths in tree form.
#
use 5.004;
use strict;
use List::Util 'max';
use Math::PlanePath::RationalsTree;
use Math::PlanePath::FractionsTree;
sub print_as_fractions {
my ($path) = @_;
my $n = $path->n_start;
foreach (1) {
my ($x,$y) = $path->n_to_xy($n++);
print centre("$x/$y",64);
}
print "\n";
print " /------------- -------------\\\n";
foreach (1 .. 2) {
my ($x,$y) = $path->n_to_xy($n++);
print centre("$x/$y",32);
}
print "\n";
print " /---- ----\\ /---- ----\\\n";
foreach (1 .. 4) {
my ($x,$y) = $path->n_to_xy($n++);
print centre("$x/$y",16);
}
print "\n";
print " / \\ / \\ / \\ / \\\n";
foreach (1 .. 8) {
my ($x,$y) = $path->n_to_xy($n++);
print centre("$x/$y",8);
}
print "\n";
print " / \\ / \\ / \\ / \\ / \\ / \\ / \\ / \\\n";
foreach (16 .. 31) {
my ($x,$y) = $path->n_to_xy($n++);
print centre("$x/$y",4);
}
print "\n";
print "\n";
}
sub centre {
my ($str, $width) = @_;
my $extra = max (0, $width - length($str));
my $left = int($extra/2);
my $right = $extra - $left;
return ' 'x$left . $str . ' 'x$right;
}
sub xy_to_cfrac_str {
my ($x,$y) = @_;
my @quotients;
while ($x > 0 && $y > 0) {
push @quotients, int($x/$y);
$x %= $y;
($x,$y) = ($y,$x);
}
return "[".join(',',@quotients)."]";
}
sub print_as_cfracs {
my ($path) = @_;
my $n = $path->n_start;
foreach (1) {
my ($x,$y) = $path->n_to_xy($n++);
print centre(xy_to_cfrac_str($x,$y), 72);
}
print "\n";
print " /--------------- ---------------\\\n";
foreach (1 .. 2) {
my ($x,$y) = $path->n_to_xy($n++);
print centre(xy_to_cfrac_str($x,$y), 36);
}
print "\n";
print " /----- -----\\ /----- -----\\\n";
foreach (1 .. 4) {
my ($x,$y) = $path->n_to_xy($n++);
print centre(xy_to_cfrac_str($x,$y), 18);
}
print "\n";
print " / \\ / \\ / \\ / \\\n";
foreach (1 .. 8) {
my ($x,$y) = $path->n_to_xy($n++);
print centre(xy_to_cfrac_str($x,$y), 9);
}
print "\n";
print "\n";
}
#------------------------------------------------------------------------------
my $rationals_type_arrayref
= Math::PlanePath::RationalsTree->parameter_info_hash()->{'tree_type'}->{'choices'};
my $fractions_type_arrayref
= Math::PlanePath::FractionsTree->parameter_info_hash()->{'tree_type'}->{'choices'};
print "RationalsTree\n";
print "-------------\n\n";
foreach my $tree_type (@$rationals_type_arrayref) {
print "$tree_type tree\n";
my $path = Math::PlanePath::RationalsTree->new
(tree_type => $tree_type);
print_as_fractions ($path);
}
print "\n";
print "FractionsTree\n";
print "-------------\n\n";
foreach my $tree_type (@$fractions_type_arrayref) {
print "$tree_type tree\n";
my $path = Math::PlanePath::FractionsTree->new
(tree_type => $tree_type);
print_as_fractions ($path);
}
print "\n";
print "-----------------------------------------------------------------------\n";
print "Or written as continued fraction quotients.\n";
print "\n";
print "RationalsTree\n";
print "-------------\n\n";
foreach my $tree_type (@$rationals_type_arrayref) {
print "$tree_type tree\n";
my $path = Math::PlanePath::RationalsTree->new
(tree_type => $tree_type);
print_as_cfracs ($path);
}
print "\n";
print "FractionsTree\n";
print "-------------\n\n";
foreach my $tree_type (@$fractions_type_arrayref) {
print "$tree_type tree\n";
my $path = Math::PlanePath::FractionsTree->new
(tree_type => $tree_type);
print_as_cfracs ($path);
}
exit 0;
Math-PlanePath-122/examples/cretan-walls.pl 0000644 0001750 0001750 00000004360 11746612502 016455 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl cretan-walls.pl
#
# This is a bit of fun carving out the CretanLabyrinth from a solid block of
# "*"s, thus leaving those "*"s representing the walls of the labyrinth.
#
# The $spacing variable is how widely to spread the path, for thicker walls.
# The $width,$height sizes are chosen to make a whole 4-way cycle.
#
# The way the arms align means the entrance to the labyrinth is at the
# bottom right corner. In real labyrinths its usual to omit the lower right
# bit of wall so the entrance is in the middle of the right side.
#
use 5.004;
use strict;
use Math::PlanePath::CretanLabyrinth;
my $spacing = 2;
my $width = $spacing * 14 - 1;
my $height = $spacing * 16 - 1;
my $path = Math::PlanePath::CretanLabyrinth->new;
my $x_origin = int($width / 2) + $spacing;
my $y_origin = int($height / 2);
my @rows = ('*' x $width) x $height; # array of strings
sub plot {
my ($x,$y,$char) = @_;
if ($x >= 0 && $x < $width
&& $y >= 0 && $y < $height) {
substr($rows[$y], $x, 1) = $char;
}
}
my ($n_lo, $n_hi)
= $path->rect_to_n_range (-$x_origin,-$y_origin, $x_origin,$y_origin);
my $x = $x_origin;
my $y = $y_origin;
plot($x,$y,'_');
foreach my $n ($n_lo+1 .. $n_hi) {
my ($next_x, $next_y) = $path->n_to_xy ($n);
$next_x *= $spacing;
$next_y *= $spacing;
$next_x += $x_origin;
$next_y += $y_origin;
while ($x != $next_x) {
$x -= ($x <=> $next_x);
plot($x,$y,' ');
}
while ($y != $next_y) {
$y -= ($y <=> $next_y);
plot($x,$y,' ');
}
}
foreach my $row (reverse @rows) {
print "$row\n";
}
exit 0;
Math-PlanePath-122/examples/hilbert-oeis.pl 0000755 0001750 0001750 00000004256 12066001433 016445 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl hilbert-oeis.pl
#
# This spot of code prints sequence A163359 of Sloane's On-Line Encyclopedia
# of Integer Sequences
#
# http://oeis.org/A163359
#
# which is the Hilbert curve N values which occur on squares numbered
# diagonally in the style of Math::PlanePath::Diagonals,
#
# 0, 3, 1, 4, 2, 14, 5, 7, 13, 15, 58, 6, 8, 12, 16, 59, ...
#
# All points in the first quadrant are reached by both paths, so this is a
# re-ordering or the non-negative integers.
#
# In the code there's a double transpose going on. A163359 is conceived as
# the Hilbert starting downwards and the diagonals numbered from the X axis,
# but the HilbertCurve code goes to the right first and the Diagonals module
# numbers from the Y axis. The effect is the same, ie. that the first
# Hilbert step is the opposite axis as the diagonals are numbered from.
#
# Diagonals option direction=>up could be added to transpose $x,$y to make
# the first Hilbert step the same axis as the diagonal numbering. Doing so
# would give sequence A163357.
#
use 5.004;
use strict;
use Math::PlanePath::HilbertCurve;
use Math::PlanePath::Diagonals;
my $hilbert = Math::PlanePath::HilbertCurve->new;
my $diagonal = Math::PlanePath::Diagonals->new;
print "A163359: ";
foreach my $n ($diagonal->n_start .. 19) {
my ($x, $y) = $diagonal->n_to_xy ($n); # X,Y points by diagonals
my $hilbert_n = $hilbert->xy_to_n ($x, $y); # hilbert N at those points
print "$hilbert_n, ";
}
print "...\n";
exit 0;
Math-PlanePath-122/examples/other/ 0002755 0001750 0001750 00000000000 12641645163 014650 5 ustar gg gg Math-PlanePath-122/examples/other/sierpinski-triangle.m4 0000644 0001750 0001750 00000002435 12241344134 021065 0 ustar gg gg divert(-1)
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: m4 sierpinski-triangle.m4
#
# Plot points of the Sierpinski triangle using a bitwise-and to decide
# whether a given X,Y point should be a "*" or a space.
#
# forloop(varname, start,end, body)
# Expand body with varname successively define()ed to integers "start" to
# "end" inclusive. "start" to "end" can go either increasing or decreasing.
define(`forloop', `define(`$1',$2)$4`'dnl
ifelse($2,$3,,`forloop(`$1',eval($2 + 2*($2 < $3) - 1), $3, `$4')')')
divert`'dnl
forloop(`y',15,0,
`forloop(`i',0,y,` ')dnl indent y many spaces
forloop(`x',0,15,
`ifelse(eval(x&y),0,` *',` ')')
')
Math-PlanePath-122/examples/other/sierpinski-triangle-text.gnuplot 0000644 0001750 0001750 00000003320 12062333616 023215 0 ustar gg gg #!/usr/bin/gnuplot
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: gnuplot sierpinski-triangle-text.gnuplot
#
# Print the Sierpinski triangle pattern with spaces and stars using
# bitwise-and to decide whether or not to plot each X,Y.
#
# *
# * *
# * *
# * * * *
# * *
# * * * *
# * * * *
# * * * * * * * *
#
# Return a space or star string to print at x,y.
# Must have x=0 && ((y+x)%2)==0 && ((y+x)&(y-x))==0 ? "*" : " ")
# Return a string which is row y of the triangle from character
# position x through to the right hand end x==y, inclusive.
row(x,y) = (x<=y ? char(x,y).row(x+1,y) : "\n")
# Return a string of stars, spaces and newlines which is the
# Sierpinski triangle rows from y to limit, inclusive.
# The first row is y=0.
triangle(y,limit) = (y <= limit ? row(-limit,y).triangle(y+1,limit) : "")
# Print rows 0 to 15, which is the order 4.
print triangle(0,15)
exit
Math-PlanePath-122/examples/other/dragon-curve.logo 0000644 0001750 0001750 00000005545 12335526416 020134 0 ustar gg gg #!/usr/bin/ucblogo
; Copyright 2012, 2013, 2014 Kevin Ryde
;
; This file is part of Math-PlanePath.
;
; Math-PlanePath is free software; you can redistribute it and/or modify it
; under the terms of the GNU General Public License as published by the Free
; Software Foundation; either version 3, or (at your option) any later
; version.
;
; Math-PlanePath is distributed in the hope that it will be useful, but
; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
; for more details.
;
; You should have received a copy of the GNU General Public License along
; with Math-PlanePath. If not, see .
; Usage: ucblogo dragon-curve-turns.logo
;
; Plot the dragon curve using bit-twiddling to turn the turtle left or
; right, as described for example in "Turn" of
; Math::PlanePath::DragonCurve and variously elsewhere.
;
; The commented out "dragon.chamfer 256" is an alternative plot with
; the corners rounded off to help see the shape.
;
;
; See also:
;
; Mark Horney, "Fractals I: Making Recursion Visible", Logo Exchange,
; Volume 9, number 1, September 1990, pages 23-29.
; Mark Horney, "Fractals II: Representation, Logo Exchange, Volume 9,
; number 2, October 1990, pages 26-29.
; http://el.media.mit.edu/logo-foundation/pubs/nlx.html
; http://el.media.mit.edu/logo-foundation/pubs/nlx/v9/Vol9No1.pdf
; http://el.media.mit.edu/logo-foundation/pubs/nlx/v9/Vol9No2.pdf
; Return the bit above the lowest 1-bit in :n.
; If :n = binary "...z100..00" then the return is "z000..00".
; Eg. n=22 is binary 10110 the lowest 1-bit is the "...1." and the return is
; bit above that "..1.," which is 4.
to bit.above.lowest.1bit :n
output bitand :n (1 + (bitxor :n (:n - 1)))
end
; Return angle +90 or -90 for dragon curve turn at point :n.
; The curve is reckoned as starting from n=0 so the first turn is at n=1.
to dragon.turn.angle :n
output ifelse (bit.above.lowest.1bit :n) = 0 [90] [-90]
end
; Draw :steps many segments of the dragon curve.
to dragon :steps
localmake "step.len 12 ; length of each step
repeat :steps [
forward :step.len
left dragon.turn.angle repcount ; repcount = 1 to :steps inclusive
]
end
; Draw :steps many segments of the dragon curve, with corners chamfered
; off with little 45-degree diagonals.
; Done this way the vertices don't touch.
to dragon.chamfer :steps
localmake "step.len 12 ; length of each step
localmake "straight.frac 0.5 ; fraction of the step to go straight
localmake "straight.len :step.len * :straight.frac
localmake "diagonal.len (:step.len - :straight.len) * sqrt(1/2)
repeat :steps [
localmake "turn (dragon.turn.angle repcount)/2 ; +45 or -45
forward :straight.len
left :turn
forward :diagonal.len
left :turn
]
end
dragon 256
; dragon.chamfer 256
Math-PlanePath-122/examples/other/fibonacci-word-fractal.logo 0000644 0001750 0001750 00000004351 12335737560 022036 0 ustar gg gg #!/usr/bin/ucblogo
; Copyright 2014 Kevin Ryde
;
; This file is part of Math-PlanePath.
;
; Math-PlanePath is free software; you can redistribute it and/or modify it
; under the terms of the GNU General Public License as published by the Free
; Software Foundation; either version 3, or (at your option) any later
; version.
;
; Math-PlanePath is distributed in the hope that it will be useful, but
; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
; for more details.
;
; You should have received a copy of the GNU General Public License along
; with Math-PlanePath. If not, see .
; Usage: ucblogo fibonacci-word-fractal.logo
;
; Draw the Fibonacci word fractal. fibonacci.word.fractal draws any
; given number of steps. The self-similar nature of the pattern is
; best seen by making it a Fibonacci number, hence 377 below.
;
; The turns are based on the Fibonacci word values which are 0 or 1.
; Those values are calculated by the least significant bit of the
; fibbinary values. Fibbinary values are integers which have no "11"
; adjacent 1-bits. They're iterated by some bit twiddling.
; Return the low 1-bits of :n
; For example if n = binary 10110111 = 183
; then return binary 111 = 7
to low.ones :n
output ashift (bitxor :n (:n+1)) -1
end
; :fibbinary should be a fibbinary value
; return the next larger fibbinary value
to fibbinary.next :fibbinary
localmake "filled bitor :fibbinary (ashift :fibbinary -1)
localmake "mask low.ones :filled
output (bitor :fibbinary :mask) + 1
end
to fibonacci.word.fractal :steps
localmake "step.length 5 ; length of each step
localmake "fibbinary 0
repeat :steps [
forward :step.length
if (bitand 1 :fibbinary) = 0 [
ifelse (bitand repcount 1) = 1 [right 90] [left 90]
]
make "fibbinary fibbinary.next :fibbinary
]
end
setheading 0 ; initial line North
fibonacci.word.fractal 377
;------------------------------------------------------------------------------
; Print the fibbinary values as iterated by fibbinary.next.
;
; make "fibbinary 0
; repeat 20 [
; print :fibbinary
; make "fibbinary fibbinary.next :fibbinary
; ]
Math-PlanePath-122/examples/other/sierpinski-triangle-replicate.gnuplot 0000644 0001750 0001750 00000003247 12041164144 024204 0 ustar gg gg #!/usr/bin/gnuplot
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: gnuplot sierpinski-triangle-replicate.gnuplot
#
# Plot points of the Sierpinski triangle by replicating sub-parts of
# the pattern according to parameter t in ternary.
#
# The alignment relative to the Y axis can be changed by what
# digit_to_x() does. For example to plot half,
#
# digit_to_x(d) = (d<2 ? 0 : 1)
#
# triangle_x(n) and triangle_y(n) return X,Y coordinates for the
# Sierpinski triangle point number n, for integer n.
triangle_x(n) = (n > 0 ? 2*triangle_x(int(n/3)) + digit_to_x(int(n)%3) : 0)
triangle_y(n) = (n > 0 ? 2*triangle_y(int(n/3)) + digit_to_y(int(n)%3) : 0)
digit_to_x(d) = (d==0 ? 0 : d==1 ? -1 : 1)
digit_to_y(d) = (d==0 ? 0 : 1)
# Plot the Sierpinski triangle to "level" many replications.
# "trange" and "samples" are chosen so the parameter t runs through
# integers t=0 to 3**level-1, inclusive.
#
level=6
set trange [0:3**level-1]
set samples 3**level
set parametric
set key off
plot triangle_x(t), triangle_y(t) with points
pause 100 Math-PlanePath-122/examples/other/dragon-curve.m4 0000644 0001750 0001750 00000013730 12221425116 017474 0 ustar gg gg divert(-1)
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: m4 dragon.m4
#
# This is a bit of fun generating the dragon curve with the predicate
# algorithms of xy_is_visited() from DragonMidpoint and DragonCurve. The
# output is generated row by row and and column by column with no image
# array or storage.
#
# The macros which return a pair of values x,y expand to an unquoted 123,456
# which is suitable as arguments to a further macro. The quoting is slack
# because the values are always integers and so won't suffer unwanted macro
# expansion.
# 0,1 Vertex and segment x,y numbering.
# |
# | Segments are numbered as if a
# |s=0,1 square grid turned anti-clockwise
# | by 45 degrees.
# |
# -1,0 -------- 0,0 -------- 1,0 vertex_to_seg_east(x,y) returns
# s=-1,1 | s=0,0 the segment x,y to the East,
# | so vertex_to_seg_east(0,0) is 0,0
# |
# |s=-1,0 vertex_to_seg_west(x,y) returns
# | the segment x,y to the West,
# 0,-1 so vertex_to_seg_west(0,0) is -1,1
#
define(`vertex_to_seg_east', `eval($1 + $2), eval($2 - $1)')
define(`vertex_to_seg_west', `eval($1 + $2 - 1), eval($2 - $1 + 1)')
define(`vertex_to_seg_south', `eval($1 + $2 - 1), eval($2 - $1)')
# Some past BSD m4 didn't have "&" operator, so mod2(n) using % instead.
# mod2() returns 0,1 even if "%" gives -1 for negative odds.
#
define(`mod2', `ifelse(eval($1 % 2),0,0,1)')
# seg_to_even(x,y) returns x,y moved to an "even" position by subtracting an
# offset in a way which suits the segment predicate test.
#
# seg_offset_y(x,y) is a repeating pattern
#
# | 1,1,0,0
# | 1,1,0,0
# | 0,0,1,1
# | 0,0,1,1
# +---------
#
# seg_offset_x(x,y) is the same but offset by 1 in x,y
#
# | 0,1,1,0
# | 1,0,0,1
# | 1,0,0,1
# | 0,1,1,0
# +---------
#
# Incidentally these offset values also give n which is the segment number
# along the curve. "x_offset XOR y_offset" is 0,1 and is a bit of n from
# low to high.
#
define(`seg_offset_y', `mod2(eval(($1 >> 1) + ($2 >> 1)))')
define(`seg_offset_x', `seg_offset_y(eval($1+1), eval($2+1))')
define(`seg_to_even', `eval($1 - seg_offset_x($1,$2)),
eval($2 - seg_offset_y($1,$2))');
# xy_div_iplus1(x,y) returns x,y divided by complex number i+1.
# So (x+i*y)/(i+1) which means newx = (x+y)/2, newy = (y-x)/2.
# Must have x,y "even", meaning x+y even, so newx and newy are integers.
#
define(`xy_div_iplus1', `eval(($1 + $2)/2), eval(($2 - $1)/2)')
# seg_is_final(x,y) returns 1 if x,y is one of the final four points.
# On these four points xy_div_iplus1(seg_to_even(x,y)) returns x,y
# unchanged, so the seg_pred() recursion does not reduce any further.
#
# .. | ..
# final | final y=+1
# final | final y=0
# -------+--------
# .. | ..
# x=-1 x=0
#
define(`seg_is_final', `eval(($1==-1 || $1==0) && ($2==1 || $2==0))')
# seg_pred(x,y) returns 1 if segment x,y is on the dragon curve.
# If the final point reached is 0,0 then the original x,y was on the curve.
# (If a different final point then x,y was one of four rotated copies of the
# curve.)
#
define(`seg_pred', `ifelse(seg_is_final($1,$2), 1,
`eval($1==0 && $2==0)',
`seg_pred(xy_div_iplus1(seg_to_even($1,$2)))')')
# vertex_pred(x,y) returns 1 if point x,y is on the dragon curve.
# The curve always turns left or right at a vertex, it never crosses itself,
# so if a vertex is visited then either the segment to the east or to the
# west must have been traversed. Prefer ifelse() for the two checks since
# eval() || operator is not a short-circuit.
#
define(`vertex_pred', `ifelse(seg_pred(vertex_to_seg_east($1,$2)),1,1,
`seg_pred(vertex_to_seg_west($1,$2))')')
# forloop(varname, start,end, body)
# Expand body with varname successively define()ed to integers "start" to
# "end" inclusive. "start" to "end" can go either increasing or decreasing.
#
define(`forloop', `define(`$1',$2)$4`'dnl
ifelse($2,$3,,`forloop(`$1',eval($2 + 2*($2 < $3) - 1), $3, `$4')')')
#----------------------------------------------------------------------------
# dragon01(xmin,xmax, ymin,ymax) prints an array of 0s and 1s which are the
# vertex_pred() values. `y' runs from ymax down to ymin so that y
# coordinate increases up the screen.
#
define(`dragon01',
`forloop(`y',$4,$3, `forloop(`x',$1,$2, `vertex_pred(x,y)')
')')
# dragon_ascii(xmin,xmax, ymin,ymax) prints an ascii art dragon curve.
# Each y value results in two output lines. The first has "+" vertices and
# "--" horizontals. The second has "|" verticals.
#
define(`dragon_ascii',
`forloop(`y',$4,$3,
`forloop(`x',$1,$2,
`ifelse(vertex_pred(x,y),1, `+', ` ')dnl
ifelse(seg_pred(vertex_to_seg_east(x,y)), 1, `--', ` ')')
forloop(`x',$1,$2,
`ifelse(seg_pred(vertex_to_seg_south(x,y)), 1, `| ', ` ')')
')')
#--------------------------------------------------------------------------
divert`'dnl
# 0s and 1s directly from vertex_pred().
#
dragon01(-7,23, dnl X range
-11,10) dnl Y range
# ASCII art lines.
#
dragon_ascii(-6,5, dnl X range
-10,2) dnl Y range
Math-PlanePath-122/examples/other/sierpinski-triangle-bitand.gnuplot 0000644 0001750 0001750 00000002646 12177346233 023512 0 ustar gg gg #!/usr/bin/gnuplot
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: gnuplot sierpinski-triangle-replicate.gnuplot
#
# Plot points of the Sierpinski triangle by a bitwise-and to decide
# whether a given X,Y point should be plotted. Points not wanted are
# suppressed by returning NaN.
level=6
size=2**level
# Return X,Y grid coordinates ranging X=0 to size-1 and Y=0 to size-1,
# as t ranges 0 to size*size-1.
x(t) = int(t) % size
y(t) = int(t / size)
# Return true if the X,Y coordinates at t are wanted for the
# Sierpinski triangle.
want(t) = ((x(t) & y(t)) == 0)
triangle_x(t) = (want(t) ? x(t) : NaN)
triangle_y(t) = (want(t) ? y(t) : NaN)
set parametric
set trange [0:size*size-1]
set samples size*size
set key off
plot triangle_x(t),triangle_y(t) with points
pause 100
Math-PlanePath-122/examples/other/flowsnake-ascii-small.gp 0000644 0001750 0001750 00000010001 12544112624 021344 0 ustar gg gg \\ Copyright 2015 Kevin Ryde
\\ This file is part of Math-PlanePath.
\\
\\ Math-PlanePath is free software; you can redistribute it and/or modify it
\\ under the terms of the GNU General Public License as published by the Free
\\ Software Foundation; either version 3, or (at your option) any later
\\ version.
\\
\\ Math-PlanePath is distributed in the hope that it will be useful, but
\\ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
\\ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
\\ for more details.
\\
\\ You should have received a copy of the GNU General Public License along
\\ with Math-PlanePath. If not, see .
\\ This is a bit of fun drawing the flowsnake in ascii art for
\\ http://codegolf.stackexchange.com/questions/50521/ascii-art-of-the-day-2-flow-snakes
\\ ____
\\ ____ \__ \
\\ \__ \__/ / __
\\ __/ ____ \ \ \ ____
\\ / __ \__ \ \/ / __ \__ \
\\ ____ \ \ \__/ / __ \/ / __/ / __
\\ ____ \__ \ \/ ____ \/ / __/ / __ \ \ \
\\ \__ \__/ / __ \__ \__/ / __ \ \ \ \/
\\ __/ ____ \ \ \__/ ____ \ \ \ \/ / __
\\ / __ \__ \ \/ ____ \__ \ \/ / __ \/ /
\\ \ \ \__/ / __ \__ \__/ / __ \ \ \__/
\\ \/ ____ \/ / __/ ____ \ \ \ \/ ____
\\ \__ \__/ / __ \__ \ \/ / __ \__ \
\\ __/ ____ \ \ \__/ / __ \/ / __/ / __
\\ / __ \__ \ \/ ____ \/ / __/ / __ \/ /
\\ \/ / __/ / __ \__ \__/ / __ \/ / __/
\\ __/ / __ \ \ \__/ ____ \ \ \__/ / __
\\ / __ \ \ \ \/ ____ \__ \ \/ ____ \/ /
\\ \ \ \ \/ / __ \__ \__/ / __ \__ \__/
\\ \/ / __ \/ / __/ ____ \ \ \__/
\\ \ \ \__/ / __ \__ \ \/
\\ \/ \ \ \__/ / __
\\ \/ ____ \/ /
\\ \__ \__/
\\ __/
\\
\\ Each hexagon of the flowsnake is 2 characters and a line segment does
\\ across its corners either by __, / or \. The loop goes over x,y and
\\ calculates which of these to show at each location. Only moderate
\\ attempts at minimizing.
\\
\\ The code expresses a complex number z in base b=2+w and digits 0, 1, w^2,
\\ ..., w^5, where w=e^(2pi/6) sixth root of unity. Those digits are kept
\\ just as a distinguishing 1 to 7 then taken high to low for net rotation.
\\
\\ This is in the style of Ed Shouten's http://80386.nl/projects/flowsnake/
\\ (xytoi) but only for net rotation, not making digits into an "N" index
\\ along the path.
\\
\\ The extents calculated are relative to an origin 0 at the centre of the
\\ shape (not the start of the curve as in Math::PlanePath::Flowsnake). The
\\ vecmin()/vecmax() calculate with centre of the little hexagons. Segments
\\ other than the start and end are always / or \ and so go only to that
\\ centre. But if the curve start or end are the maximum or minimum then
\\ they are the whole hexagon so a +1 is needed. This only occurs for k=0
\\ for X minimum and k<3 for the X maximum.
\\
\\ Pari has "quads" like sqrt(-3) builtin but the same can be done with real
\\ and imaginary parts separately.
k=3;
{
S = quadgen(-12); \\ sqrt(-3)
w = (1 + S)/2; \\ sixth root of unity
b = 2 + w; \\ base
\\ base b low digit position under 2*Re+4*Im mod 7 index
P = [0, w^2, 1, w, w^4, w^3, w^5];
\\ rotation state table
T = 7*[0,0,1,0,0,1,2, 1,2,1,0,1,1,2, 2,2,2,0,0,1,2];
C = ["_","_", " ","\\", "/"," "];
\\ extents
X = 2*sum(i=0,k-1, vecmax(real(b^i*P)));
Y = 2*sum(i=0,k-1, vecmax(imag(b^i*P)));
for(y = -Y, Y,
for(x = -X+!!k, X+(k<3), \\ adjusted when endpoint is X limit
z = (x- (o = (x+y)%2) - y*S)/2;
v = vector(k,i,
z = (z - P[ d = (2*real(z) + 4*imag(z)) % 7 + 1 ])/b;
d);
print1( C[if(z,3,
r = 0;
forstep(i=#v,1, -1, r = T[r+v[i]];);
r%5 + o + 1)]) ); \\ r=0,7,14 mod 5 is 0,2,4
print())
}
Math-PlanePath-122/examples/other/dragon-curve.el 0000644 0001750 0001750 00000007712 12241340154 017557 0 ustar gg gg ;; Copyright 2012, 2013 Kevin Ryde
;;
;; This file is part of Math-PlanePath.
;;
;; Math-PlanePath is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 3, or (at your option) any later
;; version.
;;
;; Math-PlanePath is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;; for more details.
;;
;; You should have received a copy of the GNU General Public License along
;; with Math-PlanePath. If not, see .
;; Usage: M-x load-file dragon-curve.el
;;
;; And thereafter M-x dragon-picture.
;;
(unless (fboundp 'ignore-errors)
(require 'cl)) ;; Emacs 22 and earlier `ignore-errors'
(defun dragon-ensure-line-above ()
"If point is in the first line of the buffer then insert a new line above."
(when (= (line-beginning-position) (point-min))
(save-excursion
(goto-char (point-min))
(insert "\n"))))
(defun dragon-ensure-column-left ()
"If point is in the first column then insert a new column to the left.
This is designed for use in `picture-mode'."
(when (zerop (current-column))
(save-excursion
(goto-char (point-min))
(insert " ")
(while (= 0 (forward-line 1))
(insert " ")))
(picture-forward-column 1)))
(defun dragon-insert-char (char len)
"Insert CHAR repeated LEN many times.
After each CHAR move point in the current `picture-mode'
direction (per `picture-set-motion' etc).
This is the same as `picture-insert' except in column 0 or row 0
a new row or column is inserted to make room, with existing
buffer contents shifted down or right."
(dotimes (i len)
(dragon-ensure-line-above)
(dragon-ensure-column-left)
(picture-insert char 1)))
(defun dragon-bit-above-lowest-0bit (n)
"Return the bit above the lowest 0-bit in N.
For example N=43 binary \"101011\" has lowest 0-bit at \"...0..\"
and the bit above that is \"..1...\" so return 8 which is that
bit."
(logand n (1+ (logxor n (1+ n)))))
(defun dragon-next-turn-right-p (n)
"Return non-nil if the dragon curve should turn right after segment N.
Segments are numbered from N=0 for the first, so calling with N=0
is whether to turn right at the end of that N=0 segment."
(zerop (dragon-bit-above-lowest-0bit n)))
(defun dragon-picture (len step)
"Draw the dragon curve in a *dragon* buffer.
LEN is the number of segments of the curve to draw.
STEP is the length of each segment, in characters.
Any LEN can be given but a power-of-2 such as 256 shows the
self-similar nature of the curve.
If STEP >= 2 then the segments are lines using \"-\" or \"|\"
characters (`picture-rectangle-h' and `picture-rectangle-v').
If STEP=1 then only \"+\" corners.
There's a `sit-for' delay in the drawing loop to draw the curve
progressively on screen."
(interactive (list (read-number "Length of curve " 256)
(read-number "Each step size " 3)))
(unless (>= step 1)
(error "Step length must be >= 1"))
(switch-to-buffer "*dragon*")
(erase-buffer)
(setq truncate-lines t)
(ignore-errors ;; ignore error if already in picture-mode
(picture-mode))
(dotimes (n len) ;; n=0 to len-1, inclusive
(dragon-insert-char ?+ 1) ;; corner char
(dragon-insert-char (if (zerop picture-vertical-step)
picture-rectangle-h picture-rectangle-v)
(1- step)) ;; line chars
(if (dragon-next-turn-right-p n)
;; turn right
(picture-set-motion (- picture-horizontal-step) picture-vertical-step)
;; turn left
(picture-set-motion picture-horizontal-step (- picture-vertical-step)))
;; delay to display the drawing progressively
(sit-for .01))
(picture-insert ?+ 1) ;; endpoint
(picture-mode-exit)
(goto-char (point-min)))
(dragon-picture 128 2)
Math-PlanePath-122/examples/other/dragon-recursive.gri 0000644 0001750 0001750 00000006443 12217673641 020640 0 ustar gg gg # Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
`Draw Dragon [ from .x1. .y1. to .x2. .y2. [level .level.] ]'
Draw a dragon curve going from .x1. .y1. to .x2. .y2. with recursion
depth .level.
The total number of line segments for the recursion is 2^level.
level=0 is a straight line from x1,y1 to x2,y2.
The default for x1,y1 and x2,y2 is to draw horizontally from 0,0
to 1,0.
{
new .x1. .y1. .x2. .y2. .level.
.x1. = \.word3.
.y1. = \.word4.
.x2. = \.word6.
.y2. = \.word7.
.level. = \.word9.
if {rpn \.words. 5 >=}
.x2. = 1
.y2. = 0
end if
if {rpn \.words. 7 >=}
.level. = 6
end if
if {rpn 0 .level. <=}
draw line from .x1. .y1. to .x2. .y2.
else
.level. = {rpn .level. 1 -}
# xmid,ymid is half way between x1,y1 and x2,y2 and up at
# right angles away.
#
# xmid,ymid xmid = (x1+x2 + y2-y1)/2
# ^ ^ ymid = (x1-x2 + y1+y2)/2
# / . \
# / . \
# x1,y1 ........... x2,y2
#
new .xmid. .ymid.
.xmid. = {rpn .x1. .x2. + .y2. .y1. - + 2 /}
.ymid. = {rpn .x1. .x2. - .y1. .y2. + + 2 /}
# The recursion is a level-1 dragon from x1,y1 to the midpoint
# and the same from x2,y2 to the midpoint (the latter
# effectively being a revered dragon.)
#
Draw Dragon from .x1. .y1. to .xmid. .ymid. level .level.
Draw Dragon from .x2. .y2. to .xmid. .ymid. level .level.
delete .xmid. .ymid.
end if
delete .x1. .y1. .x2. .y2. .level.
}
# Dragon curve from 0,0 to 1,0 extends out by 1/3 at the ends, so
# extents -0.5 to +1.5 for a bit of margin. The Y extent is the same
# size 2 to make the graph square.
set x axis -0.5 1.5 .25
set y axis -1 1 .25
Draw Dragon
#Draw Dragon from 0 0 to 1 0 level 10
# x1,y1 to x2,y2
# dx = x2-x1
# dy = y2-y1
# xmid = x1 + dx/2 - dy/2
# = x1 + (x2-x1 - (y2-y1))/2
# = (2*x1 + x2-x1 -y2+y1)/2
# = (2*x1 + x2-x1 - y2+y1) / 2
# = (x1+x2 + y1-y2)/2
# ymid = y1 + dy/2 + dx/2
# = (2*y1 + dy + dx)/2
# = (2*y1 + y2-y1 + x2-x1) / 2
# = (y1+y2 + x2-x1) / 2
# xmid = x1 + dx/2 + dy/2
# = x1 + (x2-x1 + y2-y1)/2
# = (x1+x2 + y2-y1)/2
# ymid = y1 + dy/2 - dx/2
# = (2*y1 + y2-y1 + x1-x2) / 2
# = (y1+y2 + x1-x2) / 2
# show " line " .x1. " " .y1. " to " .x2. " " .y2.
# show .x1. " " .y1. " to " .x2. " " .y2. " mid " .xmid. " " .ymid.
# show "second " .x1. " " .y1. " to " .x2. " " .y2. " mid " .xmid. " " .ymid.
# show "level " .level.
Math-PlanePath-122/examples/other/dragon-pgf-plain.tex 0000644 0001750 0001750 00000004665 12246063147 020525 0 ustar gg gg %% Copyright 2013 Kevin Ryde
%%
%% This file is part of Math-PlanePath.
%%
%% Math-PlanePath is free software; you can redistribute it and/or modify it
%% under the terms of the GNU General Public License as published by the Free
%% Software Foundation; either version 3, or (at your option) any later
%% version.
%%
%% Math-PlanePath is distributed in the hope that it will be useful, but
%% WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
%% or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
%% for more details.
%%
%% You should have received a copy of the GNU General Public License along
%% with Math-PlanePath. If not, see .
%% Usage: tex dragon-pgf-latex.tex
%% xdvi dragon-pgf-latex.dvi
%%
%% This a dragon curve drawn with the PGF lindenmayersystems library.
%%
%% http://sourceforge.net/projects/pgf/
%%
%% The PGF manual includes examles of Koch snowflake, Hilbert curve and
%% Sierpinski arrowhead. In the ``spy'' library section there's some
%% magnifications of the Koch and of a quadric curve too.
%%
%% In the rule here \symbol{S} is a second drawing symbol. It draws a
%% line segment the same as F, but the two different symbols let the
%% rules distinguish odd and even position line segments.
%%
%% F and S are always in pairs, F first and S second, F_S_F_S_F_S_F_S.
%% At each even position F expands to a left bend, ie with a "+" turn.
%% At each odd position S expands to a right bend, ie with a "-".
%% This is the "successive approximation" method for generating the
%% curve where each line segment is replaced by a bend to the left or
%% right according as it's at an even or odd position.
%%
%% The sequence of + and - turns resulting in the expansion follows
%% the "bit above lowest 1-bit" rule. This works essentially because
%% the bit above obeys an expansion rule
%%
%% if k even
%% bitabovelowest1bit(2k) = bitabovelowest1bit(k)
%% bitabovelowest1bit(2k+1) = 0 # the "+" in F -> F+S
%%
%% if k odd
%% bitabovelowest1bit(2k) = bitabovelowest1bit(k)
%% bitabovelowest1bit(2k+1) = 1 # the "-" in S -> F-S
%%
\input tikz.tex
\usetikzlibrary{lindenmayersystems}
\pgfdeclarelindenmayersystem{Dragon curve}{
\symbol{S}{\pgflsystemdrawforward}
\rule{F -> F+S}
\rule{S -> F-S}
}
\tikzpicture
\draw
[lindenmayer system={Dragon curve, step=10pt, axiom=F, order=8}]
lindenmayer system;
\endtikzpicture
\bye
Math-PlanePath-122/examples/other/sierpinski-triangle-text.logo 0000644 0001750 0001750 00000003040 12062333621 022460 0 ustar gg gg #!/usr/bin/ucblogo
; Copyright 2012 Kevin Ryde
; This file is part of Math-PlanePath.
;
; Math-PlanePath is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by the
; Free Software Foundation; either version 3, or (at your option) any later
; version.
;
; Math-PlanePath is distributed in the hope that it will be useful, but
; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
; for more details.
;
; You should have received a copy of the GNU General Public License along
; with Math-PlanePath. If not, see .
; Usage: ucblogo sierpinski-triangle-text.logo
;
; Print the Sierpinski triangle pattern in text with spaces and stars,
; using BITAND to decide whether to plot at a given X,Y or not.
;
; :limit determines the padding at the left, and within that limit the
; range of :y to print is arbitrary.
; Print rows of the triangle from 0 to :limit inclusive.
;
; *
; * *
; * *
; * * * *
; * *
; * * * *
; * * * *
; * * * * * * * *
;
make "limit 15
for [y 0 :limit] [
for [x -:limit :y] [
type ifelse (and :y+:x >= 0 ; blank left of triangle
(remainder :y+:x 2) = 0 ; only "even" squares
(bitand :y+:x :y-:x) = 0 ; Sierpinski bit test
) ["*] ["| |] ; star or space
]
print []
]
Math-PlanePath-122/examples/other/dragon-pgf-latex.tex 0000644 0001750 0001750 00000003341 12246063234 020522 0 ustar gg gg %% Copyright 2013 Kevin Ryde
%%
%% This file is part of Math-PlanePath.
%%
%% Math-PlanePath is free software; you can redistribute it and/or modify it
%% under the terms of the GNU General Public License as published by the Free
%% Software Foundation; either version 3, or (at your option) any later
%% version.
%%
%% Math-PlanePath is distributed in the hope that it will be useful, but
%% WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
%% or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
%% for more details.
%%
%% You should have received a copy of the GNU General Public License along
%% with Math-PlanePath. If not, see .
%% Usage: latex dragon-pgf-latex.tex
%% xdvi dragon-pgf-latex.dvi
%% See dragon-pgf-plain.tex for more comments. The F,S here behave
%% the same as there.
%%
%% The rule here is a 45-degree variation which keeps the net
%% direction unchanged after expansion. This means the curve endpoint
%% remains in a fixed direction horizontal no matter what expansion
%% level is applied.
%%
%% Does Mandelbrot's book ``Fractal Geometry of Nature'' have an
%% expansion like this, but maybe with just a single drawing symbol?
\documentclass{article}
\usepackage{tikz}
\usetikzlibrary{lindenmayersystems}
\begin{document}
\pgfdeclarelindenmayersystem{Dragon curve}{
\symbol{S}{\pgflsystemdrawforward}
\rule{F -> -F++S-}
\rule{S -> +F--S+}
}
\foreach \i in {1,...,8} {
\hbox{
order=\i
\hspace{.5em}
\begin{tikzpicture}[baseline=0pt]
\draw
[lindenmayer system={Dragon curve, step=10pt,angle=45, axiom=F, order=\i}]
lindenmayer system;
\end{tikzpicture}
\hspace{1em}
}
\vspace{.5ex}
}
\end{document}
Math-PlanePath-122/examples/other/dragon-curve.gnuplot 0000644 0001750 0001750 00000005547 12041161321 020646 0 ustar gg gg #!/usr/bin/gnuplot
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: gnuplot dragon-curve.gnuplot
#
# Draw the dragon curve by calculating an X,Y position for each
# point n. The plot is in "parametric" mode with t running integers
# 0 to n inclusive.
# Return the position of the highest 1-bit in n.
# The least significant bit is position 0.
# For example n=13 is binary "1101" and the high bit is pos=3.
# If n==0 then the return is 0.
# Arranging the test as n>=2 avoids infinite recursion if n==NaN (any
# comparison involving NaN is always false).
#
high_bit_pos(n) = (n>=2 ? 1+high_bit_pos(int(n/2)) : 0)
# Return 0 or 1 for the bit at position "pos" in n.
# pos==0 is the least significant bit.
#
bit(n,pos) = int(n / 2**pos) & 1
# dragon(n) returns a complex number which is the position of the
# dragon curve at integer point "n". n=0 is the first point and is at
# the origin {0,0}. Then n=1 is at {1,0} which is x=1,y=0, etc. If n
# is not an integer then the point returned is for int(n).
#
# The calculation goes by bits of n from high to low. Gnuplot doesn't
# have iteration in functions, but can go recursively from
# pos=high_bit_pos(n) down to pos=0, inclusive.
#
# mul() rotates by +90 degrees (complex "i") at bit transitions 0->1
# or 1->0. add() is a vector (i+1)**pos for each 1-bit, but turned by
# factor "i" when in a "reversed" section of curve, which is when the
# bit above is also a 1-bit.
#
dragon(n) = dragon_by_bits(n, high_bit_pos(n))
dragon_by_bits(n,pos) \
= (pos>=0 ? add(n,pos) + mul(n,pos)*dragon_by_bits(n,pos-1) : 0)
add(n,pos) = (bit(n,pos) ? (bit(n,pos+1) ? {0,1} * {1,1}**pos \
: {1,1}**pos) \
: 0)
mul(n,pos) = (bit(n,pos) == bit(n,pos+1) ? 1 : {0,1})
# Plot the dragon curve from 0 to "length" with line segments.
# "trange" and "samples" are set so the parameter t runs through
# integers t=0 to t=length inclusive.
#
# Any trange works, it doesn't have to start at 0. But must have
# enough "samples" that all integers t in the range are visited,
# otherwise vertices in the curve would be missed.
#
length=256
set trange [0:length]
set samples length+1
set parametric
set key off
plot real(dragon(t)),imag(dragon(t)) with lines
Math-PlanePath-122/examples/square-numbers.pl 0000755 0001750 0001750 00000003325 12041155563 017033 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl square-numbers.pl
#
# Print the SquareSpiral numbers in a grid like
#
# 37 36 35 34 33 32 31
# 38 17 16 15 14 13 30
# 39 18 5 4 3 12 29
# 40 19 6 1 2 11 28
# 41 20 7 8 9 10 27
# 42 21 22 23 24 25 26
# 43 44 45 46 47 ...
#
# See numbers.pl for a more sophisticated program.
use 5.004;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::SquareSpiral;
my $n_max = 115;
my $path = Math::PlanePath::SquareSpiral->new;
my %rows;
my $x_min = 0;
my $x_max = 0;
my $y_min = 0;
my $y_max = 0;
foreach my $n ($path->n_start .. $n_max) {
my ($x, $y) = $path->n_to_xy ($n);
$rows{$x}{$y} = $n;
$x_min = min($x_min, $x);
$x_max = max($x_max, $x);
$y_min = min($y_min, $y);
$y_max = max($y_max, $y);
}
my $cellwidth = length($n_max) + 2;
foreach my $y (reverse $y_min .. $y_max) {
foreach my $x ($x_min .. $x_max) {
printf ('%*s', $cellwidth, $rows{$x}{$y} || '');
}
print "\n";
}
exit 0;
Math-PlanePath-122/examples/numbers.pl 0000755 0001750 0001750 00000044744 12551140631 015543 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl numbers.pl CLASS...
# perl numbers.pl all
#
# Print the given path CLASS or classes as N numbers in a grid. Eg.
#
# perl numbers.pl SquareSpiral DiamondSpiral
#
# Parameters to the class can be given as
#
# perl numbers.pl SquareSpiral,wider=4
#
# With option "all" print all classes and a selection of their parameters,
# per the table in the code below
#
# perl numbers.pl all
#
# See square-numbers.pl for a simpler program designed just for the
# SquareSpiral. The code here tries to adapt itself to the tty width and
# stops when the width of the numbers to be displayed would be wider than
# the tty.
#
# Stopping when N goes outside the tty means that just the first say 99 or
# so N values will be shown. There's often other bigger N within the X,Y
# grid region, but the first few N show how the path begins, without
# clogging up the output.
#
# The origin 0,0 is kept in the middle of the output, horizontally, to help
# see how much is on each side and to make multiple paths printed line up
# such as the "all" option. Vertically only as many rows as necessary are
# printed.
#
# Paths with fractional X,Y positions like SacksSpiral or VogelFloret are
# rounded to character positions. There's some hard-coded fudge factors to
# try to make them come out nicely.
#
# When an X,Y position is visited more than once multiple N's are shown with
# a comma like "9,24". This can happen for example in the DragonCurve where
# points are visited twice, or when rounding gives the same X,Y for a few
# initial points such as in KochSquareflakes.
#
use 5.004;
use strict;
use POSIX ();
use List::Util 'min', 'max';
my $width = 79;
my $height = 23;
# use Term::Size if available
# chars() can return 0 for unknown size, ignore that
if (eval { require Term::Size }) {
my ($term_width, $term_height) = Term::Size::chars();
if ($term_width) { $width = $term_width - 1; }
if ($term_height) { $height = $term_height - 1; }
}
if (! @ARGV) {
push @ARGV, 'HexSpiral'; # default class to print if no args
}
my @all_classes = ('SquareSpiral',
'SquareSpiral,wider=9',
'DiamondSpiral',
'PentSpiral',
'PentSpiralSkewed',
'HexSpiral',
'HexSpiral,wider=3',
'HexSpiralSkewed',
'HexSpiralSkewed,wider=5',
'HeptSpiralSkewed',
'AnvilSpiral',
'AnvilSpiral,wider=3',
'OctagramSpiral',
'PyramidSpiral',
'PyramidRows',
'PyramidRows,step=5',
'PyramidRows,align=right',
'PyramidRows,align=left,step=4',
'PyramidSides',
'CellularRule,rule=30',
'CellularRule,rule=73',
'CellularRule54',
'CellularRule57',
'CellularRule57,mirror=1',
'CellularRule190',
'CellularRule190,mirror=1',
'TriangleSpiral',
'TriangleSpiralSkewed',
'TriangleSpiralSkewed,skew=right',
'TriangleSpiralSkewed,skew=up',
'TriangleSpiralSkewed,skew=down',
'Diagonals',
'Diagonals,direction=up',
'DiagonalsAlternating',
'DiagonalsOctant',
'DiagonalsOctant,direction=up',
'Staircase',
'StaircaseAlternating',
'StaircaseAlternating,end_type=square',
'Corner',
'Corner,wider=5',
'KnightSpiral',
'CretanLabyrinth',
'SquareArms',
'DiamondArms',
'HexArms',
'GreekKeySpiral',
'GreekKeySpiral,turns=4',
'GreekKeySpiral,turns=1',
'AztecDiamondRings',
'MPeaks',
'SacksSpiral',
'VogelFloret',
'ArchimedeanChords',
'TheodorusSpiral',
'MultipleRings',
'MultipleRings,step=14',
'PixelRings',
'FilledRings',
'Hypot',
'Hypot,points=even',
'Hypot,points=odd',
'HypotOctant',
'HypotOctant,points=even',
'HypotOctant,points=odd',
'TriangularHypot',
'TriangularHypot,points=odd',
'TriangularHypot,points=all',
'TriangularHypot,points=hex',
'TriangularHypot,points=hex_rotated',
'TriangularHypot,points=hex_centred',
'Rows',
'Columns',
'UlamWarburton',
'UlamWarburton,parts=2',
'UlamWarburton,parts=1',
'UlamWarburton,parts=octant',
'UlamWarburton,parts=octant_up',
'UlamWarburtonQuarter',
'UlamWarburtonQuarter,parts=octant',
'UlamWarburtonQuarter,parts=octant_up',
'PeanoCurve',
'PeanoCurve,radix=5',
'WunderlichSerpentine',
'WunderlichSerpentine,serpentine_type=coil',
'WunderlichSerpentine,radix=5,serpentine_type=01001_01110_01000_11111_00010',
'WunderlichMeander',
'HilbertCurve',
'HilbertSides',
'HilbertSpiral',
'ZOrderCurve',
'ZOrderCurve,radix=5',
'GrayCode',
'GrayCode,apply_type=Ts',
'GrayCode,radix=4',
'BetaOmega',
'AR2W2Curve',
'AR2W2Curve,start_shape=D2',
'AR2W2Curve,start_shape=B2',
'AR2W2Curve,start_shape=B1rev',
'AR2W2Curve,start_shape=D1rev',
'AR2W2Curve,start_shape=A2rev',
'KochelCurve',
'DekkingCurve',
'DekkingCurve,arms=2',
'DekkingCurve,arms=3',
'DekkingCurve,arms=4',
'DekkingCentres',
'CincoCurve',
'ImaginaryBase',
'ImaginaryBase,radix=4',
'ImaginaryHalf',
'ImaginaryHalf,radix=4',
'ImaginaryHalf,digit_order=XXY',
'ImaginaryHalf,digit_order=YXX',
'ImaginaryHalf,digit_order=XnXY',
'ImaginaryHalf,digit_order=XnYX',
'ImaginaryHalf,digit_order=YXnX',
'CubicBase',
'CubicBase,radix=4',
'SquareReplicate',
'CornerReplicate',
'LTiling',
'LTiling,L_fill=ends',
'LTiling,L_fill=all',
'DigitGroups',
'FibonacciWordFractal',
'Flowsnake',
'Flowsnake,arms=3',
'FlowsnakeCentres',
'FlowsnakeCentres,arms=3',
'GosperReplicate',
'GosperIslands',
'GosperSide',
'QuintetCurve',
'QuintetCurve,arms=4',
'QuintetCentres',
'QuintetReplicate',
'KochCurve',
'KochPeaks',
'KochSnowflakes',
'KochSquareflakes',
'KochSquareflakes,inward=1',
'QuadricCurve',
'QuadricIslands',
'SierpinskiCurve',
'SierpinskiCurve,arms=8',
'SierpinskiCurveStair',
'SierpinskiCurveStair,arms=2',
'SierpinskiCurveStair,diagonal_length=4',
'HIndexing',
'SierpinskiTriangle',
'SierpinskiTriangle,align=right',
'SierpinskiTriangle,align=left',
'SierpinskiTriangle,align=diagonal',
'SierpinskiArrowhead',
'SierpinskiArrowhead,align=right',
'SierpinskiArrowhead,align=left',
'SierpinskiArrowhead,align=diagonal',
'SierpinskiArrowheadCentres',
'SierpinskiArrowheadCentres,align=right',
'SierpinskiArrowheadCentres,align=left',
'SierpinskiArrowheadCentres,align=diagonal',
'DragonCurve',
'DragonCurve,arms=4',
'DragonRounded',
'DragonRounded,arms=4',
'DragonMidpoint',
'DragonMidpoint,arms=2',
'DragonMidpoint,arms=3',
'DragonMidpoint,arms=4',
'AlternatePaper',
'AlternatePaper,arms=2',
'AlternatePaper,arms=8',
'AlternatePaperMidpoint',
'AlternatePaperMidpoint,arms=2',
'AlternatePaperMidpoint,arms=8',
'CCurve',
'TerdragonCurve',
'TerdragonCurve,arms=6',
'TerdragonRounded',
'TerdragonRounded,arms=6',
'TerdragonMidpoint',
'TerdragonMidpoint,arms=6',
'R5DragonCurve',
'R5DragonCurve,arms=4',
'R5DragonMidpoint',
'R5DragonMidpoint,arms=2',
'R5DragonMidpoint,arms=3',
'R5DragonMidpoint,arms=4',
'ComplexPlus',
'ComplexPlus,realpart=2',
'ComplexMinus',
'ComplexMinus,realpart=2',
'ComplexRevolving',
'PythagoreanTree,tree_type=UAD',
'PythagoreanTree,tree_type=UAD,coordinates=AC',
'PythagoreanTree,tree_type=UAD,coordinates=BC',
'PythagoreanTree,tree_type=UAD,coordinates=PQ',
'PythagoreanTree,tree_type=UAD,coordinates=SM',
'PythagoreanTree,tree_type=UAD,coordinates=SC',
'PythagoreanTree,tree_type=UAD,coordinates=MC',
'PythagoreanTree,tree_type=FB',
'PythagoreanTree,tree_type=FB,coordinates=AC',
'PythagoreanTree,tree_type=FB,coordinates=BC',
'PythagoreanTree,tree_type=FB,coordinates=PQ',
'PythagoreanTree,tree_type=FB,coordinates=SM',
'PythagoreanTree,tree_type=FB,coordinates=SC',
'PythagoreanTree,tree_type=FB,coordinates=MC',
'PythagoreanTree,tree_type=UMT',
'PythagoreanTree,tree_type=UMT,coordinates=AC',
'PythagoreanTree,tree_type=UMT,coordinates=BC',
'PythagoreanTree,tree_type=UMT,coordinates=PQ',
'PythagoreanTree,tree_type=UMT,coordinates=SM',
'PythagoreanTree,tree_type=UMT,coordinates=SC',
'PythagoreanTree,tree_type=UMT,coordinates=MC',
'DiagonalRationals',
'DiagonalRationals,direction=up',
'CoprimeColumns',
'FactorRationals',
'GcdRationals',
'GcdRationals,pairs_order=rows_reverse',
'GcdRationals,pairs_order=diagonals_down',
'GcdRationals,pairs_order=diagonals_up',
'RationalsTree,tree_type=SB',
'RationalsTree,tree_type=CW',
'RationalsTree,tree_type=AYT',
'RationalsTree,tree_type=HCS',
'RationalsTree,tree_type=Bird',
'RationalsTree,tree_type=Drib',
'RationalsTree,tree_type=L',
'FractionsTree',
'ChanTree',
'ChanTree,k=4',
'ChanTree,k=5',
'ChanTree,k=7',
'ChanTree,k=8',
'CfracDigits',
'CfracDigits,radix=3',
'CfracDigits,radix=4',
'CfracDigits,radix=1',
'DivisibleColumns',
'DivisibleColumns,divisor_type=proper',
'WythoffArray',
'WythoffPreliminaryTriangle',
'PowerArray',
'PowerArray,radix=3',
'PowerArray,radix=4',
# in separate Math-PlanePath-Toothpick
'*ToothpickTree',
'*ToothpickTree,parts=3',
'*ToothpickTree,parts=2',
'*ToothpickTree,parts=1',
'*ToothpickTree,parts=octant',
'*ToothpickTree,parts=octant_up',
'*ToothpickTree,parts=wedge',
'*ToothpickReplicate',
'*ToothpickReplicate,parts=3',
'*ToothpickReplicate,parts=2',
'*ToothpickReplicate,parts=1',
'*ToothpickUpist',
'*ToothpickSpiral',
'*LCornerTree',
'*LCornerTree,parts=3',
'*LCornerTree,parts=2',
'*LCornerTree,parts=1',
'*LCornerTree,parts=octant',
'*LCornerTree,parts=octant+1',
'*LCornerTree,parts=octant_up',
'*LCornerTree,parts=octant_up+1',
'*LCornerTree,parts=wedge',
'*LCornerTree,parts=wedge+1',
'*LCornerTree,parts=diagonal',
'*LCornerTree,parts=diagonal-1',
'*LCornerReplicate',
'*OneOfEight',
'*OneOfEight,parts=4',
'*OneOfEight,parts=1',
'*OneOfEight,parts=octant',
'*OneOfEight,parts=octant_up',
'*OneOfEight,parts=3mid',
'*OneOfEight,parts=3side',
'*OneOfEight,parts=wedge',
'*HTree',
);
# expand arg "all" to full list
@ARGV = map {$_ eq 'all' ? @all_classes : $_} @ARGV;
my $separator = '';
foreach my $class (@ARGV) {
print $separator;
$separator = "\n";
print_class ($class);
}
sub print_class {
my ($name) = @_;
# secret leading "*Foo" means print if available
my $if_available = ($name =~ s/^\*//);
my $class = $name;
unless ($class =~ /::/) {
$class = "Math::PlanePath::$class";
}
($class, my @parameters) = split /\s*,\s*/, $class;
$class =~ /^[a-z_][:a-z_0-9]*$/i or die "Bad class name: $class";
if (! eval "require $class") {
if ($if_available) {
next;
} else {
die $@;
}
}
@parameters = map { /(.*?)=(.*)/ or die "Missing value for parameter \"$_\"";
$1,$2 } @parameters;
my %rows;
my $x_min = 0;
my $x_max = 0;
my $y_min = 0;
my $y_max = 0;
my $cellwidth = 1;
my $path = $class->new (width => POSIX::ceil($width / 4),
height => POSIX::ceil($height / 2),
@parameters);
my $x_limit_lo;
my $x_limit_hi;
if ($path->x_negative) {
my $w_cells = int ($width / $cellwidth);
my $half = int(($w_cells - 1) / 2);
$x_limit_lo = -$half;
$x_limit_hi = +$half;
} else {
my $w_cells = int ($width / $cellwidth);
$x_limit_lo = 0;
$x_limit_hi = $w_cells - 1;
}
my $y_limit_lo = 0;
my $y_limit_hi = $height-1;
if ($path->y_negative) {
my $half = int(($height-1)/2);
$y_limit_lo = -$half;
$y_limit_hi = +$half;
}
my $n_start = $path->n_start;
my $n = $n_start;
for ($n = $n_start; $n <= 999; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
# stretch these out for better resolution
if ($class =~ /Sacks/) { $x *= 1.5; $y *= 2; }
if ($class =~ /Archimedean/) { $x *= 2; $y *= 3; }
if ($class =~ /Theodorus|MultipleRings/) { $x *= 2; $y *= 2; }
if ($class =~ /Vogel/) { $x *= 2; $y *= 3.5; }
# nearest integers
$x = POSIX::floor ($x + 0.5);
$y = POSIX::floor ($y + 0.5);
my $cell = $rows{$x}{$y};
if (defined $cell) { $cell .= ','; }
$cell .= $n;
my $new_cellwidth = max ($cellwidth, length($cell) + 1);
my $new_x_limit_lo;
my $new_x_limit_hi;
if ($path->x_negative) {
my $w_cells = int ($width / $new_cellwidth);
my $half = int(($w_cells - 1) / 2);
$new_x_limit_lo = -$half;
$new_x_limit_hi = +$half;
} else {
my $w_cells = int ($width / $new_cellwidth);
$new_x_limit_lo = 0;
$new_x_limit_hi = $w_cells - 1;
}
my $new_x_min = min($x_min, $x);
my $new_x_max = max($x_max, $x);
my $new_y_min = min($y_min, $y);
my $new_y_max = max($y_max, $y);
if ($new_x_min < $new_x_limit_lo
|| $new_x_max > $new_x_limit_hi
|| $new_y_min < $y_limit_lo
|| $new_y_max > $y_limit_hi) {
last;
}
$rows{$x}{$y} = $cell;
$cellwidth = $new_cellwidth;
$x_limit_lo = $new_x_limit_lo;
$x_limit_hi = $new_x_limit_hi;
$x_min = $new_x_min;
$x_max = $new_x_max;
$y_min = $new_y_min;
$y_max = $new_y_max;
}
$n--; # the last N actually plotted
print "$name N=$n_start to N=$n\n\n";
foreach my $y (reverse $y_min .. $y_max) {
foreach my $x ($x_limit_lo .. $x_limit_hi) {
my $cell = $rows{$x}{$y};
if (! defined $cell) { $cell = ''; }
printf ('%*s', $cellwidth, $cell);
}
print "\n";
}
}
exit 0;
Math-PlanePath-122/examples/c-curve-wx.pl 0000644 0001750 0001750 00000066616 12641634400 016071 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014, 2015, 2016 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl c-curve-wx.pl
#
# This is a WxWidges GUI drawing the C curve and some variations. It's a
# little rough but can pan and zoom, and rolling the expansion level
# expansion level in the toolbar is an interesting way to see to see the
# curve or curves develop.
#
# Segments are drawn either as lines or as triangles (on the expansion side
# of the segment). When multiple copies of the curve are selected they're
# in different colours. (Though presently when line segments overlap only
# one colour is shown.)
#
# Drawing is done with Math::PlanePath::CCurve and
# Geometry::AffineTransform. The drawing is not particularly efficient
# since it runs through all segments, even those which are off-screen. The
# drawing is piece-wise in an idle loop, so you can move or change without
# waiting for it to finish.
#
# Some of the drawing options can be set initially from the command line.
# See the usage message print below or run --help.
use 5.008;
use strict;
use warnings;
use FindBin;
use Getopt::Long;
use Geometry::AffineTransform;
use List::Util 'min','max';
use Math::Libm 'M_PI', 'hypot';
use Math::PlanePath::CCurve;
use Time::HiRes;
use POSIX ();
use Wx;
use Wx::Event;
# uncomment this to run the ### lines
# use Smart::Comments;
our $VERSION = 122;
my $level = 5;
my $scale = 1;
my $x_offset = 0;
my $y_offset = 0;
my $window_initial_width;
my $initial_window_height;
my $window_initial_fullscreen;
my @types_list
= (
# curve goes East so x=0,y=0 to x=1,y=0
# optional $rotate*90 degrees (anti-clockwise)
{ name => '1',
copies => [ { x => 0, y => 0 } ],
},
{ name => 'Part',
copies => [ { x => 0, y => 0 } ],
min_x => -.1, max_x => 1.1,
min_y => -.1, max_y => .7,
},
{ name => '2 Pair',
# 0,0 -----> 1,0
# 0,0 <----- 1,0
copies => [ { x => 0, y => 0 },
{ x => 1, y => 0, rotate => 2 } ],
},
{ name => '2 Line',
copies => [ { x => 0, y => 0 },
{ x => -1, y => 0 } ],
},
{ name => '2 Arms',
copies => [ { x => 0, y => 0 },
{ x => 0, y => 0, rotate => 2 } ],
},
# { name => '2 Above',
# copies => [ { x => 0, y => 0 },
# { x => 0, y => 1 } ],
# },
{ name => '4 Pinwheel',
copies => [ { x => 0, y => 0 },
{ x => 0, y => 0, rotate => 1 },
{ x => 0, y => 0, rotate => 2 },
{ x => 0, y => 0, rotate => 3 },
],
},
{ name => '4 Square Inward',
# 0,0 -----> 1,0
# ^ |
# | v
# 0,-1 <----- 1,-1
copies => [ { x => 0, y => 0 },
{ x => 0, y => -1, rotate => 1 },
{ x => 1, y => -1, rotate => 2 },
{ x => 1, y => 0, rotate => 3 },
],
},
{ name => '4 Square Outward',
# 0,1 <----- 1,1
# | ^
# v |
# 0,0 -----> 1,0
copies => [ { x => 0, y => 0 },
{ x => 1, y => 0, rotate => 1 },
{ x => 1, y => 1, rotate => 2 },
{ x => 0, y => 1, rotate => 3 },
],
},
{ name => '4 Pairs',
# 0,0 -----> 1,0 -----> 2,0
# 0,0 <----- 1,0 <----- 2,0
copies => [ { x => 0, y => 0 },
{ x => 1, y => 0 },
{ x => 2, y => 0, rotate => 2 },
{ x => 1, y => 0, rotate => 2 },
],
},
{ name => '8 Cross',
copies => [ { x => 0, y => 0 },
{ x => 0, y => 0, rotate => 1 },
{ x => 0, y => 0, rotate => 2 },
{ x => 0, y => 0, rotate => 3 },
{ x => 1, y => 0, rotate => 2 },
{ x => -1, y => 0 },
{ x => 0, y => -1, rotate => 1 },
{ x => 0, y => 1, rotate => 3 },
],
},
{ name => '8 Square',
copies => [ { x => 0, y => 0 }, # 4 inward
{ x => 1, y => 0, rotate => 1 },
{ x => 1, y => 1, rotate => 2 },
{ x => 0, y => 1, rotate => 3 },
{ x => 0, y => 1 }, # 4 outward
{ x => 0, y => 0, rotate => 1 },
{ x => 1, y => 0, rotate => 2 },
{ x => 1, y => 1, rotate => 3 },,
],
},
{ name => '24 Clipped',
copies => [
{ x => -1, y => 0 },
{ x => 0, y => 0 },
{ x => 1, y => 0 },
{ x => -1, y => 1 },
{ x => 0, y => 1 },
{ x => 1, y => 1 },
{ x => 0, y => 0, rotate => 2 },
{ x => 1, y => 0, rotate => 2 },
{ x => 2, y => 0, rotate => 2 },
{ x => 0, y => 1, rotate => 2 },
{ x => 1, y => 1, rotate => 2 },
{ x => 2, y => 1, rotate => 2 },
{ x => 0, y => -1, rotate => 1 },
{ x => 0, y => 0, rotate => 1 },
{ x => 0, y => 1, rotate => 1 },
{ x => 1, y => -1, rotate => 1 },
{ x => 1, y => 0, rotate => 1 },
{ x => 1, y => 1, rotate => 1 },
{ x => 0, y => 0, rotate => 3 },
{ x => 0, y => 1, rotate => 3 },
{ x => 0, y => 2, rotate => 3 },
{ x => 1, y => 0, rotate => 3 },
{ x => 1, y => 1, rotate => 3 },
{ x => 1, y => 2, rotate => 3 },
],
min_x => -0.1, max_x => 1.1,
min_y => -0.1, max_y => 1.1,
clip_min_x => 0,
clip_max_x => 1,
clip_min_y => 0,
clip_max_y => 1,
},
{ name => '24',
copies => [
{ x => -1, y => 0 },
{ x => 0, y => 0 },
{ x => 1, y => 0 },
{ x => -1, y => 1 },
{ x => 0, y => 1 },
{ x => 1, y => 1 },
{ x => 0, y => 0, rotate => 2 },
{ x => 1, y => 0, rotate => 2 },
{ x => 2, y => 0, rotate => 2 },
{ x => 0, y => 1, rotate => 2 },
{ x => 1, y => 1, rotate => 2 },
{ x => 2, y => 1, rotate => 2 },
{ x => 0, y => -1, rotate => 1 },
{ x => 0, y => 0, rotate => 1 },
{ x => 0, y => 1, rotate => 1 },
{ x => 1, y => -1, rotate => 1 },
{ x => 1, y => 0, rotate => 1 },
{ x => 1, y => 1, rotate => 1 },
{ x => 0, y => 0, rotate => 3 },
{ x => 0, y => 1, rotate => 3 },
{ x => 0, y => 2, rotate => 3 },
{ x => 1, y => 0, rotate => 3 },
{ x => 1, y => 1, rotate => 3 },
{ x => 1, y => 2, rotate => 3 },
],
},
{ name => 'Half',
copies => [ { x => 0, y => 0 } ],
clip_min_x => -2, clip_max_x => .5, # clip second half
clip_min_y => -1, clip_max_y => 2,
},
);
my %types_hash = map { $_->{'name'} => $_ } @types_list;
my @type_names = map {$_->{'name'}} @types_list;
my $type = $types_list[0]->{'name'};
my @figure_names = ('Arrows','Triangles','Lines');
my $figure = $figure_names[0];
Getopt::Long::Configure ('no_ignore_case', 'bundling');
if (! Getopt::Long::GetOptions
('help|?' => sub {
print "$FindBin::Script [--options]\n
--version print program version
--display DISPLAY X display to use
--level N expansion level
--geometry WIDTHxHEIGHT window size
--fullscreen full screen window
--initial=1 initial centre cell value
";
exit 0;
},
'version' => sub {
print "$FindBin::Script version $VERSION\n";
exit 0;
},
'level=i' => \$level,
'geometry=s' => sub {
my ($opt, $str) = @_;
$str =~ /^(\d+)x(\d+)$/ or die "Unrecognised --geometry \"$str\"";
$window_initial_width = $1;
$initial_window_height = $2;
},
'fullscreen' => \$window_initial_fullscreen,
)) {
exit 1;
}
my $path = Math::PlanePath::CCurve->new;
my @colours;
my @brushes;
my @pens;
my $brush_black;
{
package MyApp;
use base 'Wx::App';
sub OnInit {
my ($self) = @_;
# $self->SUPER::OnInit();
foreach my $r (255/4, 255*2/4, 255) {
foreach my $g (255/4, 255*2/4, 255) {
foreach my $b (255/4, 255*2/4, 255) {
my $colour = Wx::Colour->new ($r, $g, $b);
push @colours, $colour;
my $brush = Wx::Brush->new ($colour, Wx::wxSOLID());
push @brushes, $brush;
my $pen = Wx::Pen->new ($colour, 1, Wx::wxSOLID());
push @pens, $pen;
}
}
}
$brush_black = Wx::Brush->new (Wx::wxBLACK, Wx::wxSOLID());
return 1;
}
}
my $app = MyApp->new;
$app->SetAppName($FindBin::Script);
use constant FULLSCREEN_HIDE_BITS => (Wx::wxFULLSCREEN_NOBORDER()
| Wx::wxFULLSCREEN_NOCAPTION());
my $main = Wx::Frame->new(undef, # parent
Wx::wxID_ANY(), # ID
$FindBin::Script); # title
$main->SetIcon (Wx::GetWxPerlIcon());
use constant ZOOM_IN_ID => Wx::wxID_HIGHEST() + 1;
use constant ZOOM_OUT_ID => Wx::wxID_HIGHEST() + 2;
my $accel_table = Wx::AcceleratorTable->new
([Wx::wxACCEL_NORMAL(), Wx::WXK_NUMPAD_ADD(), ZOOM_IN_ID],
[Wx::wxACCEL_CTRL(), Wx::WXK_NUMPAD_ADD(), ZOOM_IN_ID],
[Wx::wxACCEL_CTRL(), 'd', ZOOM_IN_ID],
[Wx::wxACCEL_NORMAL(), 'd', ZOOM_IN_ID],
[Wx::wxACCEL_NORMAL(), 'D', ZOOM_IN_ID],
[Wx::wxACCEL_NORMAL(), Wx::WXK_NUMPAD_SUBTRACT(), ZOOM_OUT_ID],
[Wx::wxACCEL_CTRL(), Wx::WXK_NUMPAD_SUBTRACT(), ZOOM_OUT_ID]);
$main->SetAcceleratorTable ($accel_table);
### $accel_table
my $menubar = Wx::MenuBar->new;
$main->SetMenuBar ($menubar);
if (! defined $window_initial_width) {
my $screen_size = Wx::GetDisplaySize();
$main->SetSize (Wx::Size->new ($screen_size->GetWidth * 0.8,
$screen_size->GetHeight * 0.8));
}
my $draw = Wx::Window->new ($main, # parent
Wx::wxID_ANY(), # ID
Wx::wxDefaultPosition(),
Wx::wxDefaultSize());
$draw->SetBackgroundColour (Wx::wxBLACK());
Wx::Event::EVT_PAINT ($draw, \&OnPaint);
Wx::Event::EVT_SIZE ($draw, \&OnSize);
Wx::Event::EVT_IDLE ($draw, \&OnIdle);
Wx::Event::EVT_MOUSEWHEEL ($draw, \&OnMouseWheel);
Wx::Event::EVT_LEFT_DOWN ($draw, \&OnLeftDown);
Wx::Event::EVT_MOTION ($draw, \&OnMotion);
Wx::Event::EVT_ENTER_WINDOW ($draw, \&OnMotion);
Wx::Event::EVT_KEY_DOWN ($draw, \&OnKey);
$draw->SetExtraStyle($draw->GetExtraStyle
| Wx::wxWS_EX_PROCESS_IDLE());
if (defined $window_initial_width) {
$draw->SetSize(Wx::Size->new($window_initial_width,$initial_window_height));
}
{
my $menu = Wx::Menu->new;
$menubar->Append ($menu, '&File');
# $menu->Append (Wx::wxID_PRINT(),
# '',
# Wx::GetTranslation('Print the image.'));
# Wx::Event::EVT_MENU ($main, Wx::wxID_PRINT(), 'print_image');
#
# $menu->Append (Wx::wxID_PREVIEW(),
# '',
# Wx::GetTranslation('Preview image print.'));
# Wx::Event::EVT_MENU ($main, Wx::wxID_PREVIEW(), 'print_preview');
#
# $menu->Append (Wx::wxID_PRINT_SETUP(),
# Wx::GetTranslation('Print &Setup'),
# Wx::GetTranslation('Setup page print.'));
# Wx::Event::EVT_MENU ($main, Wx::wxID_PRINT_SETUP(), 'print_setup');
$menu->Append(Wx::wxID_EXIT(),
'',
'Exit the program');
Wx::Event::EVT_MENU ($main, Wx::wxID_EXIT(), sub {
my ($main, $event) = @_;
$main->Close;
});
}
{
my $menu = Wx::Menu->new;
$menubar->Append ($menu, '&View');
{
my $item = $menu->Append (Wx::wxID_ANY(),
"&Fullscreen\tCtrl-F",
"Toggle full screen or normal window (use accelerator Ctrl-F to return from fullscreen).",
Wx::wxITEM_CHECK());
Wx::Event::EVT_MENU ($main, $item,
sub {
my ($self, $event) = @_;
### Wx-Main toggle_fullscreen() ...
$main->ShowFullScreen (! $main->IsFullScreen,
FULLSCREEN_HIDE_BITS);
}
);
Wx::Event::EVT_UPDATE_UI($main, $item,
sub {
my ($main, $event) = @_;
### Wx-Main _update_ui_fullscreen_menuitem: "@_"
# though if FULLSCREEN_HIDE_BITS hides the
# menubar then the item won't be seen when
# checked ...
$item->Check ($main->IsFullScreen);
});
}
{
$menu->Append (ZOOM_IN_ID,
"Zoom &In\tCtrl-+",
Wx::GetTranslation('Zoom in.'));
Wx::Event::EVT_MENU ($main, ZOOM_IN_ID, \&zoom_in);
}
{
$menu->Append (ZOOM_OUT_ID,
"Zoom &Out\tCtrl--",
Wx::GetTranslation('Zoom out.'));
Wx::Event::EVT_MENU ($main, ZOOM_OUT_ID, \&zoom_out);
}
{
my $item = $menu->Append (Wx::wxID_ANY(),
"&Centre\tCtrl-C",
Wx::GetTranslation('Centre display in window.'));
Wx::Event::EVT_MENU ($main, $item, sub {
$x_offset = 0;
$y_offset = 0;
});
}
}
my $toolbar = $main->CreateToolBar;
{
{
my $choice = Wx::Choice->new ($toolbar,
Wx::wxID_ANY(),
Wx::wxDefaultPosition(),
Wx::wxDefaultSize(),
\@type_names);
$choice->SetSelection(0);
$toolbar->AddControl($choice);
$toolbar->SetToolShortHelp
($choice->GetId,
'The display type.');
Wx::Event::EVT_CHOICE ($main, $choice,
sub {
my ($main, $event) = @_;
$type = $type_names[$choice->GetSelection];
### $type
$draw->Refresh;
});
}
{
my $spin = Wx::SpinCtrl->new ($toolbar,
Wx::wxID_ANY(),
$level, # initial value
Wx::wxDefaultPosition(),
Wx::Size->new(40,-1),
Wx::wxSP_ARROW_KEYS(),
0, # min
POSIX::INT_MAX(), # max
$level); # initial
$toolbar->AddControl($spin);
$toolbar->SetToolShortHelp ($spin->GetId,
'Expansion level.');
Wx::Event::EVT_SPINCTRL ($main, $spin,
sub {
my ($main, $event) = @_;
$level = $spin->GetValue;
$draw->Refresh;
});
}
{
my $choice = Wx::Choice->new ($toolbar,
Wx::wxID_ANY(),
Wx::wxDefaultPosition(),
Wx::wxDefaultSize(),
\@figure_names);
$choice->SetSelection(0);
$toolbar->AddControl($choice);
$toolbar->SetToolShortHelp
($choice->GetId,
'The figure to draw at each point.');
Wx::Event::EVT_CHOICE ($main, $choice,
sub {
my ($main, $event) = @_;
$figure = $figure_names[$choice->GetSelection];
$draw->Refresh;
});
}
}
#------------------------------------------------------------------------------
# Keyboard
sub zoom_in {
$scale *= 1.5;
# $x_offset *= 1.5;
# $y_offset *= 1.5;
$draw->Refresh;
}
sub zoom_out {
$scale /= 1.5;
# $x_offset /= 1.5;
# $y_offset /= 1.5;
$draw->Refresh;
}
# $event is a wxMouseEvent
sub OnKey {
my ($draw, $event) = @_;
### Draw OnLeftDown() ...
my $keycode = $event->GetKeyCode;
### $keycode
# if ($keycode == Wx::WXK_NUMPAD_ADD()) {
# zoom_in();
# } elsif ($keycode == Wx::WXK_NUMPAD_SUBTRACT()) {
# zoom_out();
# }
}
#------------------------------------------------------------------------------
# mouse wheel scroll
sub OnMouseWheel {
my ($draw, $event) = @_;
### OnMouseWheel() ..
# "Control" by page, otherwise by step
my $frac = ($event->ControlDown ? 0.9 : 0.1)
* $event->GetWheelRotation / $event->GetWheelDelta;
# "Shift" horizontally, otherwise vertically
my $size = $draw->GetClientSize;
if ($event->ShiftDown) {
$x_offset += int($size->GetWidth * $frac);
} else {
$y_offset += int($size->GetHeight * $frac);
}
$draw->Refresh;
}
#------------------------------------------------------------------------------
# mouse drag
# $drag_x,$drag_y are the X,Y position where dragging started.
# If dragging is not in progress then $drag_x is undef.
my ($drag_x, $drag_y);
# $event is a wxMouseEvent
sub OnLeftDown {
my ($draw, $event) = @_;
### Draw OnLeftDown() ...
$drag_x = $event->GetX;
$drag_y = $event->GetY;
$event->Skip(1); # propagate to other processing
}
sub OnMotion {
my ($draw, $event) = @_;
### Draw OnMotion() ...
if ($event->Dragging) {
if (defined $drag_x) {
### drag ...
my $x = $event->GetX;
my $y = $event->GetY;
$x_offset += $x - $drag_x;
$y_offset += $y - $drag_y;
$drag_x = $x;
$drag_y = $y;
$draw->Refresh;
}
}
}
#------------------------------------------------------------------------------
# drawing
sub TopStart {
my ($k) = @_;
return (2**$k + ($k%2==0 ? -1 : 1))/3;
}
sub TopEnd {
my ($k) = @_;
return TopStart($k+1);
}
sub OnSize {
my ($draw, $event) = @_;
$draw->Refresh;
}
# $idle_drawing is a coderef which is setup by OnPaint() to draw more of the
# curves. If it doesn't finish the drawing then it does a ->RequestMore()
# to go again when next idle (which might be immediately).
my $idle_drawing;
sub OnPaint {
my ($draw, $event) = @_;
### Drawing OnPaint(): $event
### foreground: $draw->GetForegroundColour->GetAsString(4)
### background: $draw->GetBackgroundColour->GetAsString(4)
my $busy = Wx::BusyCursor->new;
my $dc = Wx::PaintDC->new ($draw);
{
my $brush = $dc->GetBackground;
$brush->SetColour ($draw->GetBackgroundColour);
$dc->SetBackground ($brush);
$dc->Clear;
}
# $brush->SetColour (Wx::wxWHITE);
# $brush->SetStyle (Wx::wxSOLID());
# $dc->SetBrush ($brush);
#
# $dc->DrawRectangle (20,20,100,100);
my $colour = Wx::wxGREEN();
{
my $pen = $dc->GetPen;
$pen->SetColour($colour);
$dc->SetPen($pen);
}
my $brush = $dc->GetBrush;
$brush->SetColour ($colour);
$brush->SetStyle (Wx::wxSOLID());
$dc->SetBrush ($brush);
my ($width,$height) = $dc->GetSizeWH;
### $width
### $height
my ($n_lo, $n_hi);
if ($type eq 'Part') {
$n_lo = TopStart($level);
$n_hi = TopEnd($level);
} else {
($n_lo, $n_hi) = $path->level_to_n_range($level);
}
my ($x_lo,$y_lo) = $path->n_to_xy($n_lo);
my ($x_hi,$y_hi) = $path->n_to_xy($n_hi);
my ($dx,$dy) = ($x_hi-$x_lo, $y_hi-$y_lo);
my $len = hypot($dx,$dy);
my $angle = atan2($dy,$dx) * 180 / M_PI(); # dx,dy plus 180deg
### $angle
### $len
my $to01 = Geometry::AffineTransform->new;
$to01->translate(-$x_lo, -$y_lo);
$to01->rotate(- $angle);
if ($len) {
$to01->scale(1/$len, 1/$len);
}
my $t = $types_hash{$type};
### $t
my $min_x = $t->{'min_x'};
my $min_y = $t->{'min_y'};
my $max_x = $t->{'max_x'};
my $max_y = $t->{'max_y'};
if (! defined $min_x) {
$min_x = 0;
$min_y = 0;
$max_x = 0;
$max_y = 0;
foreach my $copy (@{$t->{'copies'}}) {
my $this_min_x = -.5;
my $this_max_x = 1.5;
my $this_min_y = -1;
my $this_max_y = .25;
foreach (1 .. ($copy->{'rotate'} || 0)) {
($this_max_y, $this_min_x, $this_max_x, $this_min_y)
= ($this_max_x, -$this_max_y, -$this_min_y, $this_min_x);
}
$this_min_x += $copy->{'x'};
$this_max_x += $copy->{'x'};
$this_min_y += $copy->{'y'};
$this_max_y += $copy->{'y'};
### this extents: "X $this_min_x to $this_max_x Y $this_min_y to $this_max_y"
$min_x = min($min_x, $this_min_x);
$min_y = min($min_y, $this_min_y);
$max_x = max($max_x, $this_max_x);
$max_y = max($max_y, $this_max_y);
}
}
### extents: "X $min_x to $max_x Y $min_y to $max_y"
# min_x ----------- 0 ---- max_x
# ^
# mid = (max+min)/2
my $extent_x = $max_x - $min_x;
my $extent_y = $max_y - $min_y;
### $extent_x
### $extent_y
my $affine = Geometry::AffineTransform->new;
$affine->translate(- ($min_x + $max_x)/2, # extent midpoints
- ($min_y + $max_y)/2);
my $extent_scale = min($width/$extent_x, $height/$extent_y) * .9;
$affine->scale($extent_scale, $extent_scale); # shrink
### $extent_scale
$affine->scale(1, -1); # Y upwards
$affine->scale($scale, $scale);
$affine->scale(-1,-1); # rotate 180
$affine->translate($width/2, $height/2); # 0,0 at centre
$affine->translate($x_offset, $y_offset);
my ($prev_x,$prev_y) = $to01->transform($x_lo,$y_lo);
### origin: "$prev_x, $prev_y"
undef $dc;
my $bitmap = Wx::Bitmap->new ($width, $height);
my $scale = 0.5;
# $scale = sqrt(3)/2;
my $iterations = 100;
my $n = $n_lo+1;
$idle_drawing = sub {
my ($event) = @_;
### idle_drawing: $event
my $time = Time::HiRes::time();
# my $client_dc = Wx::ClientDC->new($draw);
# my $dc = Wx::BufferedDC->new($client_dc, $bitmap);
my $dc = Wx::ClientDC->new($draw);
my $remaining = $iterations;
for ( ; $n <= $n_hi; $n++) {
if ($remaining-- < 0) {
# each took time/iterations, want to take .25 sec so
# new_iterations = .25/(time/iterations)
# new_iterations = iterations * .25/time
my $time = Time::HiRes::time() - $time;
$iterations = int(($iterations+1) * .25/$time);
# print "$iterations cf time $time\n";
if ($event) { $event->RequestMore(1); }
return;
}
my ($x,$y) = $path->n_to_xy($n);
($x,$y) = $to01->transform($x,$y);
### point: "$x, $y"
my $c = 0;
foreach my $copy (@{$t->{'copies'}}) {
$c++;
my $x = $x;
my $y = $y;
my $prev_x = $prev_x;
my $prev_y = $prev_y;
if ($copy->{'invert'}) {
$y = -$y;
$prev_y = -$prev_y;
}
if (my $r = $copy->{'rotate'}) {
foreach (1 .. $r) {
($x,$y) = (-$y,$x); # rotate +90
($prev_x, $prev_y) = (-$prev_y, $prev_x); # rotate +90
}
}
$x += $copy->{'x'};
$y += $copy->{'y'};
$prev_x += $copy->{'x'};
$prev_y += $copy->{'y'};
my $dx = $x - $prev_x;
my $dy = $y - $prev_y;
my $mx = ($x + $prev_x)/2; # midpoint prev to this
my $my = ($y + $prev_y)/2;
if (defined $t->{'clip_min_x'}) {
my $cx = $mx - $dy * $scale * .5;
my $cy = $my + $dx * $scale * .5;
if ($cx < $t->{'clip_min_x'} || $cx > $t->{'clip_max_x'}
|| $cy < $t->{'clip_min_y'} || $cy > $t->{'clip_max_y'}) {
next;
}
}
$mx += $dy * $scale; # dx,dy turned right -90deg
$my -= $dx * $scale;
($prev_x,$prev_y) = $affine->transform($prev_x,$prev_y);
($mx, $my) = $affine->transform($mx,$my);
($x,$y) = $affine->transform($x,$y);
### screen: "$prev_x, $prev_y to $x, $y"
if (xy_in_rect($x,$y, 0,$width,0,$height)
|| xy_in_rect($prev_x,$prev_y, 0,0,$width,$height)) {
if ($figure eq 'Triangles') {
$dc->SetBrush ($brushes[$c]);
$dc->SetPen ($pens[$c]);
$dc->DrawPolygon
([ Wx::Point->new($prev_x, $prev_y),
Wx::Point->new($mx, $my),
Wx::Point->new($x, $y),
],
0,0);
} elsif ($figure eq 'Arrows') {
$dx = $x - $prev_x;
$dy = $y - $prev_y;
$prev_x += $dx*.1; # shorten
$prev_y += $dy*.1;
$x -= $dx*.1;
$y -= $dy*.1;
my $rx = -$dy; # to the right
my $ry = $dx;
$prev_x += $rx*.05; # gap between overlapping segments
$prev_y += $ry*.05;
$x += $rx*.05;
$y += $ry*.05;
$dc->SetPen ($pens[$c]);
$dc->DrawLines
([ Wx::Point->new($prev_x, $prev_y),
Wx::Point->new($x, $y),
Wx::Point->new($x - $dx*.25 + $rx*.12, # arrow harpoon
$y - $dy*.25 + $ry*.12),
],
0,0);
} else { # $figure eq 'Lines'
$dc->SetPen ($pens[$c]);
$dc->DrawLine ($prev_x,$prev_y, $x,$y);
($prev_x,$prev_y) = ($x,$y);
}
}
}
# after all copies
($prev_x,$prev_y) = ($x,$y);
}
if ($type eq 'square') {
$dc->SetBrush ($brushes[0]);
$dc->SetPen ($pens[0]);
my ($x1,$y1) = $affine->transform(-$y_hi,$x_hi);
my ($x2,$y2) = $affine->transform($x_hi,$y_hi);
if ($x1 > $x2) { ($x1,$x2) = ($x2,$x1); }
if ($y1 > $y2) { ($y1,$y2) = ($y2,$y1); }
$dc->DrawRectangle (0,0, $width,$y1-5);
$dc->DrawRectangle (0,0, $x1-5, $height);
$dc->DrawRectangle ($x2+5,0, $width, $height);
$dc->DrawRectangle (0,$y2+5, $width,$height);
}
undef $idle_drawing;
};
$idle_drawing->();
}
sub OnIdle {
my ($draw, $event) = @_;
### draw OnIdle(): $event
if ($idle_drawing) {
$idle_drawing->($event);
}
}
sub xy_in_rect {
my ($x,$y, $x1,$y1, $x2,$y2) = @_;
return (($x >= $x1 && $x <= $x2)
&& ($y >= $y1 && $y <= $y2));
}
### $accel_table
$draw->SetFocus;
if ($window_initial_fullscreen) {
$main->ShowFullScreen(1, FULLSCREEN_HIDE_BITS);
} else {
$main->Show;
}
$app->MainLoop;
exit 0;
Math-PlanePath-122/devel/ 0002755 0001750 0001750 00000000000 12641645163 013010 5 ustar gg gg Math-PlanePath-122/devel/r5.pl 0000644 0001750 0001750 00000004703 11507022742 013665 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use POSIX ();
use List::Util 'min', 'max';
# uncomment this to run the ### lines
use Smart::Comments;
my $width = 79;
my $height = 23;
my @turn_right = (0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 0);
sub xturn_right {
my ($n) = @_;
return $turn_right[$n-1];
}
sub turn_right {
my ($n) = @_;
while (($n % 5) == 0) {
$n = int($n/5);
}
return ($n % 5) > 2;
}
{
my %rows;
my $x_min = 0;
my $x_max = 0;
my $y_min = 0;
my $y_max = 0;
my $cellwidth = 1;
my $xd = 1;
my $yd = 0;
my $x = 0;
my $y = 0;
my $n = 1;
foreach my $n (1 .. 500) {
$x += $xd;
$y += $yd;
my $cell = $rows{$x}{$y};
if ($cell) { $cell .= '/'; }
$cell .= $n;
$rows{$x}{$y} = $cell;
$cellwidth = max ($cellwidth, length($cell)+1);
### draw: "$x,$y $cell"
$x_min = min ($x_min, $x);
$x_max = max ($x_max, $x);
$y_min = min ($y_min, $y);
$y_max = max ($y_max, $y);
my $turn_right = turn_right($n) // last;
if ($turn_right) {
### right: "$xd,$yd -> $yd,@{[-$xd]}"
($xd,$yd) = ($yd,-$xd);
} else {
### left: "$xd,$yd -> @{[-$yd]},$xd"
($xd,$yd) = (-$yd,$xd);
}
}
### $x_min
### $x_max
### $y_min
### $y_max
foreach my $y (reverse $y_min .. $y_max) {
foreach my $x ($x_min .. $x_max) {
printf ('%*s', $cellwidth, $rows{$x}{$y} || '');
}
print "\n";
}
exit 0;
}
{
foreach my $n (1 .. 50) {
print turn($n),",";
}
print "\n";
exit 0;
}
Math-PlanePath-122/devel/sierpinski-arrowhead.pl 0000644 0001750 0001750 00000010077 12021370606 017467 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::SierpinskiArrowhead;
# uncomment this to run the ### lines
use Smart::Comments;
{
# turn sequence
require Math::NumSeq::PlanePathTurn;
require Math::BaseCnv;
my $seq = Math::NumSeq::PlanePathTurn->new
(planepath => 'SierpinskiArrowhead',
turn_type => 'Left');
foreach (1 .. 400) {
my ($i, $value) = $seq->next;
my $i3 = Math::BaseCnv::cnv($i,10,3);
my $calc = calc_turnleft($i);
print "$i $i3 $value $calc\n";
}
sub calc_turnleft { # not working
my ($n) = @_;
my $ret = 1;
my $flip = 0;
while ($n && ($n % 9) == 0) {
$n = int($n/9);
}
if ($n) {
my $digit = $n % 9;
my $flip = ($digit == 0
|| $digit == 1 # 01
# || $digit == 3 # 10
|| $digit == 5 # 12
|| $digit == 6 # 20
|| $digit == 7 # 21
);
$ret ^= $flip;
$n = int($n/9);
}
while ($n) {
my $digit = $n % 9;
my $flip = ($digit == 1 # 01
|| $digit == 3 # 10
|| $digit == 5 # 12
|| $digit == 7 # 21
);
$ret ^= $flip;
$n = int($n/9);
}
return $ret;
}
sub WORKING__calc_turnleft { # works
my ($n) = @_;
my $ret = 1;
while ($n && ($n % 3) == 0) {
$ret ^= 1; # flip for trailing 0s
$n = int($n/3);
}
$n = int($n/3);
while ($n) {
if (($n % 3) == 1) { # flip for all 1s
$ret ^= 1;
}
$n = int($n/3);
}
return $ret;
}
sub count_digits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count++;
$n = int($n/3);
}
return $count;
}
sub count_1_digits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += (($n % 3) == 1);
$n = int($n/3);
}
return $count;
}
exit 0;
}
{
# direction sequence
require Math::NumSeq::PlanePathDelta;
require Math::BaseCnv;
my $seq = Math::NumSeq::PlanePathDelta->new
(planepath => 'SierpinskiArrowhead',
delta_type => 'TDir6');
foreach (1 .. 3**4+1) {
my ($i, $value) = $seq->next;
# $value %= 6;
my $i3 = Math::BaseCnv::cnv($i,10,3);
my $calc = calc_dir6($i);
print "$i $i3 $value $calc\n";
}
sub calc_dir6 { # works
my ($n) = @_;
my $dir = 1;
while ($n) {
if (($n % 9) == 0) {
} elsif (($n % 9) == 1) {
$dir = 3 - $dir;
} elsif (($n % 9) == 2) {
$dir = $dir + 2;
} elsif (($n % 9) == 3) {
$dir = 3 - $dir;
} elsif (($n % 9) == 4) {
} elsif (($n % 9) == 5) {
$dir = 1 - $dir;
} elsif (($n % 9) == 6) {
$dir = $dir - 2;
} elsif (($n % 9) == 7) {
$dir = 1 - $dir;
} elsif (($n % 9) == 8) {
}
$n = int($n/9);
}
return $dir % 6;
}
sub Xcalc_dir6 { # works
my ($n) = @_;
my $dir = 1;
while ($n) {
if (($n % 3) == 0) {
}
if (($n % 3) == 1) {
# mirror
$dir = 3 - $dir;
}
if (($n % 3) == 2) {
$dir = $dir + 2;
}
$n = int($n/3);
if (($n % 3) == 0) {
}
if (($n % 3) == 1) {
# mirror
$dir = 3 - $dir;
}
if (($n % 3) == 2) {
$dir = $dir - 2;
}
$n = int($n/3);
}
return $dir % 6;
}
exit 0;
}
Math-PlanePath-122/devel/koch-squareflakes.pl 0000644 0001750 0001750 00000011740 12375744415 016762 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use Math::PlanePath::KochSquareflakes;
# uncomment this to run the ### lines
# use Smart::Comments;
{
# area
#
# start diag[0] = 0
# start straight[0] = 4
# diag[n+1] = 2*straight[n] + 2*diag[n]
# straight[n+1] = 2*straight[n] + 2*diag[n]
#
#
require Math::Geometry::Planar;
my $path = Math::PlanePath::KochSquareflakes->new;
my @values;
my $prev_a_log = 0;
my $prev_len_log = 0;
foreach my $level (1 .. 7) {
my $n_level = (4**($level+1) - 1) / 3;
my $n_end = $n_level + 4**$level;
my @points;
foreach my $n ($n_level .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
push @points, [$x,$y];
}
### @points
my $polygon = Math::Geometry::Planar->new;
$polygon->points(\@points);
my $a = $polygon->area;
my $len = $polygon->perimeter;
my $a_log = log($a);
my $len_log = log($len);
my $d_a_log = $a_log - $prev_a_log;
my $d_len_log = $len_log - $prev_len_log;
my $f = $d_a_log / $d_len_log;
my $formula = area_by_formula($level);
print "$level $a $formula\n";
# print "$level $d_len_log $d_a_log $f\n";
push @values, $a;
$prev_a_log = $a_log;
$prev_len_log = $len_log;
}
shift @values;
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values);
exit 0;
sub area_by_formula {
my ($n) = @_;
return (9**$n - 4**$n)/5;
# return (4 * (9**$n - 4**$n)/5 + 16**$n);
}
}
{
# max extents of a single side
# horiz: 1, 4, 14, 48, 164, 560, 1912, 6528, 22288, 76096, 259808, 887040
# A007070 a(n+1) = 4*a(n) - 2*a(n-1), starting 1,4
#
# diag: 1, 3, 10, 34, 116, 396, 1352, 4616, 15760, 53808, 183712, 627232
# A007052 a(n+1) = 4*a(n) - 2*a(n-1), starting 1,3
# A007070 max horiz dist from ring start pos 4,14,48,164 side width
# A206374 N of the max position 2,9,37,149 corner
# A003480 X of the max position 2,7,24,82 last
# A007052 max vert dist from ring start pos 3,10,34,116 height
# A072261 N of the max Y position 7,29,117,469 Y axis
# A007052 Y of the max position 3,10,34,116
my $path = Math::PlanePath::KochSquareflakes->new;
my @values;
my $coord = 1;
foreach my $level (1 .. 8) {
my $nstart = (4**($level+1) - 1) / 3;
my $nend = $nstart + 4**$level;
my @start = $path->n_to_xy($nstart);
my $max_offset = 0;
my $max_offset_n = $nstart;
my $max_offset_c = $start[$coord];
foreach my $n ($nstart .. $nend) {
my @this = $path->n_to_xy($n);
my $offset = abs ($this[$coord] - $start[$coord]);
if ($offset > $max_offset) {
$max_offset = $offset;
$max_offset_n = $n;
$max_offset_c = $this[$coord];
}
}
push @values, $max_offset;
print "level $level start=$start[$coord] max offset $max_offset at N=$max_offset_n (of $nstart to $nend) Y=$max_offset_c\n";
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# X or Y coordinate of first point of ring
# X or Y coord: 1, 2,7,24,82,280,
# A003480 1,2,7 OFFSET=0
# A020727 2,7
#
# cf A006012 same recurrence, start 1,2
my $path = Math::PlanePath::KochSquareflakes->new;
my @values;
foreach my $level (1 .. 12) {
my $nstart = (4**($level+1) - 1) / 3;
my ($x,$y) = $path->n_to_xy($nstart);
push @values, -$y;
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# Xstart power
# Xstart = b^level
# b = Xstart^(1/level)
#
# D = P^2-4Q = 4^2-4*-2 = 24
# sqrt(24) = 4.898979485566356196394568149
#
my $path = Math::PlanePath::KochSquareflakes->new;
my $prev = 1;
foreach my $level (1 .. 12) {
my $nstart = (4**($level+1) - 1) / 3;
my ($xstart,$ystart) = $path->n_to_xy($nstart);
$xstart = -$xstart;
my $f = $xstart / $prev;
# my $b = $xstart ** (1/($level+1));
print "level=$level xstart=$xstart f=$f\n";
$prev = $xstart;
}
print "\n";
exit 0;
}
{
my @horiz = (1);
my @diag = (1);
foreach my $i (0 .. 10) {
$horiz[$i+1] = 2*$horiz[$i] + 2*$diag[$i];
$diag[$i+1] = $horiz[$i] + 2*$diag[$i];
$i++;
}
print "horiz: ",join(', ',@horiz),"\n";
print "diag: ",join(', ',@diag),"\n";
exit 0;
}
Math-PlanePath-122/devel/cubic-base.pl 0000644 0001750 0001750 00000005342 12003406621 015326 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use List::MoreUtils;
use POSIX 'floor';
use Math::Libm 'M_PI', 'hypot';
use List::Util 'min', 'max';
use Math::BaseCnv 'cnv';
use lib 'xt';
# uncomment this to run the ### lines
use Smart::Comments;
{
# smallest hypot in each level
require Math::PlanePath::CubicBase;
require Math::NumSeq::PlanePathDelta;
my $tdir6_func = \&Math::NumSeq::PlanePathDelta::_delta_func_TDir6;
my $radix = 2;
my $path = Math::PlanePath::CubicBase->new (radix => $radix);
foreach my $level (1 .. 30) {
my $n_lo = $radix ** ($level-1);
my $n_hi = $radix ** $level - 1;
my $n = $n_lo;
my $min_h = $path->n_to_rsquared($n);
my @min_n = ($n);
for ($n++; $n < $n_hi; $n++) {
my $h = $path->n_to_rsquared($n);
if ($h < $min_h) {
@min_n = ($n);
$min_h = $h;
} elsif ($h == $min_h) {
push @min_n, $n;
}
}
print "level=$level\n";
# print " n=${n_lo}to$n_hi\n";
print " min_h=$min_h\n";
foreach my $n (@min_n) {
my $nr = cnv($n,10,$radix);
my ($x,$y) = $path->n_to_xy($n);
my $xr = cnv($x,10,$radix);
my $yr = cnv($y,10,$radix);
my $tdir6 = $tdir6_func->(0,0,$x,$y);
print " n=$n $nr xy=$x,$y $xr,$yr tdir6=$tdir6 \n";
}
}
exit 0;
sub path_n_to_trsquared {
my ($path,$n) = @_;
my ($x,$y) = $path->n_to_xy($n);
return $x*$x+3*$y*$y;
}
}
{
# Dir4 maximum
require Math::PlanePath::CubicBase;
require Math::NumSeq::PlanePathDelta;
require Math::BigInt;
my $path = Math::PlanePath::CubicBase->new;
my $seq = Math::NumSeq::PlanePathDelta->new (planepath => 'CubicBase',
delta_type => 'Dir4');
my $dir4_max = 0;
foreach my $level (0 .. 600) {
my $n = Math::BigInt->new(2)**$level - 1;
my $dir4 = $seq->ith($n);
if (1 || $dir4 > $dir4_max) {
$dir4_max = $dir4;
my ($dx,$dy) = $path->n_to_dxdy($n);
printf "%3d %2b,\n %2b %8.6f\n", $n, abs($dx),abs($dy), $dir4;
}
}
exit 0;
}
Math-PlanePath-122/devel/pixel-rings.pl 0000644 0001750 0001750 00000015146 11667347222 015615 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use POSIX ();
use List::Util 'min', 'max';
# uncomment this to run the ### lines
use Smart::Comments;
{
# vs spectrum
require Image::Base::Text;
my $prev = 0;
my $diff_total = 0;
my $diff_count = 0;
my $prev_count = 0;
my $prev_sq = 0;
foreach my $r (1 .. 6000) {
my $count = image_count($r) / 4;
my $dcount = $count - $prev_count - 1;
my $xfrac = (1 + sqrt(8*($r+0)**2-1))/4;
# my $x = (2 + sqrt(8*($r+0)**2-4))/4;
my $y = int($xfrac+.5);
my $x = int($xfrac);
my $extra = (($y-1)**2 + ($y+.5)**2) < $r*$r;
$extra = ($x==$y); # && (($x^$y^1)&1);
my $sq = $y + $y-1 + $extra;
my $dsq = $sq - $prev_sq;
my $star = ($dsq != $dcount ? "***" : "");
# printf "%2d dc=%3d dsq=%4.2f %s\n", $r, $dcount,$dsq, $star;
$star = (int($sq) != $count ? "***" : "");
printf "%2d c=%3d sq=%4.2f x=%4.2f,y=$y %s\n", $r, $count,$sq,$x, $star;
$prev_count = $count;
$prev_sq = $sq;
}
exit 0;
sub floor_half {
my ($n) = @_;
return int(2*$n)/2;
}
}
{
my $r = 5;
my $w = 2*$r+1;
require Image::Base::Text;
my $image = Image::Base::Text->new (-width => $w,
-height => $w);
$image->ellipse (0,0, $w-1,$w-1, 'x');
my $str = $image->save_string;
print $str;
exit 0;
}
{
# wider ellipse() overlaps, near centre mostly
my %image_coords;
my $offset = 100;
my $i;
{
package MyImageCoords;
require Image::Base;
use vars '@ISA';
@ISA = ('Image::Base');
sub new {
my $class = shift;
return bless {@_}, $class;
}
sub xy {
my ($self, $x, $y, $colour) = @_;
my $key = "$x,$y";
if ($image_coords{$key}) {
$image_coords{$key} .= ',';
}
$image_coords{$key} .= $i;
}
}
my $width = 500;
my $height = 494;
my $image = MyImageCoords->new (-width => $width, -height => $height);
for ($i = 0; $i < min($width,$height)/2; $i++) {
$image->ellipse ($i,$i, $width-1-$i,$height-1-$i, $i % 10);
}
foreach my $coord (keys %image_coords) {
if ($image_coords{$coord} =~ /,/) {
print "$coord i=$image_coords{$coord}\n";
}
}
exit 0;
}
{
# wider ellipse()
require Image::Base::Text;
my $width = 40;
my $height = 10;
my $image = Image::Base::Text->new (-width => $width, -height => $height);
for (my $i = 0; $i < min($width,$height)/2; $i++) {
$image->ellipse ($i,$i, $width-1-$i,$height-1-$i, $i % 10);
}
$image->save('/dev/stdout');
exit 0;
}
{
# average diff step 4*sqrt(2)
require Image::Base::Text;
my $prev = 0;
my $diff_total = 0;
my $diff_count = 0;
foreach my $r (1 .. 1000) {
my $count = image_count($r);
my $diff = $count - $prev;
# printf "%2d %3d %2d\n", $r, $count, $diff;
$prev = $count;
$diff_total += $diff;
$diff_count++;
}
my $avg = $diff_total/$diff_count;
my $sqavg = $avg*$avg;
print "diff average $avg squared $sqavg\n";
exit 0;
}
{
# vs int(sqrt(2))
require Image::Base::Text;
my $prev = 0;
my $diff_total = 0;
my $diff_count = 0;
my $prev_count = 0;
my $prev_sq = 0;
foreach my $r (1 .. 300) {
my $count = image_count($r) / 4;
my $dcount = $count - $prev_count - 1;
my $sq = int(sqrt(2) * ($r+3));
my $dsq = $sq - $prev_sq - 1;
my $star = ($dsq != $dcount ? "***" : "");
printf "%2d %3d %3d %s\n", $r, $dcount,$dsq, $star;
$prev_count = $count;
$prev_sq = $sq;
}
exit 0;
}
{
# vs int(sqrt(2))
my $prev = 0;
my $diff_total = 0;
my $diff_count = 0;
foreach my $r (1 .. 500) {
my $count = image_count($r);
my $sq = 4*int(sqrt(2) * ($r+1));
my $star = ($sq != $count ? "***" : "");
printf "%2d %3d %3d %s\n", $r, $count,$sq, $star;
}
exit 0;
}
my $width = 79;
my $height = 23;
my @rows;
my @x;
my @y;
foreach my $r (0 .. 39) {
my $rr = $r * $r;
# E(x,y) = x^2*r^2 + y^2*r^2 - r^2*r^2
#
# Initially,
# d1 = E(x-1/2,y+1)
# = (x-1/2)^2*r^2 + (y+1)^2*r^2 - r^2*r^2
# which for x=r,y=0 is
# = r^2 - r^2*r + r^2/4
# = (r + 5/4) * r^2
#
my $x = $r;
my $y = 0;
my $d = ($x-.5)**2 * $rr + ($y+1)**2 * $rr - $rr*$rr;
my $count = 0;
while ($x >= $y) {
### at: "$x,$y"
### assert: $d == ($x-.5)**2 * $rr + ($y+1)**2 * $rr - $rr*$rr
push @x, $x;
push @y, $y;
$rows[$y]->[$x] = ($r%10);
$count++;
if( $d < 0 ) {
$d += $rr * (2*$y + 3);
++$y;
}
else {
$d += $rr * (2*$y - 2*$x + 5);
++$y;
--$x;
}
}
my $c = int (2*3.14159*$r/8 + .5);
printf "%2d %2d %2d %s\n", $r, $count, $c, ($count!=$c ? "**" : "");
}
foreach my $row (reverse @rows) {
if ($row) {
foreach my $char (@$row) {
print ' ', $char // ' ';
}
}
print "\n";
}
{
require Math::PlanePath::PixelRings;
my $path = Math::PlanePath::PixelRings->new (wider => 0,
# step => 0,
);
### range: $path->rect_to_n_range (0,0, 0,0)
exit 0;
}
{
# search OEIS
require Image::Base::Text;
my @count4;
my @count;
my @diffs4;
my @diffs;
my @diffs0;
my $prev_count = 0;
foreach my $r (1 .. 50) {
my $count = image_count($r);
push @count4, $count;
push @count, $count/4;
my $diff = $count - $prev_count;
push @diffs4, $diff;
push @diffs, $diff/4;
push @diffs0, $diff/4 - 1;
$prev_count = $count;
}
print "count4: ", join(',', @count4), "\n";
print "count: ", join(',', @count), "\n";
print "diffs4: ", join(',', @diffs4), "\n";
print "diffs: ", join(',', @diffs), "\n";
print "diffs0: ", join(',', @diffs0), "\n";
exit 0;
}
sub image_count {
my ($r) = @_;
my $w = 2*$r+1;
require Image::Base::Text;
my $image = Image::Base::Text->new (-width => $w,
-height => $w);
$image->ellipse (0,0, $w-1,$w-1, 'x');
my $str = $image->save_string;
my $count = ($str =~ tr/x/x/);
return $count;
}
Math-PlanePath-122/devel/fibonacci-word.logo 0000644 0001750 0001750 00000002707 12335325716 016563 0 ustar gg gg #!/usr/bin/ucblogo
;; Copyright 2012, 2014 Kevin Ryde
;;
;; This file is part of Math-PlanePath.
;;
;; Math-PlanePath is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 3, or (at your option) any later
;; version.
;;
;; Math-PlanePath is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;; for more details.
;;
;; You should have received a copy of the GNU General Public License along
;; with Math-PlanePath. If not, see .
;; hexagons overlapping much but slowly expanding
to fibbinary.next :n
localmake "filled bitor :n (lshift :n -1)
localmake "mask lshift (bitxor :filled (:filled + 1)) -1
output (bitor :n :mask) + 1
end
; to print.binary :n
; do.while [
; type bitand :n 1
; make "n lshift :n -1
; ] [:n <> 0]
; print "
; end
; make "n 0
; for [i 0 21 1] [
; print "n
; print :n
; print.binary :n
; make "n fibbinary.next :n
; ]
to fib.hex :steps
; right 90
; left 45
; penup
; back 300
; right 90
; pendown
localmake "step.len 10
localmake "n 0
for [i 0 :steps 1] [
forward :step.len
if (bitand :n 1)=0 [left 60] [right 60]
make "n fibbinary.next :n
]
end
fib.hex 210000 Math-PlanePath-122/devel/theodorus.pl 0000644 0001750 0001750 00000025627 12040145574 015365 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.006;
use strict;
use warnings;
use POSIX 'floor', 'fmod';
use Math::Trig 'pi', 'atan';
use Math::BigFloat try => 'GMP';
use Math::Libm 'hypot';
use Math::PlanePath::TheodorusSpiral;
use Smart::Comments;
{
# Euler summation
# kparse_from_string("TREE_a * (TREE_b / TREE_c)");
# my $pattern = Math::Symbolic::Custom::Pattern->new($formula);
use Math::Symbolic::Custom::Transformation;
my $trafo = Math::Symbolic::Custom::Transformation::Group->new
(',',
'TREE_a * (TREE_b / TREE_c)' => '(TREE_a * TREE_b) / TREE_c',
'TREE_a * (TREE_b + TREE_c)' => 'TREE_a * TREE_b + TREE_a * TREE_c',
'(TREE_b + TREE_c) * TREE_a' => 'TREE_b * TREE_a + TREE_c * TREE_a',
# '(TREE_a / TREE_b) / TREE_c' => 'TREE_a / (TREE_b * TREE_c)',
'(TREE_a / TREE_b) / (TREE_c / TREE_d)'
=> '(TREE_a * TREE_d) / (TREE_b * TREE_c)',
'1 - TREE_a / TREE_b' => '(TREE_b - TREE_a) / TREE_b',
'TREE_a / TREE_b + TREE_c' => '(TREE_a + TREE_b * TREE_c) / TREE_b',
'(TREE_a / TREE_b) * TREE_c' => '(TREE_a * TREE_c) / TREE_b',
'TREE_a - (TREE_b + TREE_c)' => 'TREE_a - TREE_b - TREE_c',
'(TREE_a - TREE_b) - TREE_c' => 'TREE_a - TREE_b - TREE_c',
);
sub simplify {
my $tree = shift;
### simplify(): "$tree"
### traf: ($trafo->apply_recursive($tree)//'').''
return $trafo->apply_recursive($tree) || $tree;
# if (my $m = $pattern->match($tree)) {
# $m = $m->{'trees'};
# ### trees: $m
# ### return: ($m->{'a'} * $m->{'b'}) / $m->{'c'}
# return ($m->{'a'} * $m->{'b'}) / $m->{'c'};
# } else {
# ### no match
# return $tree;
# }
}
__PACKAGE__->register();
}
require Math::Symbolic;
require Math::Symbolic::Derivative;
{
my $t = Math::Symbolic->parse_from_string('1/(x^2+1)');
$t = Math::Symbolic::Derivative::total_derivative($t, 'x');
$t = $t->simplify;
print "$t\n";
exit 0;
}
{
my $a = Math::Symbolic->parse_from_string(
'(x+y)/(1-x*y)'
);
my $z = Math::Symbolic->parse_from_string(
'z'
);
my $t = ($a + $z) / (1 - $a*$z);
$t = $t->simplify;
print $t;
exit 0;
}
}
{
my $path = Math::PlanePath::TheodorusSpiral->new;
my $prev_x = 0;
my $prev_y = 0;
#for (my $n = 10; $n < 100000000; $n = int($n * 1.2)) {
foreach my $n (2000, 2010, 2020, 2010, 2000, 2010, 2000, 2010) {
my ($x,$y) = $path->n_to_xy($n);
my $rsq = $x*$x+$y*$y;
my $dx = $x - $prev_x;
my $dy = $y - $prev_y;
my $dxy_dist = hypot($dx,$dy);
printf "%d %.2f,%.2f %.2f %.4f\n", $n, $x,$y, $rsq, $dxy_dist;
($prev_x, $prev_y) = ($x,$y);
}
exit 0;
}
sub integral {
my ($x) = @_;
print "log ", log(1+$x*$x), " at x=$x\n";
return $x * atan($x) - 0.5 * log (1 + $x*$x);
}
print "integral 0 = ", integral(0), "\n";
print "integral 1 = ", integral(1)/(2*pi()), "\n";
print "atan 1 = ", atan(1)/(2*pi()), "\n";
sub est {
my ($n) = @_;
my $k = $n-1;
if ($k == 0) { return 0; }
my $K = 2.1577829966;
my $root = sqrt($k);
my $a = 2*pi()*pi();
my $radians;
$radians = integral(1/$root); # - integral(0);
# $radians = ($k+1)*atan(1/$root) + $root - 1/($root*$k);
return $radians / (2*pi());
# $radians = 2*$root;
# return $radians / (2*pi());
#
# $radians = $root - atan($root) + $k*atan(1/$root);
# return $radians / (2*pi());
#
# return $k / $a; # revolutions
# return $k / pi();
#
# return 2*$root / $a;
# $radians = 2*sqrt($k+1) + $K + 1/(6*sqrt($k+1)); # plus O(n^(-3/2))
# return 0.5 * $a * ($k * sqrt(1+$k*$k) + log($k + sqrt(1+$k*$k))) / $k;
# return $root + ($k+1)*atan(1/$root);
}
print "est 1 = ", est(1), "\n";
print "est 2 = ", est(2), "\n";
{
require Math::Polynomial;
open OUT, '>', '/tmp/theodorus.data' or die;
my @n;
my @theta;
my $total = 0;
foreach my $n (2 .. 120) {
my $inc = Math::Trig::atan(1/sqrt($n-1)) / (2*pi()); # revs
$total += $inc;
my $est = est($n);
my $diff = $total - $est;
# $diff = 1/$diff;
if ($n > 50) {
push @n, $n-51;
push @theta, $diff;
print OUT "$n $diff\n";
}
print "$n $inc $total $est $diff\n";
}
print "\n";
Math::BigFloat->accuracy(500);
my $p = Math::Polynomial->new; # (Math::BigFloat->new(0));
$p = $p->interpolate(\@n, \@theta);
foreach my $i (0 .. $p->degree) {
print "$i ",$p->coeff($i),"\n";
}
# $p->string_config({ fold_sign => 1,
# variable => 'n' });
# print "theta = $p\n";
close OUT or die;
system "xterm -e 'gnuplot = $next) {
$next++;
my $diff = $n - $prev_n;
my $diff_diff = $diff - $prev_diff;
$total_diff_diff += $diff_diff;
$count_diff_diff++;
print "$n +$diff +$diff_diff $total\n";
if ($next >= 1000) {
last;
}
$prev_n = $n;
$prev_diff = $diff;
}
}
my $avg = $total_diff_diff / $count_diff_diff;
print "average $avg\n";
print "\n";
exit 0;
}
{
my $c2 = 2.15778;
my $t1 = 1.8600250;
my $t2 = 0.43916457;
my $z32 = 2.6123753486;
my $tn1 = 2*$t1 - 2*$t2 - $z32;
my $n = 1;
my $x = 1;
my $y = 0;
while ($n < 10000) {
my $r = sqrt($n); # before increment
($x, $y) = ($x - $y/$r, $y + $x/$r);
$n++;
$r = sqrt($n); # after increment
my $theta = atan2($y,$x);
if ($theta < 0) { $theta += 2*pi(); }
my $root;
$root = 2*sqrt($n) - $c2;
# $root += .01/$r;
# $root = -atan(sqrt($n)) + $n*atan(1/sqrt($n)) + sqrt($n);
# $root = atan(1/sqrt($n)) - pi()/2 + $n*atan(1/sqrt($n)) + sqrt($n);
$root = 2*sqrt($n)
+ 1/sqrt($n)
- $c2
# - 1/($n*sqrt($n))/3
# + 1/($n*$n*sqrt($n))/5
# - 1/($n*$n*sqrt($n))/7
# + 1/($n*$n*$n*sqrt($n))/9
;
# $root = -pi()/4 + Arctan($r);
# foreach my $k (2 .. 1000000) {
# $root += atan(1/sqrt($k)) - atan(1/sqrt($k + $r*$r - 1));
# # $root += atan( ($r*$r - 1) / ( ($k + $r*$r)*sqrt($k) + ($k+1)*sqrt($k+$r*$r-1)));
# }
# $root = -pi()/2 + Arctan($r) + $t1 *$r*$r/2 + ($tn1 - $t1)*$r**2/8;
$root = fmod ($root, 2*pi());
my $d = $root - $theta;
$d = fmod ($d + pi(), 2*pi()) - pi();
# printf "%10.6f %10.6f %23.20f\n", $theta, $root, $d;
printf "%23.20f\n", $d;
}
exit 0;
}
{
my $t1 = 0;
foreach my $k (1 .. 100) {
$t1 += 1 / (sqrt($k) * ($k+1));
printf "%10.6f\n", $t1;
}
exit 0;
}
sub Arctan {
my ($r) = @_;
return pi()/2 - atan(1/$r);
}
{
Math::BigFloat->accuracy(200);
my $bx = Math::BigFloat->new(1);
my $by = Math::BigFloat->new(0);
my $x = 1;
my $y = 0;
my $n = 1;
my @n = ($n);
my @x = ($x);
my @y = ($y);
my $count = 0;
my $prev_n = 0;
my $prev_d = 0;
my @dd;
while ($n++ < 10000000) {
my $r = hypot($x,$y);
my $py = $y;
($x, $y) = ($x - $y/$r, $y + $x/$r);
if ($py < 0 && $y >= 0) {
my $d = $n-$prev_n;
my $dd = $d-$prev_d;
push @dd, $dd;
printf "%5d +%4d +%3d %7.3f %10.6f %10.6f\n",
$n,
$d,
$dd,
# (sqrt($n)-1.07)/pi(),
sqrt($n),
$x, $y;
$prev_n = $n;
$prev_d = $d;
if (++$count >= 10) {
push @n, $n;
push @x, $x;
push @y, $y;
$count = 0;
}
}
}
print "average dd ", List::Util::sum(@dd)/scalar(@dd),"\n";
# require Data::Dumper;
# print Data::Dumper->new([\@n],['n'])->Indent(1)->Dump;
# print Data::Dumper->new([\@x],['x'])->Indent(1)->Dump;
# print Data::Dumper->new([\@y],['y'])->Indent(1)->Dump;
# require Math::Polynomial;
# my $p = Math::Polynomial->new(0);
# $p = $p->interpolate([ 1 .. @nc ], \@nc);
# $p->string_config({ fold_sign => 1,
# variable => 'd' });
# print "N = $p\n";
exit 0;
}
{
Math::BigFloat->accuracy(200);
my $bx = Math::BigFloat->new(1);
my $by = Math::BigFloat->new(0);
my $x = 1;
my $y = 0;
my $n = 1;
while ($n++ < 10000) {
my $r = hypot($x,$y);
($x, $y) = ($x - $y/$r, $y + $x/$r);
my $br = sqrt($bx*$bx + $by*$by);
($bx, $by) = ($bx - $by/$br, $by + $bx/$br);
}
my $ex = "$bx" + 0;
my $ey = "$by" + 0;
printf "%10.6f %10.6f %23.20f\n", $ex, $x, $ex - $x;
exit 0;
}
Math-PlanePath-122/devel/exe-atan2.c 0000644 0001750 0001750 00000003472 12005653477 014745 0 ustar gg gg /* Copyright 2011, 2012 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received a copy of the GNU General Public License along
with Math-PlanePath. If not, see .
*/
#include
#include
#include
#include
void
dump (double d)
{
union { double d; unsigned char byte[8]; } u;
u.d = d;
printf ("%02X %02X %02X %02X %02X %02X %02X %02X\n",
u.byte[0], u.byte[1], u.byte[2], u.byte[3],
u.byte[4], u.byte[5], u.byte[6], u.byte[7]);
}
static const double double_ulong_max_plus_1
= ((double) ((ULONG_MAX >> 1)+1)) * 2.0;
static const double double_ull_max_plus_1
= ((double) ((ULLONG_MAX >> 1)+1)) * 2.0;
int
main (void)
{
volatile double zero = 0;
volatile double negzero = -zero;
dump (zero);
dump (negzero);
printf ("%la %la\n", zero,negzero);
printf ("%la\n", atan2(zero,zero));
printf ("%la\n", atan2(negzero,zero));
printf ("\n");
printf ("%la\n", atan2(zero,negzero));
printf ("%la\n", atan2(negzero,negzero));
printf ("\n");
printf ("ulong %la ", double_ulong_max_plus_1);
dump (double_ulong_max_plus_1);
printf (" %lf\n", double_ulong_max_plus_1);
printf ("ull %la ", double_ull_max_plus_1);
dump (double_ull_max_plus_1);
printf (" %lf\n", double_ull_max_plus_1);
exit (0);
}
Math-PlanePath-122/devel/sierpinski-triangle.gnuplot 0000644 0001750 0001750 00000006636 12041164262 020404 0 ustar gg gg #!/usr/bin/gnuplot
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
#------------------------------------------------------------------------------
set xrange [0:16]; set yrange [0:16]
set key off
set samples 256
splot (int(x)&int(y))==0 ? 1 : NaN with points
pause 100
#------------------------------------------------------------------------------
triangle_x(n) = (n > 0 \
? 2*triangle_x(int(n/3)) + digit_to_x(int(n)%3) \
: 0)
triangle_y(n) = (n > 0 \
? 2*triangle_y(int(n/3)) + digit_to_y(int(n)%3) \
: 0)
digit_to_x(d) = (d==0 ? 0 : d==1 ? -1 : 1)
digit_to_y(d) = (d==0 ? 0 : 1)
# Plot the Sierpinski triangle to "level" many replications.
# trange and samples are chosen so that the parameter t runs through
# integers 0 to 3**level-1 inclusive.
#
level=6
set trange [0:3**level-1] #
set samples 3**level # making t integers
set parametric
set key off
plot triangle_x(t), triangle_y(t) with points
pause 100
#------------------------------------------------------------------------------
# 0 0 0
# 1 -1 1
# 2 1 -1
# n%3 >=
# triangle(n) = (n > 0 \
# ? 2*triangle(int(n/3)) + (int(n)%3==0 ? {0,0} \
# : int(n)%3==1 ? {-1,1} \
# : {1,1}) \
# : 0)
# level=6
# set trange [0:3**level-1]
# set samples 3**level
# set parametric
# set key off
# plot real(triangle(t)), imag(triangle(t)) with points
#
# pause 100
#
# #------------------------------------------------------------------------------
# root = cos(pi*2/3) + {0,1}*sin(pi*2/3)
#
# print root**0
# print root**1
# print root**2
#
# # triangle(n) = (n > 0 \
# # ? (1+2*triangle(int(n/3)))*root**(int(n)%3) \
# # : 0)
#
# # left = cos(pi*2/3) + {0,1}*sin(pi*2/3)
# # right = cos(pi*1/3) + {0,1}*sin(pi*1/3)
# left = {-1,1}
# right = {1,1}
#
#
# t_to_x(t,size) = int(t / size)
# t_to_y(t,size) = (int(t) % size)
#
# t_to_pyramid_x(t,size) = t_to_x(t,size) - t_to_y(t,size)
# t_to_pyramid_y(t,size) = t_to_x(t,size) + t_to_y(t,size)
#
# sierpinski_x(t,size) = \
# (t_to_x(t,size) & t_to_y(t,size) \
# ? NaN \
# : t_to_pyramid_x(t,size))
# sierpinski_y(t,size) = \
# (t_to_x(t,size) & t_to_y(t,size) \
# ? NaN \
# : t_to_pyramid_y(t,size))
#
# size=50
# set trange [0:size*size-1]
# set samples size*size
# set parametric
# set key off
# plot sierpinski_x(t,size), sierpinski_y(t,size) with points
#
# pause 100 Math-PlanePath-122/devel/sierpinski-arrowhead-stars.pl 0000644 0001750 0001750 00000002634 11612663016 020626 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use POSIX ();
use Math::PlanePath::SierpinskiArrowhead;
# uncomment this to run the ### lines
use Smart::Comments;
{
my $path = Math::PlanePath::SierpinskiArrowhead->new;
my @rows = ((' ' x 79) x 64);
foreach my $n (0 .. 3 * 3**4) {
my ($x, $y) = $path->n_to_xy ($n);
$x += 32;
substr ($rows[$y], $x,1, '*');
}
local $,="\n";
print reverse @rows;
exit 0;
}
{
my @rows = ((' ' x 64) x 32);
foreach my $p (0 .. 31) {
foreach my $q (0 .. 31) {
next if ($p & $q);
my $x = $p-$q;
my $y = $p+$q;
next if ($y >= @rows);
$x += 32;
substr ($rows[$y], $x,1, '*');
}
}
local $,="\n";
print reverse @rows;
exit 0;
}
Math-PlanePath-122/devel/quintet.pl 0000644 0001750 0001750 00000011767 11755772113 015051 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.006;
use strict;
use warnings;
use Math::Libm 'M_PI', 'hypot';
{
require Math::PlanePath::QuintetCurve;
require Math::PlanePath::QuintetCentres;
my $f = Math::PlanePath::QuintetCurve->new (arms=>4);
my $c = Math::PlanePath::QuintetCentres->new (arms=>4);
my $width = 5;
my %saw;
my $n_end = 5**($width-1) * $f->arms_count;
foreach my $n (0 .. $n_end) {
my ($x,$y) = $f->n_to_xy($n);
my $cn = $c->xy_to_n($x,$y) // -1;
my $cr = $c->xy_to_n($x+1,$y) // -1;
my $cur = $c->xy_to_n($x+1,$y+1) // -1;
my $cu = $c->xy_to_n($x, $y+1) // -1; # <-----
my $cul = $c->xy_to_n($x-1,$y+1) // -1; # <-----
my $cl = $c->xy_to_n($x-1,$y) // -1; # <-----
my $cdl = $c->xy_to_n($x-1,$y-1) // -1;
my $cd = $c->xy_to_n($x, $y-1) // -1;
my $cdr = $c->xy_to_n($x+1,$y-1) // -1;
if ($n == $cn) { $saw{'n'} = 0; }
if ($n == $cr) { $saw{'r'} = 1; }
if ($n == $cur) { $saw{'ur'} = 2; }
if ($n == $cu) { $saw{'u'} = 3; }
if ($n == $cul) { $saw{'ul'} = 4; }
if ($n == $cl) { $saw{'l'} = 5; }
if ($n == $cdl) { $saw{'dl'} = 6; }
if ($n == $cd) { $saw{'d'} = 7; }
if ($n == $cdr) { $saw{'dr'} = 8; }
unless ($n == $cn
|| $n == $cr
|| $n == $cur
|| $n == $cu
|| $n == $cul
|| $n == $cl
|| $n == $cdl
|| $n == $cd
|| $n == $cdr) {
die "$n";
}
# print "$n5 $cn5 $ch5 $cw5 $cu5 $bad\n";
}
my $saw = join(',', sort {$saw{$a}<=>$saw{$b}} keys %saw);
print "$saw to n_end=$n_end\n";
exit 0;
}
{
require Math::BaseCnv;
require Math::PlanePath::QuintetCurve;
require Math::PlanePath::QuintetCentres;
my $f = Math::PlanePath::QuintetCurve->new;
my $c = Math::PlanePath::QuintetCentres->new;
my $width = 5;
my %saw;
foreach my $n (0 .. 5**($width-1)) {
my $n5 = sprintf '%*s', $width, Math::BaseCnv::cnv($n,10,5);
my ($x,$y) = $f->n_to_xy($n);
my $cn = $c->xy_to_n($x,$y) || -1;
my $cn5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cn,10,5);
my $rx = $x + 1;
my $ry = $y;
my $cr = $c->xy_to_n($rx,$ry) || -1;
my $cr5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cr,10,5);
my $urx = $x + 1;
my $ury = $y + 1;
my $cur = $c->xy_to_n($urx,$ury) || -1;
my $cur5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cur,10,5);
my $ux = $x;
my $uy = $y + 1;
my $cu = $c->xy_to_n($ux,$uy) || -1;
my $cu5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cu,10,5);
my $ulx = $x - 1;
my $uly = $y + 1;
my $cul = $c->xy_to_n($ulx,$uly) || -1;
my $cul5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cul,10,5);
my $lx = $x - 1;
my $ly = $y;
my $cl = $c->xy_to_n($lx,$ly) || -1;
my $cl5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cl,10,5);
my $dlx = $x - 1;
my $dly = $y - 1;
my $cdl = $c->xy_to_n($dlx,$dly) || -1;
my $cdl5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cdl,10,5);
my $dx = $x;
my $dy = $y - 1;
my $cd = $c->xy_to_n($dx,$dy) || -1;
my $cd5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cd,10,5);
my $drx = $x + 1;
my $dry = $y - 1;
my $cdr = $c->xy_to_n($drx,$dry) || -1;
my $cdr5 = sprintf '%*s', $width, Math::BaseCnv::cnv($cdr,10,5);
if ($n == $cn) { $saw{'n'} = 0; }
if ($n == $cr) { $saw{'r'} = 1; }
if ($n == $cur) { $saw{'ur'} = 2; }
if ($n == $cu) { $saw{'u'} = 3; }
if ($n == $cul) { $saw{'ul'} = 4; }
if ($n == $cl) { $saw{'l'} = 5; }
if ($n == $cdl) { $saw{'dl'} = 6; }
if ($n == $cd) { $saw{'d'} = 7; }
if ($n == $cdr) { $saw{'dr'} = 8; }
my $bad = ($n == $cn
|| $n == $cr
|| $n == $cur
|| $n == $cu
|| $n == $cul
|| $n == $cl
|| $n == $cdl
|| $n == $cd
|| $n == $cdr
? ''
: ' ******');
# print "$n5 $cn5 $ch5 $cw5 $cu5 $bad\n";
}
my $saw = join(',', sort {$saw{$a}<=>$saw{$b}} keys %saw);
print "$saw\n";
exit 0;
}
{
my $x = 1;
my $y = 0;
for (my $level = 1; $level < 20; $level++) {
# (x+iy)*(2+i)
($x,$y) = (2*$x - $y, $x + 2*$y);
if (abs($x) >= abs($y)) {
$x -= ($x<=>0);
} else {
$y -= ($y<=>0);
}
print "$level $x,$y\n";
}
exit 0;
}
Math-PlanePath-122/devel/r5-dragon.pl 0000644 0001750 0001750 00000076460 12435205200 015137 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use Math::BaseCnv;
use List::MoreUtils;
use POSIX 'floor';
use Math::Libm 'M_PI', 'hypot';
use List::Util 'min', 'max';
use Math::PlanePath::R5DragonCurve;
use Math::BigInt try => 'GMP';
use Math::BigFloat;
use lib 'devel/lib';
use lib 'xt';
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments;
{
# partial fractions
require Math::Polynomial;
Math::Polynomial->string_config({ascending=>1});
# x^3/((x-1)*(2*x-1)*(x^2-x+1))
require Math::Complex;
my $b = Math::Complex->make(1,1);
my @numerators = MyOEIS::polynomial_partial_fractions
(Math::Polynomial->new(Math::Complex->make( 3, -2),
Math::Complex->make(-10, 1),
Math::Complex->make( 11, 5),
Math::Complex->make( 2, -24),
Math::Complex->make(-18, 18),
Math::Complex->make( 8, -16),
Math::Complex->make( 16, -32),
), # numerator
# (( 16 - 32*I)*x^6
# + ( 8 - 16*I)*x^5
# + (-18 + 18*I)*x^4
# + ( 2 - 24*I)*x^3
# + ( 11 + 5*I)*x^2
# + (-10 + I)*x
# + ( 3 - 2*I))
Math::Polynomial->new(1,-$b), # 1-b*x
Math::Polynomial->new(1,1)**2, # 1+x
Math::Polynomial->new(1,-2,2)**2, # 1 - 2x + 2x^2
Math::Polynomial->new(1, -$b, -2*$b**3), # 1 - b*x - 2*b^3*x^3
);
print "@numerators\n";
# my @numerators = MyOEIS::polynomial_partial_fractions
# (Math::Polynomial->new(0,0,0,3), # numerator x^3
# Math::Polynomial->new(1,-1), # 1-x
# Math::Polynomial->new(1,-2), # 1-2x
# Math::Polynomial->new(1, -1, 1), # 1 - x + x^2
# );
# print "@numerators\n";
# my @numerators = MyOEIS::polynomial_partial_fractions
# (1640 * Math::Polynomial->new(1), # numerator 1
# Math::Polynomial->new(1,-1), # 1-x
# Math::Polynomial->new(1, 1), # 1+x
# Math::Polynomial->new(1, -2, 2), # 1 - 2*x + 2*x^2
# );
# print "@numerators\n";
# use Math::BigRat;
# my $o = Math::BigRat->new(1);
# $o = 1;
# my @numerators = MyOEIS::polynomial_partial_fractions
# (1640 * Math::Polynomial->new(0*$o/10, 65*$o/10, 18*$o/10, 13*$o/10), # numerator 13*x^2 + 18*x + 65
# Math::Polynomial->new(25*$o, 6*$o, 1*$o), # (25 + 6*x + x^2)
# Math::Polynomial->new(1*$o, -5*$o), # * (1-5*x)
# Math::Polynomial->new(1*$o, -1*$o)); # (1-x)
# print "@numerators\n";
# dragon dir N touching next level
# p = (1-2*x^3)/(1-2*x-x^3+2*x^4)
# (1-2*x^3)/((1-2*x)*(1-x)*(1+x+x^2)) * 21 == (18+12*x)/(1+x+x^2) + 3/(1-2*x)
# p*21 == ((3 + 6*x + 12*x^2)/(1-x^3) + 3/(1-2*x)
# p*21 == (-4 -5*x)/(1+x+x^2) + 7/(1-x) + 18/(1-2*x)
# my @numerators = MyOEIS::polynomial_partial_fractions
# (21 * Math::Polynomial->new(1,0,0,-2), # numerator 1-2*x^3
# Math::Polynomial->new(1,0,0,-1), # 1-x^3
# # Math::Polynomial->new(1,1,1), # 1+x+x^2
# # Math::Polynomial->new(1,-1), # 1-x
# Math::Polynomial->new(1,-2)); # 1-2x
# print "@numerators\n";
# # dragon JA[k] area
# # x^4/ ((1 - x - 2*x^3)*(1-x)*(1-2*x))
# my @numerators = MyOEIS::polynomial_partial_fractions
# (Math::Polynomial->new(1), # numerator
# Math::Polynomial->new(1,-1,0,-2), # 1-x-2*x^3
# Math::Polynomial->new(1,-1)); # 1-x
# print "@numerators\n";
# # dragon A[k] area
# # x^4/ ((1 - x - 2*x^3)*(1-x)*(1-2*x))
# my @numerators = MyOEIS::polynomial_partial_fractions
# (Math::Polynomial->new(2), # numerator
# Math::Polynomial->new(1,-1,0,-2), # 1-x-2*x^3
# Math::Polynomial->new(1,-2), # 1-2*x
# Math::Polynomial->new(1,-1)); # 1-x
# print "@numerators\n";
# # dragon B[k]=R[k+1] total boundary
# # (4 + 2 x + 4 x^2)/(1-x-2*x^3) + (-2)/(1-x)
# my @numerators = MyOEIS::polynomial_partial_fractions
# (Math::Polynomial->new(2,0,2), # numerator reduced 2*x + 2*x^3
# Math::Polynomial->new(1,-1,0,-2), # 1-x-2*x^3
# Math::Polynomial->new(1,-1)); # 1-x
# print "@numerators\n";
# # dragon R right boundary
# my @numerators = MyOEIS::polynomial_partial_fractions
# (Math::Polynomial->new(1,0,1,0,2),
# Math::Polynomial->new(1,-1,0,-2),
# Math::Polynomial->new(1,-1));
# print "@numerators\n";
exit 0;
}
{
# convex hull
# hull 8 new vertices
require Math::Geometry::Planar;
my $points = [ [0,0], [1,0], [0,0] ];
$points = [ [Math::BigInt->new(0), Math::BigInt->new(0)],
[Math::BigInt->new(1), Math::BigInt->new(0)],
[Math::BigInt->new(0), Math::BigInt->new(0)] ];
my $end_x = Math::BigInt->new(1);
my $end_y = Math::BigInt->new(0);
my $path = Math::PlanePath::R5DragonCurve->new;
my $num_points_prev = 0;
for (my $k = Math::BigInt->new(0);
$k < 40;
$k++) {
my $angle = 0; # Math::BigFloat->new($end_y)->batan2(Math::BigFloat->new($end_x), 10);
my $num_points = scalar(@$points);
my $num_points_diff = $num_points - $num_points_prev;
print "k=$k end=$end_x,$end_y a=$angle $num_points diff=$num_points_diff\n";
my @new_points = @$points;
{
my $p = Math::Geometry::Planar->new;
$p->points(points_copy($points));
$p->move (-$end_y, $end_x);
push @new_points, @{$p->points};
### move 1: $p->points
}
{
my $p = Math::Geometry::Planar->new;
$p->points(points_copy($points));
$p->move (2*-$end_y, 2*$end_x);
push @new_points, @{$p->points};
### move 2: $p->points
}
{
my $p = Math::Geometry::Planar->new;
$p->points(points_copy($points));
planar_rotate_plus90($p);
push @new_points, @{$p->points};
### rot: $p->points
}
{
my $p = Math::Geometry::Planar->new;
$p->points(points_copy($points));
planar_rotate_plus90($p);
$p->move ($end_x + -$end_y, $end_y + $end_x);
push @new_points, @{$p->points};
### rot move: $p->points
}
my $p = Math::Geometry::Planar->new;
$p->points(\@new_points);
$p = $p->convexhull2;
$points = $p->points;
($end_x,$end_y) = ($end_x - 2*$end_y,
$end_y + 2*$end_x);
$num_points_prev = $num_points;
my ($x,$y) = $path->n_to_xy(5**($k+1));
### $end_y
### $y
$x == $end_x or die;
$y == $end_y or die;
}
exit 0;
sub planar_rotate_plus90 {
my ($planar) = @_;
my $points = $planar->points;
foreach my $p (@$points) {
($p->[0],$p->[1]) = (- $p->[1], $p->[0]);
}
return $planar;
}
sub points_copy {
my ($points) = @_;
return [ map {[$_->[0],$_->[1]]} @$points ];
}
# {
# my $pl = Math::Geometry::Planar->new;
# $pl->points($points);
# $pl->rotate(- atan2(2,1));
# $pl->scale(1/sqrt(5));
# $points = $pl->points;
# }
}
{
# extents h->4/5 w->2/5
# 1/sqrt(5)
# *--* 1/5 + 4/5 = 1
# 2/sqrt(5) | / 1
# |/
# *
#
my $h = 0;
my $w = 0;
my $sum = 0;
foreach my $k (0 .. 20) {
print "$h $w $sum\n";
$sum += (3/5)**$k;
$h /= sqrt(5);
$w /= sqrt(5);
my $s = 1/sqrt(5);
my $add = $s * 2/sqrt(5);
($h, $w) = ($h*2/sqrt(5) + $w*1/sqrt(5) + $add,
$h*2/sqrt(5) + $w*1/sqrt(5));
}
exit 0;
}
{
# min/max for level
# radial extent
#
# dist0to5 = sqrt(1*1+2*2) = sqrt(5)
#
# 4-->5
# ^
# |
# 3<--2
# ^
# |
# 0-->1
#
# Rlevel = sqrt(5)^level + Rprev
# = sqrt(5) + sqrt(5)^2 + ... + sqrt(5)^(level-1) + sqrt(5)^level
# if level
# = sqrt(5) + sqrt(5)^2 + sqrt(5)*sqrt(5)^2 + ...
# = sqrt(5) + (1+sqrt(5))*5^1 + (1+sqrt(5))*5^2 + ...
# = sqrt(5) + (1+sqrt(5))* [ 5^1 + 5^2 + ... ]
# = sqrt(5) + (1+sqrt(5))* (5^k - 1)/4
# <= 5^k
# Rlevel^2 <= 5^level
require Math::BaseCnv;
require Math::PlanePath::R5DragonCurve;
my $path = Math::PlanePath::R5DragonCurve->new;
my $prev_min = 1;
my $prev_max = 1;
for (my $level = 1; $level < 10; $level++) {
my $n_start = 5**($level-1);
my $n_end = 5**$level;
my $min_hypot = 128*$n_end*$n_end;
my $min_x = 0;
my $min_y = 0;
my $min_pos = '';
my $max_hypot = 0;
my $max_x = 0;
my $max_y = 0;
my $max_pos = '';
print "level $level n=$n_start .. $n_end\n";
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
my $h = $x*$x + $y*$y;
if ($h < $min_hypot) {
$min_hypot = $h;
$min_pos = "$x,$y";
}
if ($h > $max_hypot) {
$max_hypot = $h;
$max_pos = "$x,$y";
}
}
# print " min $min_hypot at $min_x,$min_y\n";
# print " max $max_hypot at $max_x,$max_y\n";
{
my $factor = $min_hypot / $prev_min;
my $min_hypot_5 = Math::BaseCnv::cnv($min_hypot,10,5);
print " min r^2 $min_hypot ${min_hypot_5}[5] at $min_pos factor $factor\n";
}
{
my $factor = $max_hypot / $prev_max;
my $max_hypot_5 = Math::BaseCnv::cnv($max_hypot,10,5);
print " max r^2 $max_hypot ${max_hypot_5}[5]) at $max_pos factor $factor\n";
}
$prev_min = $min_hypot;
$prev_max = $max_hypot;
}
exit 0;
}
{
# boundary length between arms = 2*3^k
#
# *---1 length=6
# |
# 2 *---*---*
# | | | |
# *---* 0---*
#
# T[0] = 2
# T[k+1] = R[k] + T[k] + U[k]
# T[k+1] = 4*3^k + T[k]
# i=k-1
# T[k] = 2 + sum 4*3^i
# i=0
# = 2 + 4*(3^k - 1)/(3-1)
# = 2 + 2*(3^k - 1)
# = 2*3^k
my $arms = 2;
my $path = Math::PlanePath::R5DragonCurve->new (arms => $arms);
my @values;
foreach my $k (0 .. 8) {
my $n_limit = $arms * 5**$k + $arms-1;
my $n_from = $n_limit-1;
my $n_to = $n_limit;
print "k=$k n_limit=$n_limit\n";
my $points = MyOEIS::path_boundary_points_ft ($path, $n_limit,
$path->n_to_xy($n_from),
$path->n_to_xy($n_to),
side => 'right',
);
if (@$points < 10) {
foreach my $p (@$points) {
print " $p->[0],$p->[1]";
}
print "\n";
}
my $length = scalar(@$points) - 1;
print " length $length\n";
push @values, $length;
}
shift @values;
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# right boundary N
my $path = Math::PlanePath::R5DragonCurve->new;
my %non_values;
my %n_values;
my @n_values;
my @values;
foreach my $k (3){
my $n_limit = 5**$k;
print "k=$k n_limit=$n_limit\n";
foreach my $n (0 .. $n_limit-1) {
$non_values{$n} = 1;
}
my $points = MyOEIS::path_boundary_points ($path, $n_limit,
side => 'right',
);
### $points
for (my $i = 0; $i+1 <= $#$points; $i++) {
my ($x,$y) = @{$points->[$i]};
my ($x2,$y2) = @{$points->[$i+1]};
# my @n_list = $path->xy_to_n_list($x,$y);
my @n_list = path_xyxy_to_n($path, $x,$y, $x2,$y2);
foreach my $n (@n_list) {
delete $non_values{$n};
if ($n <= $n_limit) { $n_values{$n} = 1; }
my $n5 = Math::BaseCnv::cnv($n,10,5);
my $pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n);
my $diff = $pred ? '' : ' ***';
if ($k <= 4) { print "$n $n5$diff\n"; }
}
}
@n_values = keys %n_values;
@n_values = sort {$a<=>$b} @n_values;
my @non_values = keys %non_values;
@non_values = sort {$a<=>$b} @non_values;
my $count = scalar(@n_values);
print "count $count\n";
# push @values, $count;
@values = @n_values;
if ($k <= 4) {
foreach my $n (@non_values) {
my $pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n);
my $diff = $pred ? ' ***' : '';
my $n5 = Math::BaseCnv::cnv($n,10,5);
print "non $n $n5$diff\n";
}
}
# @values = @non_values;
# print "func ";
# foreach my $i (0 .. $count-1) {
# my $n = $path->_UNDOCUMENTED__right_boundary_i_to_n($i);
# my $n5 = Math::BaseCnv::cnv($n,10,5);
# print "$n,";
# }
# print "\n";
print "vals ";
foreach my $i (0 .. $count-1) {
my $n = $values[$i];
my $n5 = Math::BaseCnv::cnv($n,10,5);
print "$n,";
}
print "\n";
}
@values = MyOEIS::first_differences(@values);
shift @values;
shift @values;
shift @values;
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
exit 0;
sub path_xyxy_to_n {
my ($path, $x1,$y1, $x2,$y2) = @_;
### path_xyxy_to_n(): "$x1,$y1, $x2,$y2"
my @n_list = $path->xy_to_n_list($x1,$y1);
### @n_list
my $arms = $path->arms_count;
foreach my $n (@n_list) {
my ($x,$y) = $path->n_to_xy($n + $arms);
if ($x == $x2 && $y == $y2) {
return $n;
}
}
return;
}
}
{
my $C = sub {
my ($k) = @_;
return 3**$k - $k; # A024024
};
my $E = sub {
my ($k) = @_;
return 3**$k + $k; # A104743
};
my @values = map { $E->($_) } 0 .. 10;
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
exit;
}
{
# left boundary N
my $path = Math::PlanePath::R5DragonCurve->new;
my %non_values;
my %n_values;
my @n_values;
my @values;
foreach my $k (2) {
my $n_limit = 3*5**$k;
print "k=$k n_limit=$n_limit\n";
foreach my $n (0 .. $n_limit-1) {
$non_values{$n} = 1;
}
my $points = MyOEIS::path_boundary_points ($path, $n_limit,
side => 'left',
);
@$points = reverse @$points; # for left
### $points
for (my $i = 0; $i+1 <= $#$points; $i++) {
my ($x,$y) = @{$points->[$i]};
my ($x2,$y2) = @{$points->[$i+1]};
# my @n_list = $path->xy_to_n_list($x,$y);
my @n_list = path_xyxy_to_n($path, $x,$y, $x2,$y2);
foreach my $n (@n_list) {
delete $non_values{$n};
if ($n <= $n_limit) { $n_values{$n} = 1; }
my $n5 = Math::BaseCnv::cnv($n,10,5);
my $pred = $path->_UNDOCUMENTED__n_segment_is_left_boundary($n);
my $diff = $pred ? '' : ' ***';
if ($k <= 4) { print "$n $n5$diff\n"; }
}
}
@n_values = keys %n_values;
@n_values = sort {$a<=>$b} @n_values;
my @non_values = keys %non_values;
@non_values = sort {$a<=>$b} @non_values;
my $count = scalar(@n_values);
print "count $count\n";
# push @values, $count;
@values = @n_values;
if ($k <= 4) {
foreach my $n (@non_values) {
my $pred = $path->_UNDOCUMENTED__n_segment_is_left_boundary($n);
my $diff = $pred ? ' ***' : '';
my $n5 = Math::BaseCnv::cnv($n,10,5);
print "non $n $n5$diff\n";
}
}
# @values = @non_values;
# print "func ";
# foreach my $i (0 .. $count-1) {
# my $n = $path->_UNDOCUMENTED__left_boundary_i_to_n($i);
# my $n5 = Math::BaseCnv::cnv($n,10,5);
# print "$n,";
# }
# print "\n";
print "vals ";
foreach my $i (0 .. $count-1) {
my $n = $values[$i];
my $n5 = Math::BaseCnv::cnv($n,10,5);
print "$n5,";
}
print "\n";
}
# @values = MyOEIS::first_differences(@values);
shift @values;
shift @values;
shift @values;
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# recurrence
# v3 = a*v0 + b*v1 + c*v2
# [v0 v1 v2] [a] [v3]
# [v1 v2 v3] [b] = [v4]
# [v2 v3 v4] [c] [v5]
# [a] [v0 v1 v2] -1 [v1]
# [b] = [v1 v2 v3] * [v2]
# [c] [v2 v3 v4] [v3]
$|=1;
my @array = (
54,90,150,250,422,714,1206,2042,3462
);
# @array = ();
# foreach my $k (5 .. 10) {
# push @array, R_formula(2*$k+1);
# }
# require MyOEIS;
# my $path = Math::PlanePath::R5DragonCurve->new;
# foreach my $k (0 .. 30) {
# my $value = MyOEIS::path_boundary_length($path, 5**$k,
# # side => 'left',
# );
# last if $value > 10_000;
# push @array, $value;
# print "$value,";
# }
print "\n";
array_to_recurrence_pari(\@array);
print "\n";
my @recurr = array_to_recurrence(\@array);
print join(', ',@recurr),"\n";
exit 0;
sub array_to_recurrence_pari {
my ($aref) = @_;
my $order = int(scalar(@array)/2); # 2*order-1 = @array-1
my $str = "m=[";
foreach my $i (0 .. $order-1) {
if ($i) { $str .= "; " }
foreach my $j (0 .. $order-1) {
if ($j) { $str .= "," }
$str .= $aref->[$i+$j];
}
}
$str .= "]\n";
$str .= "v=[";
foreach my $i ($order .. 2*$order-1) {
if ($i > $order) { $str .= ";" }
$str .= $aref->[$i];
}
$str .= "];";
$str .= "(m^-1)*v\n";
print $str;
require IPC::Run;
IPC::Run::run(['gp'],'<',\$str);
}
sub array_to_recurrence {
my ($aref) = @_;
# 2*order-1 = @array-1
my $order = int(scalar(@array)/2);
require Math::Matrix;
my $m = Math::Matrix->new(map {[
map { $array[$_]
} $_ .. $_+$order-1
]}
0 .. $order-1);
print $m;
print $m->determinant,"\n";
my $v = Math::Matrix->new(map {[ $array[$_] ]} $order .. 2*$order-1);
print $v;
$m = $m->invert;
print $m;
$v = $m*$v;
print $v;
return (map {$v->[$_][0]} reverse 0 .. $order-1);
}
}
{
# at N=29
require Math::NumSeq::PlanePathDelta;
require Math::PlanePath::R5DragonMidpoint;
my $path = Math::PlanePath::R5DragonMidpoint->new;
my $n = 29;
my ($x,$y) = $path->n_to_xy($n);
my ($dx,$dy) = $path->n_to_dxdy($n);
my $tradius = Math::NumSeq::PlanePathCoord::_path_n_to_tradius($path,$n);
my $next_tradius = Math::NumSeq::PlanePathCoord::_path_n_to_tradius($path,$n + $path->arms_count);
my $dtradius = Math::NumSeq::PlanePathDelta::_path_n_to_dtradius($path,$n);
print "$n x=$x,y=$y $dx,$dy dtradius=$dtradius\n";
print " tradius $tradius to $next_tradius\n";
exit 0;
}
{
# first South step dY=-1 on Y axis
require Math::PlanePath::R5DragonMidpoint;
my $path = Math::PlanePath::R5DragonMidpoint->new;
require Math::NumSeq::PlanePathDelta;
my $seq = Math::NumSeq::PlanePathDelta->new (path => $path);
my @values;
my $n = 0;
OUTER: for ( ; ; $n++) {
my ($x,$y) = $path->n_to_xy($n);
my ($dx,$dy) = $path->n_to_dxdy($n);
if ($x == 0 && $dx == 0 && $dy == -($y < 0 ? -1 : 1)) {
my $tradius = Math::NumSeq::PlanePathCoord::_path_n_to_tradius($path,$n);
my $next_tradius = Math::NumSeq::PlanePathCoord::_path_n_to_tradius($path,$n + $path->arms_count);
my $dtradius = Math::NumSeq::PlanePathDelta::_path_n_to_dtradius($path,$n);
print "$n $x,$y $dx,$dy dtradius=$dtradius\n";
print " tradius $tradius to $next_tradius\n";
push @values, $n;
last OUTER if @values > 20;
}
}
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# any South step dY=-1 on Y axis
# use Math::BigInt try => 'GMP';
# use Math::BigFloat;
require Math::PlanePath::R5DragonMidpoint;
my $path = Math::PlanePath::R5DragonMidpoint->new;
require Math::NumSeq::PlanePathDelta;
my $seq = Math::NumSeq::PlanePathDelta->new (path => $path);
my @values;
my $x = 0;
my $y = 0;
# $x = Math::BigFloat->new($x);
# $y = Math::BigFloat->new($y);
OUTER: for ( ; ; $y++) {
### y: "$y"
foreach my $sign (1,-1) {
### at: "$x, $y sign=$sign"
if (defined (my $n = $path->xy_to_n($x,$y))) {
my ($dx,$dy) = $path->n_to_dxdy($n);
### dxdy: "$dx, $dy"
if ($dx == 0 && $dy == $sign) {
my $tradius = Math::NumSeq::PlanePathCoord::_path_n_to_tradius($path,$n);
my $next_tradius = Math::NumSeq::PlanePathCoord::_path_n_to_tradius($path,$n + $path->arms_count);
my $dtradius = Math::NumSeq::PlanePathDelta::_path_n_to_dtradius($path,$n);
print "$n $x,$y $dx,$dy dtradius=$dtradius\n";
print " tradius $tradius to $next_tradius\n";
push @values, $y;
last OUTER if @values > 20;
}
}
$y = -$y;
}
}
print join(',',@values),"\n";
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# boundary join 4,13,40,121,364
# A003462 (3^n - 1)/2.
require Math::PlanePath::R5DragonCurve;
my $path = Math::PlanePath::R5DragonCurve->new;
my @values;
$| = 1;
foreach my $exp (2 .. 6) {
my $t_lo = 5**$exp;
my $t_hi = 2*5**$exp - 1;
my $count = 0;
foreach my $n (0 .. $t_lo-1) {
my ($x,$y) = $path->n_to_xy($n);
my @n_list = $path->xy_to_n_list($x,$y);
if (@n_list >= 2
&& $n_list[0] < $t_lo
&& $n_list[1] >= $t_lo
&& $n_list[1] < $t_hi) {
$count++;
}
}
push @values, $count;
print "$count,";
}
print "\n";
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# overlaps
require Math::PlanePath::R5DragonCurve;
require Math::BaseCnv;
my $path = Math::PlanePath::R5DragonCurve->new;
my $width = 5;
foreach my $n (0 .. 5**($width-1)) {
my ($x,$y) = $path->n_to_xy($n);
my @n_list = $path->xy_to_n_list($x,$y);
next unless @n_list >= 2;
if ($n_list[1] == $n) { ($n_list[0],$n_list[1]) = ($n_list[1],$n_list[0]); }
my $n_list = join(',',@n_list);
my @n5_list = map { sprintf '%*s', $width, Math::BaseCnv::cnv($_,10,5) } @n_list;
print "$n5_list[0] $n5_list[1] ($n_list)\n";
}
exit 0;
}
{
# tiling
require Image::Base::Text;
require Math::PlanePath::R5DragonCurve;
my $path = Math::PlanePath::R5DragonCurve->new;
my $width = 37;
my $height = 21;
my $image = Image::Base::Text->new (-width => $width,
-height => $height);
my $xscale = 3;
my $yscale = 2;
my $w2 = int(($width+1)/2);
my $h2 = int($height/2);
$w2 -= $w2 % $xscale;
$h2 -= $h2 % $yscale;
my $affine = sub {
my ($x,$y) = @_;
return ($x*$xscale + $w2,
-$y*$yscale + $h2);
};
my ($n_lo, $n_hi) = $path->rect_to_n_range(-$w2/$xscale, -$h2/$yscale,
$w2/$xscale, $h2/$yscale);
print "n to $n_hi\n";
foreach my $n ($n_lo .. $n_hi) {
next if ($n % 5) == 2;
my ($x,$y) = $path->n_to_xy($n);
my ($next_x,$next_y) = $path->n_to_xy($n+1);
foreach (1 .. 4) {
$image->line ($affine->($x,$y),
$affine->($next_x,$next_y),
($x==$next_x ? '|' : '-'));
$image->xy ($affine->($x,$y),
'+');
$image->xy ($affine->($next_x,$next_y),
'+');
($x,$y) = (-$y,$x); # rotate +90
($next_x,$next_y) = (-$next_y,$next_x); # rotate +90
}
}
$image->xy ($affine->(0,0),
'o');
foreach my $x (0 .. $width-1) {
foreach my $y (0 .. $height-1) {
next unless $image->xy($x,$y) eq '+';
if ($x > 0 && $image->xy($x-1,$y) eq ' ') {
$image->xy($x,$y, '|');
} elsif ($x < $width-1 && $image->xy($x+1,$y) eq ' ') {
$image->xy($x,$y, '|');
} elsif ($y > 0 && $image->xy($x,$y-1) eq ' ') {
$image->xy($x,$y, '-');
} elsif ($y < $height-1 && $image->xy($x,$y+1) eq ' ') {
$image->xy($x,$y, '-');
}
}
}
$image->save('/dev/stdout');
exit 0;
}
{
# area recurrence
foreach my $i (0 .. 10) {
print recurrence($i),",";
}
print "\n";
print "wrong(): ";
foreach my $i (0 .. 10) { print wrong($i),","; }
print "\n";
print "recurrence_area815(): ";
foreach my $i (0 .. 10) { print recurrence_area815($i),","; }
print "\n";
print "recurrence_area43(): ";
foreach my $i (0 .. 10) { print recurrence_area43($i),","; }
print "\n";
print "formula_pow(): ";
foreach my $i (0 .. 10) { print formula_pow($i),","; }
print "\n";
print "recurrence_areaSU(): ";
foreach my $i (0 .. 10) { print recurrence_areaSU($i),","; }
print "\n";
print "recurrence_area2S(): ";
foreach my $i (0 .. 10) { print recurrence_area2S($i),","; }
print "\n";
exit 0;
# A[n+1] = 4*A[n] - 3*A[n-1] + 4*5^(n-1)
# - A[n+1] + 4*A[n] + 4*5^(n-1) = 3*A[n-1]
# 3*A[n-1] = - A[n+1] + 4*A[n] + 4*5^(n-1)
# 3*A[n-2] = - A[n] + 4*A[n-1] + 4*5^(n-2)
# D[n+1] = 4*A[n] - 3*A[n-1] + 4*5^(n-1)
# - (4*A[n-1] - 3*A[n-2] + 4*5^(n-2))
# = 4*A[n] - 3*A[n-1] + 4*5^(n-1)
# - 4*A[n-1] + 3*A[n-2] - 4*5^(n-2))
# = 4*A[n] - 3*A[n-1] + 4*5^(n-1)
# - 4*A[n-1] - A[n] + 4*A[n-1] + 4*5^(n-2) - 4*5^(n-2))
# = 4*A[n] - 3*A[n-1] + 4*5^(n-1)
# - A[n]
# D[n+1] = 4*A[n] - 3*A[n-1] + 4*5^(n-1)
# - A[n]
# D[n+1] = 3*A[n] - 3*A[n-1] + 4*5^(n-1)
# D[n+1] = 3*D[n] + 4*5^(n-1)
# = 4*A[n] - 7*A[n-1] + 3*A[n-2] + (4*5-4)*5^(n-2)
# = 4*A[n] - 7*A[n-1] + 3*A[n-2] + 16*5^(n-2)
# = 4*A[n] - 7*A[n-1] + A[n] + 4*A[n-1] + 4*5^(n-2) + 16*5^(n-2)
# = 3*A[n] - 3*A[n-1] + 20*5^(n-2)
# 4*A[n] - 12*A[n-1] + 4 - 4*5^(n-1) = 0 ??
sub wrong {
my ($n) = @_;
if ($n <= 0) { return 0; }
if ($n == 1) { return 0; }
return 4*wrong($n-1) + 4*5**($n-2);
}
# A[n] = (5^k - 2*3^k + 1)/2
sub formula_pow {
my ($n) = @_;
return (5**$n - 2*3**$n + 1) / 2;
}
sub recurrence_area43 {
my ($n) = @_;
if ($n <= 0) { return 0; }
if ($n == 1) { return 0; }
return 4*recurrence_area43($n-1) - 3*recurrence_area43($n-2) + 4*5**($n-2);
}
# A[n+1] = 8*A[n] - 15*A[n-1] + 4
sub recurrence_area815 {
my ($n) = @_;
if ($n <= 0) { return 0; }
if ($n == 1) { return 0; }
return 8*recurrence_area815($n-1) - 15*recurrence_area815($n-2) + 4;
}
sub recurrence {
my ($n) = @_;
if ($n <= 0) { return 0; }
if ($n == 1) { return 2; }
return 8*recurrence($n-1) - 15*recurrence($n-2) + 2;
}
sub recurrence_area2S {
my ($n) = @_;
return 2*recurrence_S($n+1);
}
sub recurrence_areaSU {
my ($n) = @_;
return 4*recurrence_S($n) + 2*recurrence_U($n);
}
sub recurrence_S {
my ($n) = @_;
if ($n <= 0) { return 0; }
if ($n == 1) { return 0; }
return 2*recurrence_S($n-1) + recurrence_U($n-1);
}
sub recurrence_U {
my ($n) = @_;
if ($n <= 0) { return 0; }
if ($n == 1) { return 0; }
return recurrence_S($n-1) + 2*recurrence_U($n-1) + 2*5**($n-2);
}
# A(n)=a(n)*2
# A(n)/2 = 8*A(n-1)/2 - 15*A(n-2)/2 + 2
# A(n) = 8*A(n-1) - 15*A(n-2) + 4
}
{
# arm xy modulus
require Math::PlanePath::R5DragonMidpoint;
my $path = Math::PlanePath::R5DragonMidpoint->new (arms => 4);
my %dxdy_to_digit;
my %seen;
for (my $n = 0; $n < 6125; $n++) {
my $digit = $n % 5;
foreach my $arm (0 .. 3) {
my ($x,$y) = $path->n_to_xy(4*$n+$arm);
my $nb = int($n/5);
my ($xb,$yb) = $path->n_to_xy(4*$nb+$arm);
# (x+iy)*(1+2i) = x-2y + 2x+y
($xb,$yb) = ($xb-2*$yb, 2*$xb+$yb);
my $dx = $xb - $x;
my $dy = $yb - $y;
my $dxdy = "$dx,$dy";
my $show = "${dxdy}[$digit]";
$seen{$x}{$y} = $show;
if ($dxdy eq '0,0') {
}
# if (defined $dxdy_to_digit{$dxdy} && $dxdy_to_digit{$dxdy} != $digit) {
# die;
# }
$dxdy_to_digit{$dxdy} = $digit;
}
}
foreach my $y (reverse -45 .. 45) {
foreach my $x (-5 .. 5) {
printf " %9s", $seen{$x}{$y}//'e'
}
print "\n";
}
### %dxdy_to_digit
exit 0;
}
{
# Midpoint xy to n
require Math::PlanePath::DragonMidpoint;
require Math::BaseCnv;
my @yx_adj_x = ([0,1,1,0],
[1,0,0,1],
[1,0,0,1],
[0,1,1,0]);
my @yx_adj_y = ([0,0,1,1],
[0,0,1,1],
[1,1,0,0],
[1,1,0,0]);
sub xy_to_n {
my ($self, $x,$y) = @_;
my $n = ($x * 0 * $y) + 0; # inherit bignum 0
my $npow = $n + 1; # inherit bignum 1
while (($x != 0 && $x != -1) || ($y != 0 && $y != 1)) {
# my $ax = ((($x+1) ^ ($y+1)) >> 1) & 1;
# my $ay = (($x^$y) >> 1) & 1;
# ### assert: $ax == - $yx_adj_x[$y%4]->[$x%4]
# ### assert: $ay == - $yx_adj_y[$y%4]->[$x%4]
my $y4 = $y % 4;
my $x4 = $x % 4;
my $ax = $yx_adj_x[$y4]->[$x4];
my $ay = $yx_adj_y[$y4]->[$x4];
### at: "$x,$y n=$n axy=$ax,$ay bit=".($ax^$ay)
if ($ax^$ay) {
$n += $npow;
}
$npow *= 2;
$x -= $ax;
$y -= $ay;
### assert: ($x+$y)%2 == 0
($x,$y) = (($x+$y)/2, # rotate -45 and divide sqrt(2)
($y-$x)/2);
}
### final: "xy=$x,$y"
my $arm;
if ($x == 0) {
if ($y) {
$arm = 1;
### flip ...
$n = $npow-1-$n;
} else { # $y == 1
$arm = 0;
}
} else { # $x == -1
if ($y) {
$arm = 2;
} else {
$arm = 3;
### flip ...
$n = $npow-1-$n;
}
}
### $arm
my $arms_count = $self->arms_count;
if ($arm > $arms_count) {
return undef;
}
return $n * $arms_count + $arm;
}
foreach my $arms (4,3,1,2) {
### $arms
my $path = Math::PlanePath::DragonMidpoint->new (arms => $arms);
for (my $n = 0; $n < 50; $n++) {
my ($x,$y) = $path->n_to_xy($n)
or next;
my $rn = xy_to_n($path,$x,$y);
my $good = '';
if (defined $rn && $rn == $n) {
$good .= "good N";
}
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $rn2 = Math::BaseCnv::cnv($rn,10,2);
printf "n=%d xy=%d,%d got rn=%d %s\n",
$n,$x,$y,
$rn,
$good;
}
}
exit 0;
}
{
# 2i+1 powers
my $x = 1;
my $y = 0;
foreach (1 .. 10) {
($x,$y) = ($x - 2*$y,
$y + 2*$x);
print "$x $y\n";
}
exit 0;
}
{
# turn sequence
require Math::NumSeq::PlanePathTurn;
my @want = (0);
foreach (1 .. 5) {
@want = map { $_ ? (0,0,1,1,1) : (0,0,1,1,0) } @want;
}
my @got;
foreach my $i (1 .. @want) {
push @got, calc_n_turn($i);
}
# my $seq = Math::NumSeq::PlanePathTurn->new (planepath => 'R5DragonCurve',
# turn_type => 'Right');
# while (@got < @want) {
# my ($i,$value) = $seq->next;
# push @got, $value;
# }
my $got = join(',',@got);
my $want = join(',',@want);
print "$got\n";
print "$want\n";
if ($got ne $want) {
die;
}
exit 0;
# return 0 for left, 1 for right
sub calc_n_turn {
my ($n) = @_;
$n or die;
for (;;) {
if (my $digit = $n % 5) {
return ($digit >= 3 ? 1 : 0);
}
$n = int($n/5);
}
}
}
Math-PlanePath-122/devel/greek-key.pl 0000644 0001750 0001750 00000005611 11774517323 015233 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use POSIX 'floor';
use List::Util 'min', 'max';
use Math::PlanePath::GreekKeySpiral;
# uncomment this to run the ### lines
use Smart::Comments;
{
{
package Math::PlanePath::GreekKeySpiral;
sub new {
my $self = shift->SUPER::new (@_);
my $turns = $self->{'turns'};
if (! defined $turns) {
$turns = 2;
} elsif ($turns < 0) {
}
$self->{'turns'} = $turns;
$self->{'centre_x'} = int($turns/2);
$self->{'centre_y'} = int(($turns+1)/2);
$self->{'midpoint'} = ($turns+1)*$turns/2;
return $self;
}
}
sub _n_part_to_xy {
my ($self, $n) = @_;
### _n_part_to_xy(): $n
# if ($rot & 2) {
# $y = -$y;
# }
# if ($d & 1) {
# $x = -$x;
# }
#
# my $d = int((sqrt(-8*$n-7) + 1) / 2);
# $x = $n;
# $y = 0;
# } elsif (($n -= 1) < 0) {
# ### centre ...
# $x = + $n;
# $y = $self->{'centre_y'};
# $rot = $self->{'turns'};
# } else {
# $rot = $d;
# $x = $n;
# $y = 0;
# }
}
my $turns = 6;
my $self = Math::PlanePath::GreekKeySpiral->new (turns => $turns);
### $self
foreach my $n (# 20 .. ($turns+1)**2
0, 6, 11, 15, 18, 20, 21,
21.25,
21.75,
22, 23, 25, 28, 32, 37, 43, 49
) {
my $nn = $n;
my $n = $n;
my $rot = $self->{'turns'};
my $centre_x = $self->{'centre_x'};
my $centre_y = $self->{'centre_y'};
if (($n -= $self->{'midpoint'}) <= 0) {
$n = -$n;
$rot += 0;
$centre_x += 1;
} elsif ($n < 1) {
$rot -= 1;
$centre_x += 1;
} else {
$n -= 1;
$rot += 2;
}
my $d = int((sqrt(8*$n + 1) + 1) / 2);
$n -= $d*($d-1)/2;
my $half = int($d/2);
my $x = $half - $n;
my $y = $n*0 - $half;
if (($d % 4) == 2) {
$x -= 1;
}
if (($d % 4) == 3) {
$y -= 1;
}
$rot -= $d;
if ($rot & 2) {
$x = -$x;
$y = -$y;
}
if ($rot & 1) {
($x,$y) = (-$y,$x);
}
$x += $centre_x;
$y += $centre_y;
$rot &= 3;
print "$nn $d,$n,rot=$rot $x,$y\n";
}
exit 0;
}
Math-PlanePath-122/devel/vogel.pl 0000644 0001750 0001750 00000023161 12067770710 014461 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use POSIX 'fmod';
use List::Util 'min', 'max';
use Math::Libm 'M_PI', 'hypot';
use Math::Trig 'pi';
use POSIX;
use Smart::Comments;
use constant PHI => (1 + sqrt(5)) / 2;
{
require Math::PlanePath::VogelFloret;
my $width = 79;
my $height = 21;
my $x_factor = 1.4;
my $y_factor = 2;
my $n_hi = 99;
require Math::NumSeq::OEIS;
my $seq = Math::NumSeq::OEIS->new(anum => 'A000201');
print_class('Math::PlanePath::VogelFloret');
require Math::NumSeq::FibonacciWord;
$seq = Math::NumSeq::FibonacciWord->new;
$y_factor = 1.2;
$n_hi = 73;
print_class('Math::PlanePath::VogelFloret');
sub print_class {
my ($name) = @_;
# secret leading "*Foo" means print if available
my $if_available = ($name =~ s/^\*//);
my $class = $name;
unless ($class =~ /::/) {
$class = "Math::PlanePath::$class";
}
($class, my @parameters) = split /\s*,\s*/, $class;
$class =~ /^[a-z_][:a-z_0-9]*$/i or die "Bad class name: $class";
if (! eval "require $class") {
if ($if_available) {
next;
} else {
die $@;
}
}
@parameters = map { /(.*?)=(.*)/ or die "Missing value for parameter \"$_\"";
$1,$2 } @parameters;
my %rows;
my $x_min = 0;
my $x_max = 0;
my $y_min = 0;
my $y_max = 0;
my $cellwidth = 1;
my $path = $class->new (width => POSIX::ceil($width / 4),
height => POSIX::ceil($height / 2),
@parameters);
my $x_limit_lo;
my $x_limit_hi;
if ($path->x_negative) {
my $w_cells = int ($width / $cellwidth);
my $half = int(($w_cells - 1) / 2);
$x_limit_lo = -$half;
$x_limit_hi = +$half;
} else {
my $w_cells = int ($width / $cellwidth);
$x_limit_lo = 0;
$x_limit_hi = $w_cells - 1;
}
my $y_limit_lo = 0;
my $y_limit_hi = $height-1;
if ($path->y_negative) {
my $half = int(($height-1)/2);
$y_limit_lo = -$half;
$y_limit_hi = +$half;
}
my $is_01 = $seq->characteristic('smaller');
### seq: ref $seq
### $is_01
$rows{0}{0} = '.';
my $n_start = $path->n_start;
my $n = $n_start;
for (;;) {
my ($x, $y) = $path->n_to_xy ($n);
# stretch these out for better resolution
if ($class =~ /Sacks/) { $x *= 1.5; $y *= 2; }
if ($class =~ /Archimedean/) { $x *= 2; $y *= 3; }
if ($class =~ /Theodorus|MultipleRings/) { $x *= 2; $y *= 2; }
if ($class =~ /Vogel/) { $x *= $x_factor; $y *= $y_factor; }
# nearest integers
$x = POSIX::floor ($x + 0.5);
$y = POSIX::floor ($y + 0.5);
my $cell = $rows{$x}{$y};
if (defined $cell) { $cell .= ','; }
if ($is_01) {
$cell .= $seq->ith($n);
} else {
$cell .= $n;
}
my $new_cellwidth = max ($cellwidth, length($cell) + 1);
my $new_x_limit_lo;
my $new_x_limit_hi;
if ($path->x_negative) {
my $w_cells = int ($width / $new_cellwidth);
my $half = int(($w_cells - 1) / 2);
$new_x_limit_lo = -$half;
$new_x_limit_hi = +$half;
} else {
my $w_cells = int ($width / $new_cellwidth);
$new_x_limit_lo = 0;
$new_x_limit_hi = $w_cells - 1;
}
my $new_x_min = min($x_min, $x);
my $new_x_max = max($x_max, $x);
my $new_y_min = min($y_min, $y);
my $new_y_max = max($y_max, $y);
if ($new_x_min < $new_x_limit_lo
|| $new_x_max > $new_x_limit_hi
|| $new_y_min < $y_limit_lo
|| $new_y_max > $y_limit_hi) {
last;
}
$rows{$x}{$y} = $cell;
$cellwidth = $new_cellwidth;
$x_limit_lo = $new_x_limit_lo;
$x_limit_hi = $new_x_limit_hi;
$x_min = $new_x_min;
$x_max = $new_x_max;
$y_min = $new_y_min;
$y_max = $new_y_max;
if ($is_01) {
$n++;
} else {
(my $i, $n) = $seq->next;
}
last if $n > $n_hi;
}
$n--; # the last N actually plotted
print "$name N=$n_start to N=$n\n\n";
foreach my $y (reverse $y_min .. $y_max) {
foreach my $x ($x_limit_lo .. $x_limit_hi) {
my $cell = $rows{$x}{$y};
if (! defined $cell) { $cell = ''; }
printf ('%*s', $cellwidth, $cell);
}
print "\n";
}
}
exit 0;
}
sub cont {
my $ret = pop;
while (@_) {
$ret = (pop @_) + 1/$ret;
}
return $ret;
}
### phi: cont(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)
{
# use constant ROTATION => M_PI-3;
# use constant ROTATION => PHI;
#use constant ROTATION => sqrt(37);
use constant ROTATION => cont(1 .. 20);
my $margin = 0.999;
# use constant K => 6;
# use constant ROTATION => (K + sqrt(4+K*K)) / 2;
print "ROTATION ",ROTATION,"\n";
my @n;
my @r;
my @x;
my @y;
my $prev_d = 5;
my $min_d = 5;
my $min_n1 = 0;
my $min_n2 = 0;
my $min_x2 = 0;
my $min_y2 = 0;
for (my $n = 1; $n < 100_000_000; $n++) {
my $r = sqrt($n);
my $theta = $n * ROTATION() * 2*pi(); # radians
my $x = $r * cos($theta);
my $y = $r * sin($theta);
foreach my $i (0 .. $#n) {
my $d = hypot ($x-$x[$i], $y-$y[$i]);
if ($d < $min_d) {
$min_d = $d;
$min_n1 = $n[$i];
$min_n2 = $n;
$min_x2 = $x;
$min_y2 = $y;
if ($min_d / $prev_d < $margin) {
$prev_d = $min_d;
print "$min_n1 $min_n2 $min_d ", 1/$min_d, "\n";
print " x=$min_x2 y=$min_y2\n";
}
}
}
push @n, $n;
push @r, $r;
push @x, $x;
push @y, $y;
if ((my $r_lo = sqrt($n) - 1.2 * $min_d) > 0) {
while (@n > 1) {
if ($r[0] >= $r_lo) {
last;
}
shift @r;
shift @n;
shift @x;
shift @y;
}
}
}
print "$min_n1 $min_n2 $min_d ", 1/$min_d, "\n";
print " x=$min_x2 y=$min_y2\n";
exit 0;
}
{
my $x = 3;
foreach (1 .. 100) {
$x = 1 / (1 + $x);
}
}
# {
# # 609 631 0.624053229799566 1.60242740883046
# # 2 7 1.47062247517163 0.679984167849259
#
# use constant ROTATION => M_PI-3;
# my @x;
# my @y;
# foreach my $n (1 .. 20000) {
# my $r = sqrt($n);
# # my $theta = 2 * $n; # radians
# my $theta = $n * ROTATION() * 2*pi(); # radians
# push @x, $r * cos($theta);
# push @y, $r * sin($theta);
# }
# # ### @x
# my $min_d = 999;
# my $min_i = 0;
# my $min_j = 0;
# my $min_xi = 0;
# my $min_yi = 0;
# foreach my $i (0 .. $#x-1) {
# my $xi = $x[$i];
# my $yi = $y[$i];
# foreach my $j ($i+1 .. $#x) {
# my $d = hypot ($xi-$x[$j], $yi-$y[$j]);
# if ($d < $min_d) {
# $min_d = $d;
# $min_i = $i;
# $min_j = $j;
# $min_xi = $xi;
# $min_yi = $yi;
# }
# }
# }
# print "$min_i $min_j $min_d ", 1/$min_d, "\n";
# print " x=$min_xi y=$min_yi\n";
# exit 0;
# }
# {
# require Math::PlanePath::VogelFloret;
# use constant FACTOR => do {
# my @c = map {
# my $n = $_;
# my $r = sqrt($n);
# my $revs = $n / (PHI * PHI);
# my $theta = $revs * 2*M_PI();
# ### $n
# ### $r
# ### $revs
# ### $theta
# ($r*cos($theta), $r*sin($theta))
# } 1, 4;
# ### @c
# ### hypot: hypot ($c[0]-$c[2], $c[1]-$c[3])
# 1 / hypot ($c[0]-$c[2], $c[1]-$c[3])
# };
# ### FACTOR: FACTOR()
#
# print "FACTOR ", FACTOR(), "\n";
# # print "FACTOR ", Math::PlanePath::VogelFloret::FACTOR(), "\n";
# exit 0;
# }
{
foreach my $i (0 .. 20) {
my $f = PHI**$i/sqrt(5);
my $rem = fmod($f,PHI);
printf "%11.5f %6.5f\n", $f, $rem;
}
exit 0;
}
{
foreach my $n (18239,19459,25271,28465,31282,35552,43249,74592,88622,
101898,107155,116682) {
my $theta = $n / (PHI * PHI); # 1==full circle
printf "%6d %.2f\n", $n, $theta;
}
exit 0;
}
foreach my $i (2 .. 5000) {
my $rem = fmod ($i, PHI*PHI);
if ($rem > 0.5) {
$rem = $rem - 1;
}
if (abs($rem) < 0.02) {
printf "%4d %6.3f %s\n", $i,$rem,factorize($i);
}
}
sub factorize {
my ($n) = @_;
my @factors;
foreach my $f (2 .. int(sqrt($n)+1)) {
if (($n % $f) == 0) {
push @factors, $f;
$n /= $f;
while (($n % $f) == 0) {
$n /= $f;
}
}
}
return join ('*',@factors);
}
exit 0;
# pi => { rotation_factor => M_PI() - 3,
# rfactor => 2,
# # ever closer ?
# # 298252 298365 0.146295611059244 6.83547505464836
# # x=-142.771526420416 y=527.239311170539
# },
# # BEGIN {
# # foreach my $info (rotation_types()) {
# # my $rot = $info->{'rotation_factor'};
# # my $n1 = $info->{'closest_Ns'}->[0];
# # my $r1 = sqrt($n1);
# # my $t1 = $n1 * $rot * 2*M_PI();
# # my $x1 = cos ($t1);
# # my $y1 = sin ($t1);
# #
# # my $r2 = sqrt($n2);
# # my $t2 = $n2 * $rot * 2*M_PI();
# # my $x2 = cos ($t2);
# # my $y2 = sin ($t2);
# #
# # $info->{'rfactor'} = 1 / hypot ($x1-$x2, $y1-$y2);
# # }
# # }
Math-PlanePath-122/devel/beta-omega.pl 0000644 0001750 0001750 00000004020 12507664322 015337 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::Base::Digits 'round_down_pow';
# uncomment this to run the ### lines
use Smart::Comments;
use Math::PlanePath::BetaOmega;
use Math::PlanePath::KochCurve;
{
require Math::BaseCnv;
my $path = Math::PlanePath::BetaOmega->new;
my @values;
foreach my $x (0 .. 64) {
my $n = $path->xy_to_n($x,0);
my $n2 = Math::BaseCnv::cnv($n,10,4);
printf "%8s\n", $n2;
push @values, $n;
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose=>1);
exit 0;
}
{
require Math::BaseCnv;
my $path = Math::PlanePath::BetaOmega->new;
foreach my $n (0 .. 64) {
my $n4 = sprintf '%3s', Math::BaseCnv::cnv($n,10,4);
my ($x,$y) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
my $dx = $x2-$x;
my $dy = $y2-$y;
print "$n4 $dx,$dy\n";
}
exit 0;
}
{
require Math::PlanePath::KochCurve;
foreach my $y (reverse -16 .. 22) {
my $y1 = $y;
my $y2 = $y;
{
if ($y2 > 0) {
# eg y=5 gives 3*5 = 15
$y2 *= 3;
} else {
# eg y=-2 gives 1-3*-2 = 7
$y2 = 1-3*$y1;
}
my ($ylen, $ylevel) = round_down_pow($y2,2);
($ylen, $ylevel) = Math::PlanePath::BetaOmega::_y_round_down_len_level($y);
print "$y $y2 $ylevel $ylen\n";
}
}
exit 0;
}
Math-PlanePath-122/devel/flowsnake.pl 0000644 0001750 0001750 00000047550 12561316063 015342 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use FindBin;
use Math::Libm 'M_PI', 'hypot';
use Math::PlanePath;;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh',
'digit_join_lowtohigh';
# uncomment this to run the ### lines
# use Smart::Comments;
{
}
{
# ascii by path
my $k = 3;
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
my ($n_lo, $n_hi) = $path->level_to_n_range($k);
foreach my $y (reverse -2 .. 25) {
my $x = -20;
if ($y % 2) { print " "; $x++; }
X: for ( ; $x <= 28; $x+=2) {
### at: "$x, $y"
{
my $n = $path->xyxy_to_n_either($x,$y, $x+2,$y);
if (defined $n && $n < $n_hi) {
print "__";
### horiz ...
next X;
}
}
{
my $n = $path->xyxy_to_n_either($x,$y, $x+1,$y+1);
if (defined $n && $n < $n_hi) {
print "/ ";
next X;
}
}
{
my $n = $path->xyxy_to_n_either($x+2,$y, $x+1,$y+1);
if (defined $n && $n < $n_hi) {
print " \\";
next X;
}
}
### none ...
print "..";
}
print "\n";
}
exit 0;
}
{
require Math::BaseCnv;
push @INC, "$FindBin::Bin/../../dragon/tools";
require MyFSM;
my @digit_to_rot = (0, 0, 1, 0, 0, 1, 2);
my @digit_permute = (0, 2, 4, 6, 1, 3, 5);
my %table;
foreach my $digit (0 .. 6) {
foreach my $rot (0 .. 2) {
my $p = $digit;
foreach (1 .. $rot) {
$p = $digit_permute[$p];
}
my $new_rot = ($rot + $digit_to_rot[$p]) % 3;
$table{$rot}->{$digit} = $new_rot;
print "$new_rot, ";
}
print "\n";
}
my $fsm = MyFSM->new(table => \%table,
initial => 0,
accepting => { 0=>0, 1=>1, 2=>2 },
);
{
my $width = 2;
foreach my $n (0 .. 7**$width-1) {
my $n7 = sprintf '%0*s', $width, Math::BaseCnv::cnv($n,10,7);
my @v = split //,$n7;
# print $fsm->traverse(\@v);
print @v," ",$fsm->traverse(\@v),"\n";
}
print "\n";
# exit 0;
}
my $hf = $fsm;
print "traverse ", $fsm->traverse([0,2]), "\n";
$fsm->view;
$fsm = $fsm->reverse;
$fsm->simplify;
$fsm->view;
print "reverse\n";
foreach my $digit (0 .. 6) {
foreach my $state ($fsm->sorted_states) {
my $new_state = $fsm->{'table'}->{$state}->{$digit};
my $ns = $new_state;
if ($ns eq 'identity') { $ns = 0; } $ns =~ s/,.*//;
print $ns,", ";
}
print "\n";
}
print "traverse ", $fsm->traverse([2,0]), "\n";
my $width = 2;
foreach my $n (0 .. 7**$width-1) {
my $n7 = sprintf '%0*s', $width, Math::BaseCnv::cnv($n,10,7);
my @v = split //,$n7;
my $h = $hf->traverse(\@v);
my $l = $fsm->traverse([ reverse @v ]);
if ($l eq 'identity') { $l = 0; } $l =~ s/,.*//;
if ($h ne $l) {
print join(', ',@v)," h=$h l=$l\n";
}
}
exit 0;
}
{
# rect_to_n_range
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
my ($n_lo,$n_hi) = $path->rect_to_n_range(0,0, 31.5,31.5);
### $n_lo
### $n_hi
foreach my $n (973 .. 1000000) {
my ($x,$y) = $path->n_to_xy($n);
if ($x >= 0 && $x <= 31.5
&& $y >= 0 && $y <= 31.5) {
print "$n $x,$y\n";
}
}
exit 0;
}
{
require Math::NumSeq::PlanePathDelta;
require Math::PlanePath::Flowsnake;
my $class = 'Math::PlanePath::Flowsnake';
my $path = $class->new;
my $seq = Math::NumSeq::PlanePathDelta->new (planepath_object=>$path,
delta_type => 'TDir6');
sub path_n_to_tturn6 {
my ($n) = @_;
if ($n < 1) { return undef; }
my $turn6 = $seq->ith($n) - $seq->ith($n-1);
if ($turn6 > 3) { $turn6 -= 6; }
return $turn6;
}
# N to Turn by recurrence
sub calc_n_to_tturn6 { # not working
my ($n) = @_;
if ($n < 1) { return undef; }
if ($n % 49 == 0) {
return calc_n_to_tturn6($n/7);
}
if (int($n/7) % 7 == 3) { # "_3_"
return calc_n_to_tturn6(($n%7) + int($n/49));
}
return path_n_to_tturn6($n);
if ($n == 1) { return 1; }
if ($n == 2) { return 2; }
if ($n == 3) { return -1; }
if ($n == 4) { return -2; }
if ($n == 5) { return 0; }
if ($n == 6) { return -1; }
my @digits = digit_split_lowtohigh($n,7);
my $high = pop @digits;
if ($digits[-1]) {
}
$n = digit_join_lowtohigh(\@digits,7,0);
if ($n == 0) {
return 0;
}
return calc_n_to_tturn6($n);
}
{
for (my $n = 1; $n < 7**3; $n+=1) {
my $value = path_n_to_tturn6($n);
my $calc = calc_n_to_tturn6($n);
my $diff = ($value != $calc ? ' ***' : '');
print "$n $value $calc$diff\n";
}
exit 0;
}
exit 0;
}
{
# N to Dir6 -- working for integers
require Math::PlanePath::Flowsnake;
require Math::NumSeq::PlanePathDelta;
my @next_state = (0,7,7,0,0,0,7,
0,7,7,7,0,0,7);
my @tdir6 = (0,1,3,2,0,0,-1,
-1,0,0,2,3,1,0);
sub n_to_totalturn6 {
my ($self, $n) = @_;
unless ($n >= 0) {
return undef;
}
my $state = 0;
my $tdir6 = 0;
foreach my $digit (reverse digit_split_lowtohigh($n,7)) {
$state += $digit;
$tdir6 += $tdir6[$state];
$state = $next_state[$state];
}
return $tdir6 % 6;
}
{
my $class = 'Math::PlanePath::Flowsnake';
my $path = $class->new;
my $seq = Math::NumSeq::PlanePathDelta->new (planepath=>'Flowsnake',
delta_type => 'TDir6');
for (my $n = 0; $n < 7**3; $n+=1) {
my $value = $seq->ith($n);
my $tdir6 = n_to_totalturn6($path,$n) % 6;
my $diff = ($value != $tdir6 ? ' ***' : '');
print "$n $value $tdir6$diff\n";
}
exit 0;
}
# sub _digit_lowest {
# my ($n, $radix) = @_;
# my $digit;
# for (;;) {
# last if ($digit = ($n % 7));
# $n /= 7;
# last unless $n;
# }
# # if ($digit < 1_000_000) {
# # $digit = "$digit";
# # }
# return $digit;
# }
}
{
# N to Turn6 -- working for integers
require Math::PlanePath::Flowsnake;
require Math::NumSeq::PlanePathDelta;
my $class = 'Math::PlanePath::Flowsnake';
my $path = $class->new;
my $seq = Math::NumSeq::PlanePathDelta->new (planepath=>'Flowsnake',
delta_type => 'TDir6');
for (my $n = 1; $n < 7**4; $n+=1) {
my $value = ($seq->ith($n) - $seq->ith($n-1)) % 6;
$value += 2; # range -2 to +2
$value %= 6;
$value -= 2;
my $turn = $path->_WORKING_BUT_SECRET__n_to_turn6($n);
my $diff = ($value != $turn ? ' ***' : '');
print "$n $value $turn$diff\n";
die if $value != $turn;
}
exit 0;
}
{
require Math::PlanePath::Flowsnake;
require Math::PlanePath::FlowsnakeCentres;
my $f = Math::PlanePath::Flowsnake->new (arms => 2);
my $c = Math::PlanePath::FlowsnakeCentres->new (arms => 2);
my $width = 5;
my %saw;
foreach my $n (0 .. 7**($width-1)) {
my ($x,$y) = $f->n_to_xy($n);
my $cn = $c->xy_to_n($x,$y) // -1;
my $cr = $c->xy_to_n($x+2, $y) // -1;
my $ch = $c->xy_to_n($x+1,$y+1) // -1;
my $cw = $c->xy_to_n($x-1,$y+1) // -1;
my $cl = $c->xy_to_n($x-2,$y) // -1; # <------
my $cu = $c->xy_to_n($x-1,$y-1) // -1; # <------3
my $cz = $c->xy_to_n($x+1,$y-1) // -1;
if ($n == $cn) { $saw{'n'} = 0; }
if ($n == $cr) { $saw{'r'} = 1; }
if ($n == $ch) { $saw{'h'} = 2; }
if ($n == $cw) { $saw{'w'} = 3; }
if ($n == $cl) { $saw{'l'} = 4; }
if ($n == $cu) { $saw{'u'} = 5; }
if ($n == $cz) { $saw{'z'} = 6; }
unless (($n == $cn)
|| ($n == $cr)
|| ($n == $ch)
|| ($n == $cw)
|| ($n == $cl)
|| ($n == $cu)
|| ($n == $cz)) {
die "no match $n: $cn,$cr,$ch,$cw,$cl,$cu,$cz";
}
}
my $saw = join(',', sort {$saw{$a}<=>$saw{$b}} keys %saw);
print "$saw\n";
exit 0;
}
{
require Math::PlanePath::Flowsnake;
require Math::PlanePath::FlowsnakeCentres;
say Math::PlanePath::Flowsnake->isa('Math::PlanePath::FlowsnakeCentres');
say Math::PlanePath::FlowsnakeCentres->isa('Math::PlanePath::Flowsnake');
say Math::PlanePath::Flowsnake->can('xy_to_n');
say Math::PlanePath::FlowsnakeCentres->can('xy_to_n');
exit 0;
}
{
require Math::BaseCnv;
require Math::PlanePath::Flowsnake;
require Math::PlanePath::FlowsnakeCentres;
my $c = Math::PlanePath::Flowsnake->new;
my $f = Math::PlanePath::FlowsnakeCentres->new;
my $width = 5;
my %saw;
foreach my $n (0 .. 7**($width-1)) {
my $n7 = sprintf '%*s', $width, Math::BaseCnv::cnv($n,10,7);
my ($x,$y) = $f->n_to_xy($n);
my $cn = $c->xy_to_n($x,$y) || -1;
my $cn7 = sprintf '%*s', $width, Math::BaseCnv::cnv($cn,10,7);
my $rx = $x + 1;
my $ry = $y + 1;
my $cr = $c->xy_to_n($rx,$ry) || -1;
my $cr7 = sprintf '%*s', $width, Math::BaseCnv::cnv($cr,10,7);
my $hx = $x + 1;
my $hy = $y + 1;
my $ch = $c->xy_to_n($hx,$hy) || -1;
my $ch7 = sprintf '%*s', $width, Math::BaseCnv::cnv($ch,10,7);
my $wx = $x - 1;
my $wy = $y + 1;
my $cw = $c->xy_to_n($wx,$wy) || -1;
my $cw7 = sprintf '%*s', $width, Math::BaseCnv::cnv($cw,10,7);
my $lx = $x - 2;
my $ly = $y;
my $cl = $c->xy_to_n($lx,$ly) || -1;
my $cl7 = sprintf '%*s', $width, Math::BaseCnv::cnv($cl,10,7);
my $ux = $x - 1;
my $uy = $y - 1;
my $cu = $c->xy_to_n($ux,$uy) || -1;
my $cu7 = sprintf '%*s', $width, Math::BaseCnv::cnv($cu,10,7);
my $zx = $x + 1;
my $zy = $y - 1;
my $cz = $c->xy_to_n($zx,$zy) || -1;
my $cz7 = sprintf '%*s', $width, Math::BaseCnv::cnv($cz,10,7);
if ($n == $cn) { $saw{'n'} = 0; }
if ($n == $cr) { $saw{'r'} = 1; }
if ($n == $ch) { $saw{'h'} = 2; }
if ($n == $cw) { $saw{'w'} = 3; }
if ($n == $cl) { $saw{'l'} = 4; }
if ($n == $cu) { $saw{'u'} = 5; }
if ($n == $cz) { $saw{'z'} = 6; }
my $bad = ($n == $cn
|| $n == $cr
|| $n == $ch
|| $n == $cw
|| $n == $cl
|| $n == $cu
|| $n == $cz
? ''
: ' ******');
# print "$n7 $cn7 $ch7 $cw7 $cu7 $bad\n";
}
my $saw = join(',', sort {$saw{$a}<=>$saw{$b}} keys %saw);
print "$saw\n";
exit 0;
}
{
require Math::BaseCnv;
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
foreach my $y (reverse -5 .. 40) {
printf "%3d ", $y;
foreach my $x (-20 .. 15) {
my $n = $path->xy_to_n($x,$y);
if (! defined $n) {
print " ";
next;
}
my $nh = $n - ($n%7);
my ($hx,$hy) = $path->n_to_xy($nh);
my $pos = '?';
if ($hy > $y) {
$pos = 'T';
} elsif ($hx > $x) {
$pos = '.';
} else {
$pos = '*';
$pos = $n%7;
}
print "$pos ";
}
print "\n";
}
exit 0;
}
{
require Math::BaseCnv;
require Math::PlanePath::Flowsnake;
require Math::PlanePath::FlowsnakeCentres;
my $f = Math::PlanePath::Flowsnake->new;
my $c = Math::PlanePath::FlowsnakeCentres->new;
my $width = 5;
foreach my $n (0 .. 7**($width-1)) {
my $n7 = sprintf '%*s', $width, Math::BaseCnv::cnv($n,10,7);
my ($x,$y) = $f->n_to_xy($n);
my $cn = $c->xy_to_n($x,$y) || 0;
my $cn7 = sprintf '%*s', $width, Math::BaseCnv::cnv($cn,10,7);
my $m = ($x + 2*$y) % 7;
if ($m == 2) { # 2,0 = 2
$x -= 2;
} elsif ($m == 5) { # 3,1 = 3+2*1 = 5
$x -= 3;
$y -= 1;
} elsif ($m == 3) { # 1,1 = 1+2 = 3
$x -= 1;
$y -= 1;
} elsif ($m == 4) { # 0,2 = 0+2*2 = 4
$y -= 2;
} elsif ($m == 6) { # 2,2 = 2+2*2 = 6
$x -= 2;
$y -= 2;
} elsif ($m == 1) { # 4,2 = 4+2*2 = 8 = 1
$x -= 4;
$y -= 2;
}
my $mn = $c->xy_to_n($x,$y) || 0;
my $mn7 = sprintf '%*s', $width, Math::BaseCnv::cnv($mn,10,7);
my $nh = $n - ($n%7);
my $mh = $mn - ($mn%7);
my $diff = ($nh == $mh ? "" : " **");
print "$n7 $mn7 $cn7$diff\n";
}
exit 0;
}
{
# xy_to_n
require Math::PlanePath::Flowsnake;
require Math::PlanePath::FlowsnakeCentres;
my $path = Math::PlanePath::FlowsnakeCentres->new;
my $k = 4000;
my ($n_lo,$n_hi) = $path->rect_to_n_range(-$k,-$k, $k,$k);
print "$n_lo, $n_hi\n";
exit 0;
}
{
# xy_to_n
require Math::PlanePath::Flowsnake;
require Math::PlanePath::FlowsnakeCentres;
my $path = Math::PlanePath::FlowsnakeCentres->new;
my $y = 0;
for (my $x = 6; $x >= -5; $x-=2) {
$x -= ($x^$y)&1;
my $n = $path->xy_to_n($x,$y);
print "$x,$y ",($n//'undef'),"\n";
}
exit 0;
}
{
# modulo
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
for (my $n = 0; $n <= 49; $n++) {
if (($n % 7) == 0) { print "\n"; }
my ($x,$y) = $path->n_to_xy($n);
my $c = $x + 2*$y;
my $m = $c % 7;
print "$n $x,$y $c $m\n";
}
exit 0;
}
{
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
for (my $n = 0; $n <= 49; $n+=7) {
my ($x,$y) = $path->n_to_xy($n);
my ($rx,$ry) = ((3*$y + 5*$x) / 14,
(5*$y - $x) / 14);
print "$n $x,$y $rx,$ry\n";
}
exit 0;
}
{
# radius
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
my $prev_max = 1;
for (my $level = 1; $level < 10; $level++) {
print "level $level\n";
my ($x2,$y2) = $path->n_to_xy(2 * 7**($level-1));
my ($x3,$y3) = $path->n_to_xy(3 * 7**($level-1));
my $cx = ($x2+$x3)/2;
my $cy = ($y2+$y3)/2;
my $max_hypot = 0;
my $max_pos = '';
foreach my $n (0 .. 7**$level - 1) {
my ($x,$y) = $path->n_to_xy($n);
my $h = ($x-$cx)**2 + 3*($y-$cy);
if ($h > $max_hypot) {
$max_hypot = $h;
$max_pos = "$x,$y";
}
}
my $factor = $max_hypot / $prev_max;
$prev_max = $max_hypot;
print " cx=$cx,cy=$cy max $max_hypot at $max_pos factor $factor\n";
}
exit 0;
}
{
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
my $prev_max = 1;
for (my $level = 1; $level < 10; $level++) {
my $n_start = 0;
my $n_end = 7**$level - 1;
my $min_hypot = $n_end;
my $min_x = 0;
my $min_y = 0;
my $max_hypot = 0;
my $max_pos = '';
print "level $level\n";
my ($xend,$yend) = $path->n_to_xy(7**($level-1));
print " end $xend,$yend\n";
$yend *= sqrt(3);
my $cx = -$yend; # rotate +90
my $cy = $xend;
print " rot90 $cx, $cy\n";
# $cx *= sqrt(3/4) * .5;
# $cy *= sqrt(3/4) * .5;
$cx *= 1.5;
$cy *= 1.5;
print " scale $cx, $cy\n";
$cx += $xend;
$cy += $yend;
print " offset to $cx, $cy\n";
$cy /= sqrt(3);
printf " centre %.1f, %.1f\n", $cx,$cy;
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
my $h = ($cx-$x)**2 + 3*($cy-$y)**2;
if ($h > $max_hypot) {
$max_hypot = $h;
$max_pos = "$x,$y";
}
# if ($h < $min_hypot) {
# $min_hypot = $h;
# $min_x = $x;
# $min_y = $y;
# }
}
# print " min $min_hypot at $min_x,$min_y\n";
my $factor = $max_hypot / $prev_max;
print " max $max_hypot at $max_pos factor $factor\n";
$prev_max = $max_hypot;
}
exit 0;
}
{
# diameter
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
my $prev_max = 1;
for (my $level = 1; $level < 10; $level++) {
print "level $level\n";
my $n_start = 0;
my $n_end = 7**$level - 1;
my ($xend,$yend) = $path->n_to_xy($n_end);
print " end $xend,$yend\n";
my @x;
my @y;
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
push @x, $x;
push @y, $y;
}
my $max_hypot = 0;
my $max_pos = '';
my ($cx,$cy);
foreach my $i (0 .. $#x-1) {
foreach my $j (1 .. $#x) {
my $h = ($x[$i]-$x[$j])**2 + 3*($y[$i]-$y[$j]);
if ($h > $max_hypot) {
$max_hypot = $h;
$max_pos = "$x[$i],$y[$i], $x[$j],$y[$j]";
$cx = ($x[$i] + $x[$j]) / 2;
$cy = ($y[$i] + $y[$j]) / 2;
}
}
}
my $factor = $max_hypot / $prev_max;
print " max $max_hypot at $max_pos factor $factor\n";
$prev_max = $max_hypot;
}
exit 0;
}
{
require Math::PlanePath::GosperIslands;
my $path = Math::PlanePath::GosperIslands->new;
foreach my $level (0 .. 20) {
my $n_start = 3**($level+1) - 2;
my $n_end = 3**($level+2) - 2 - 1;
my ($prev_x) = $path->n_to_xy($n_start);
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
# if ($y == 0 && $x > 0) {
# print "level $level x=$x y=$y n=$n\n";
# }
if (($prev_x>0) != ($x>0) && $y > 0) {
print "level $level x=$x y=$y n=$n\n";
}
$prev_x = $x;
}
print "\n";
}
exit 0;
}
sub hij_to_xy {
my ($h, $i, $j) = @_;
return ($h*2 + $i - $j,
$i+$j);
}
{
# y<0 at n=8598 x=-79,y=-1
require Math::PlanePath::Flowsnake;
my $path = Math::PlanePath::Flowsnake->new;
for (my $n = 3; ; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($y == 0) {
print "zero n=$n $x,$y\n";
}
if ($y < 0) {
print "yneg n=$n $x,$y\n";
exit 0;
}
# if ($y < 0 && $x >= 0) {
# print "yneg n=$n $x,$y\n";
# exit 0;
# }
}
exit 0;
}
{
{
my $sh = 1;
my $si = 0;
my $sj = 0;
my $n = 1;
foreach my $level (1 .. 20) {
$n *= 7;
($sh, $si, $sj) = (2*$sh - $sj,
2*$si + $sh,
2*$sj + $si);
my ($x, $y) = hij_to_xy($sh,$si,$sj);
$n = sprintf ("%f",$n);
print "$level $n $sh,$si,$sj $x,$y\n";
}
}
exit 0;
}
our $level;
my $n = 0;
my $x = 0;
my $y = 0;
my %seen;
my @row;
my $x_offset = 8;
my $dir = 0;
sub step {
$dir %= 6;
print "$n $x, $y dir=$dir\n";
my $key = "$x,$y";
if (defined $seen{$key}) {
print "repeat $x, $y from $seen{$key}\n";
}
$seen{"$x,$y"} = $n;
if ($y >= 0) {
$row[$y]->[$x+$x_offset] = $n;
}
if ($dir == 0) { $x += 2; }
elsif ($dir == 1) { $x++, $y++; }
elsif ($dir == 2) { $x--, $y++; }
elsif ($dir == 3) { $x -= 2; }
elsif ($dir == 4) { $x--, $y--; }
elsif ($dir == 5) { $x++, $y--; }
else { die; }
$n++;
}
sub forward {
if ($level == 1) {
step ();
return;
}
local $level = $level-1;
forward(); $dir++; # 0
backward(); $dir += 2; # 1
backward(); $dir--; # 2
forward(); $dir -= 2; # 3
forward(); # 4
forward(); $dir--; # 5
backward(); $dir++; # 6
}
sub backward {
my ($dir) = @_;
if ($level == 1) {
step ();
return;
}
print "backward\n";
local $level = $level-1;
$dir += 2;
forward();
forward();
$dir--; # 5
forward();
$dir--; # 5
forward();
$dir--; # 5
backward();
$dir--; # 5
backward();
$dir--; # 5
forward();
$dir--; # 5
}
$level = 3;
forward (2);
foreach my $y (reverse 0 .. $#row) {
my $aref = $row[$y];
foreach my $x (0 .. $#$aref) {
printf ('%*s', 3, (defined $aref->[$x] ? $aref->[$x] : ''));
}
print "\n";
}
Math-PlanePath-122/devel/diagonals.pl 0000644 0001750 0001750 00000006437 12157255652 015320 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
# uncomment this to run the ### lines
use Smart::Comments;
use Math::PlanePath::Diagonals;
use Math::NumSeq::PlanePathDelta;
{
my $dir = 'up';
foreach my $y_start (reverse -7 .. 7) {
printf "Ystart=%2d", $y_start;
foreach my $x_start (-7 .. 7) {
my $seq = Math::NumSeq::PlanePathDelta->new
(planepath => "Diagonals,x_start=$x_start,y_start=$y_start,direction=$dir",
delta_type => 'dSumAbs');
printf " %3d", $seq->values_max;
}
print "\n";
}
print "\n";
foreach my $y_start (reverse -7 .. 7) {
printf "Ystart=%2d", $y_start;
foreach my $x_start (-7 .. 7) {
my $max = dsumabs_max($x_start,$y_start);
my $seq = Math::NumSeq::PlanePathDelta->new
(planepath => "Diagonals,x_start=$x_start,y_start=$y_start,direction=$dir",
delta_type => 'dSumAbs');
my $diff = ($seq->values_max == $max ? ' ' : '*');
printf "%3d%s", $max, $diff;
}
print "\n";
}
print "\n";
foreach my $y_start (reverse -7 .. 7) {
printf "Ystart=%2d", $y_start;
foreach my $x_start (-7 .. 7) {
my $seq = Math::NumSeq::PlanePathDelta->new
(planepath => "Diagonals,x_start=$x_start,y_start=$y_start,direction=$dir",
delta_type => 'dSumAbs');
printf " %3d", $seq->values_min;
}
print "\n";
}
print "\n";
foreach my $y_start (reverse -7 .. 7) {
printf "Ystart=%2d ", $y_start;
foreach my $x_start (-7 .. 7) {
my $min = dsumabs_min($x_start,$y_start);
my $seq = Math::NumSeq::PlanePathDelta->new
(planepath => "Diagonals,x_start=$x_start,y_start=$y_start,direction=$dir",
delta_type => 'dSumAbs');
my $diff = ($seq->values_min == $min ? ' ' : '*');
printf "%3d%s", $min, $diff;
}
print "\n";
}
print "\n";
exit 0;
sub dsumabs_min {
my ($x_start, $y_start) = @_;
my $seq = Math::NumSeq::PlanePathDelta->new
(planepath => "Diagonals,x_start=$x_start,y_start=$y_start,direction=$dir",
delta_type => 'dSumAbs');
my $i_start = $seq->i_start;
my $min = $seq->ith($i_start);
foreach my $i ($i_start .. 500) {
$min = min($min, $seq->ith($i));
}
return $min;
}
sub dsumabs_max {
my ($x_start, $y_start) = @_;
my $seq = Math::NumSeq::PlanePathDelta->new
(planepath => "Diagonals,x_start=$x_start,y_start=$y_start,direction=$dir",
delta_type => 'dSumAbs');
my $i_start = $seq->i_start;
my $max = $seq->ith($i_start);
foreach my $i ($i_start .. 500) {
$max = max($max, $seq->ith($i));
}
return $max;
}
}
Math-PlanePath-122/devel/ulam-warburton.pl 0000644 0001750 0001750 00000013241 12400225034 016303 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use warnings;
# uncomment this to run the ### lines
#use Smart::Comments;
{
# depth_to_n()
require Math::PlanePath::UlamWarburton;
my $path = Math::PlanePath::UlamWarburton->new(parts=>'octant');
for (my $depth = 0; $depth < 35; $depth++) {
my $n = $path->tree_depth_to_n($depth);
my ($x,$y) = $path->n_to_xy($n);
my $rn = $path->xy_to_n($x,$y);
my $diff = $rn - $n;
print "$depth $n $x,$y $diff\n";
}
exit 0;
}
{
# n_to_depth() 1 6 16
# 2 7,8 17,18
# 14 3 9,10 19,20
# 15 10 13 20 4,5 11,12,13,14,15
# 5 8 12 18
# 1 2 3 4 6 7 9 11 16 17 19
# --------------------------
# 0 1 2 3 4 5 6 7 8
require Math::PlanePath::UlamWarburton;
my $path = Math::PlanePath::UlamWarburton->new(parts=>'octant');
for (my $n = 1; $n <= 35; $n++) {
my $depth = $path->tree_n_to_depth($n);
print "$n $depth\n";
}
exit 0;
}
{
# height
# my $class = 'Math::PlanePath::UlamWarburton';
# my $class = 'Math::PlanePath::UlamWarburtonQuarter';
# my $class = 'Math::PlanePath::ToothpickUpist';
my $class = 'Math::PlanePath::LCornerTree';
eval "require $class";
require Math::BaseCnv;
my $path = $class->new (parts => 1);
my $prev_depth = 0;
for (my $n = $path->n_start;; $n++) {
my $depth = $path->tree_n_to_depth($n);
my $n_depth = $path->tree_depth_to_n($depth);
if ($depth != $prev_depth) {
print "\n";
last if $depth > 65;
$prev_depth = $depth;
}
my $calc_height = $path->tree_n_to_subheight($n);
my $search_height = path_tree_n_to_subheight_by_search($path,$n);
my $n3 = Math::BaseCnv::cnv($n - $n_depth, 10,3);
$search_height //= 'undef';
$calc_height //= 'undef';
my $diff = ($search_height eq $calc_height ? '' : ' ***');
printf "%2d %2d %3s %5s %5s%s\n",
$depth, $n, $n3, $search_height, $calc_height, $diff;
}
exit 0;
sub path_tree_n_to_subheight_by_search {
my ($self, $n) = @_;
my @n = ($n);
my $height = 0;
for (;;) {
@n = map {$self->tree_n_children($_)} @n
or return $height;
$height++;
if (@n > 400 || $height > 70) {
return undef; # presumed infinite
}
}
}
}
{
# number of children
require Math::PlanePath::UlamWarburton;
require Math::PlanePath::UlamWarburtonQuarter;
# my $path = Math::PlanePath::UlamWarburton->new;
my $path = Math::PlanePath::UlamWarburtonQuarter->new;
my $prev_depth = 0;
for (my $n = $path->n_start; ; $n++) {
my $depth = $path->tree_n_to_depth($n);
if ($depth != $prev_depth) {
$prev_depth = $depth;
print "\n";
last if $depth > 40;
}
my $num_children = $path->tree_n_num_children($n);
print "$num_children,";
}
print "\n";
exit 0;
}
# turn on u(0) = 1
# u(1) = 1
# u(n) = 4 * 3^ones(n-1) - 1
# where ones(x) = number of 1 bits A000120
#
{
my @yx;
sub count_around {
my ($x,$y) = @_;
return ((!! $yx[$y+1][$x])
+ (!! $yx[$y][$x+1])
+ ($x > 0 && (!! $yx[$y][$x-1]))
+ ($y > 0 && (!! $yx[$y-1][$x])));
}
my (@turn_x,@turn_y);
sub turn_on {
my ($x,$y) = @_;
### turn_on(): "$x,$y"
if (! $yx[$y][$x] && count_around($x,$y) == 1) {
push @turn_x, $x;
push @turn_y, $y;
}
}
my $print_grid = 1;
my $cumulative = 1;
my @lchar = ('a' .. 'z');
$yx[0][0] = $lchar[0];
for my $level (1 .. 20) {
print "\n";
printf "level %d %b\n", $level, $level;
if ($print_grid) {
foreach my $row (reverse @yx) {
foreach my $cell (@$row) {
print ' ', (defined $cell #&& ($cell eq 'p' || $cell eq 'o')
? $cell : ' ');
}
print "\n";
}
print "\n";
}
{
my $count = 0;
foreach my $row (reverse @yx) {
foreach my $cell (@$row) {
$count += defined $cell;
}
}
print "total $count\n";
}
foreach my $y (0 .. $#yx) {
my $row = $yx[$y];
foreach my $x (0 .. $#$row) {
$yx[$y][$x] or next;
### cell: $yx[$y][$x]
turn_on ($x, $y+1);
turn_on ($x+1, $y);
if ($x > 0) {
turn_on ($x-1, $y);
}
if ($y > 0) {
turn_on ($x, $y-1);
}
}
}
print "extra ",scalar(@turn_x),"\n";
my %seen_turn;
for (my $i = 0; $i < @turn_x; ) {
my $key = "$turn_x[$i],$turn_y[$i]";
if ($seen_turn{$key}) {
splice @turn_x,$i,1;
splice @turn_y,$i,1;
} else {
$seen_turn{$key} = 1;
$i++;
}
}
my $e = 4*(scalar(@turn_x)-2)+4;
$cumulative += $e;
print "extra $e cumulative $cumulative\n";
### @turn_x
### @turn_y
while (@turn_x) {
$yx[pop @turn_y][pop @turn_x] = ($lchar[$level]||'z');
}
### @yx
}
exit 0;
}
Math-PlanePath-122/devel/corner-replicate.pl 0000644 0001750 0001750 00000002261 12157300664 016576 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
# uncomment this to run the ### lines
use Smart::Comments;
use Math::PlanePath::CornerReplicate;
{
my $path = Math::PlanePath::CornerReplicate->new;
foreach my $n (0x0FFF, 0x1FFF, 0x2FFF, 0x3FFF) {
my ($x,$y) = $path->n_to_xy ($n);
my ($x2,$y2) = $path->n_to_xy ($n+1);
my $dsum = ($x2+$y2) - ($x+$y);
printf "%4X to %4X %2X,%2X to %2X,%2X dSum=%d\n",
$n,$n+1, $x,$y, $x2,$y2, $dsum;
}
exit 0;
}
Math-PlanePath-122/devel/terdragon.pl 0000644 0001750 0001750 00000115026 12561577603 015341 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::TerdragonCurve;
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh',
'digit_join_lowtohigh';
use List::Pairwise;
use Math::BaseCnv;
use lib 'xt';
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments;
# # skip low zeros
# # 1 left
# # 2 right
# ones(n) - ones(n+1)
# 1*3^k left
# 2*3^k right
{
# A062756 == 1-abs(A229215) mod 3
# A062756(n) = vecsum(apply(d->d==1,digits(n,3)));
# A229215(n) = [1,-3,-2,-1,3,2][(A062756(n-1) % 6)+1];
# A229215(n) = [1,2,3,-1,-2,-3][(-A062756(n-1) % 6)+1];
# vector(20,n,n--; A062756(n))
# vector(20,n, A229215(n))
# A229215(n) = (digits(n,3))
# A229215
# 1, -3, 1, -3, -2, -3, 1, -3, 1, -3, -2, -3, -2, -1, -2, -3, -2, -3, 1,
require Math::NumSeq::OEIS;
my $A062756 = Math::NumSeq::OEIS->new(anum=>'A062756');
my $A229215 = Math::NumSeq::OEIS->new(anum=>'A229215');
my @map = (1,2,3,-1,-2,-3);
for (;;) {
my ($i1,$value1) = $A062756->next or last;
my ($i2,$value2) = $A229215->next or last;
# $value1 %= 3;
# $value2 = (1 - abs($value2)) % 3;
$value1 = $map[-$value1 % 6];
print "i=$i1 $value1 $value2\n";
$value1 == $value2 or die;
}
exit 0;
}
{
# some variations
# cf A106154 terdragon 6 something
# A105499 terdragon permute something
# 1->{2,1,2}, 2->{1,3,1}, 3->{3,2,3}.
# 212323212131212131212323212323131323212323212323
# * * 3 2
# \ / \ \ /
# *---* -1 ---*--- 1
# \ / \
# *---* -2 -3
#
# A062756
# 0, 1, 0, 1, 2, 1, 0, 1, 0, 1, 2, 1, 2, 3, 2, 1, 2, 1, 0, 1, 0, 1, 2, 1,
# 1,2,3 = 0,1,2
# -1,-2,-3 = 3,4,5
my @map123 = (undef, 0,1,2, 5,4,3);
require Math::NumSeq::OEIS;
my $seq;
$seq = Math::NumSeq::OEIS->new(anum=>'A105969');
$seq = Math::NumSeq::OEIS->new(anum=>'A106154');
$seq = Math::NumSeq::OEIS->new(anum=>'A229215');
require Language::Logo;
my $lo = Logo->new(update => 2, port => 8200 + (time % 100));
my $draw;
# $lo->command("seth 135; backward 200; seth 90");
$lo->command("pendown; hideturtle");
my $angle = 0;
while (my ($i,$value) = $seq->next) {
last if $i > 3**3;
$value = $map123[$value];
$angle = $value*120;
# $angle = 90-$angle;
$angle += 90;
$lo->command("seth $angle; forward 13");
}
$lo->disconnect("Finished...");
exit 0;
}
{
# powers (1+w)^k
# w^2 = -1+w
# (a+bw)*(1+w) = a+bw + aw+bw^2
# = a + bw + aw - b + bw
# = (a-b) + (a+2b)w
# a+bw = (a+b) + bw^2
my $a = 1;
my $b = 0;
my @values;
for (1 .. 30) {
push @values, -($a+$b);
($a,$b) = ($a-$b, $a+2*$b);
}
for (1 .. 20) {
print "$_\n";
Math::OEIS::Grep->search(array=>\@values);
}
exit 0;
}
{
# mixed ternary grep
my @values;
foreach my $n (1 .. 3*2**3) {
my @digits = Math::PlanePath::TerdragonCurve::_digit_split_mix23_lowtohigh($n);
push @values, digit_join_lowtohigh(\@digits,3);
}
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
=head2 Left Boundary Turn Sequence
The left boundary turn sequence is
Lt(i) = / if i == 1 mod 3 then turn -120 (right)
| otherwise
| let b = bit above lowest 1-bit of i-floor((i+1)/3)
| if b = 0 then turn 0 (straight ahead)
\ if b = 1 then turn +120 (left)
= 1, 0, 0, 1, -1, 0, 1, 0, -1, 1, -1, 0, 1, 0, 0, 1, -1, -1, ...
starting i=1, multiple of 120 degrees
The sequence can be calculated in a similar way to the right boundary, but
from an initial V part since the "0" and "2" points are on the left boundary
(and "1" is not).
2
Vrev \
\
0-----1
This expands as
2 * initial
\ / \ Vtrev[0] = 1
\ / \ Rtrev[0] = empty
a-----1
\ Vtrev[1] = Vtrev[0], 0, Rtrev[0]
\ = 1, 0 (at "*" and "a")
0-----*
Vtrev[k+1] = Vtrev[k], 0, Rtrev[k]
Rtrev[k+1] = Vtrev[k], 1, Rtrev[k]
The
R and V parts are the same on the left, but are to be taken in reverse.
The left side 0 to 2 is the same V shape as on the right (by symmetry), but
the points are in reverse.
=head2 Right and Left Turn Matching
=cut
{
# segments by direction
# A092236, A135254, A133474
# A057083 half term, offset from 3^k, A103312 similar
require Math::PlanePath::TerdragonCurve;
my $path = Math::PlanePath::TerdragonCurve->new;
my %count;
my %count_arrays;
my $n = 0;
my @dxdy_strs = List::Pairwise::mapp {"$a,$b"} $path->_UNDOCUMENTED__dxdy_list;
my $width = 36;
foreach my $k (12 .. 23) {
my $n_end = 3**$k * 0;
for ( ; $n < $n_end; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n);
$count{"$dx,$dy"}++;
}
# printf "k=%2d ", $k;
# foreach my $dxdy (@dxdy_strs) {
# my $a = $count{$dxdy} || 0;
# my $aref = ($count_arrays{$dxdy} ||= []);
# push @$aref, $a;
#
# my $ar = Math::BaseCnv::cnv($a,10,3);
# printf " %18s", $ar;
# }
# print "\n";
printf "k=%2d ", $k;
foreach my $dxdy (@dxdy_strs) {
my $a = _UNDOCUMENTED__level_to_segments_dxdy($path, $k, split(/,/, $dxdy));
my $ar = Math::BaseCnv::cnv($a,10,3);
printf " %*s", $width, $ar;
}
print "\n";
print " ";
foreach my $dxdy (@dxdy_strs) {
my $a = _UNDOCUMENTED__level_to_segments_dxdy_2($path, $k, split(/,/, $dxdy));
my $ar = Math::BaseCnv::cnv($a,10,3);
printf " %*s", $width, $ar;
}
print "\n";
print "\n";
}
my $trim = 1;
foreach my $dxdy (@dxdy_strs) {
my $aref = $count_arrays{$dxdy} || [];
splice @$aref, 0, $trim;
# @$aref = MyOEIS::first_differences(@$aref);
print "$dxdy\n";
print "is ", join(',',@$aref),"\n";
Math::OEIS::Grep->search (array => \@$aref, name => $dxdy);
}
sub _UNDOCUMENTED__level_to_segments_dxdy {
my ($self, $level, $dx,$dy) = @_;
my $a = 1;
my $b = 0;
my $c = 0;
for (1 .. $level) {
($a,$b,$c) = (2*$a + $c,
2*$b + $a,
2*$c + $b);
}
if ($dx == 2 && $dy == 0) {
return $a;
}
if ($dx == -1) {
if ($dy == 1) {
return $b;
}
if ($dy == -1) {
return $c;
}
}
return undef;
}
BEGIN {
my @dir3_to_offset = (0,8,4);
my @table = (2,1,1, 0,-1,-1, -2,-1,-1, 0,1,1);
sub _UNDOCUMENTED__level_to_segments_dxdy_2 {
my ($self, $level, $dx,$dy) = @_;
my $ret = _dxdy_to_dir3($dx,$dy);
if (! defined $ret) { return undef; }
$ret = $table[($dir3_to_offset[$ret] + $level) % 12];
$level -= 1;
if ($ret) {
$ret *= 3**int($level/2);
}
return 3**$level + $ret;
}
}
sub _dxdy_to_dir3 {
my ($dx,$dy) = @_;
if ($dx == 2 && $dy == 0) {
return 0;
}
if ($dx == -1) {
if ($dy == 1) {
return 1;
}
if ($dy == -1) {
return 2;
}
}
return undef;
}
# print "\n";
# foreach my $k (0 .. $#a) {
# my $h = int($k/2);
# printf "%3d,", $d[$k];
# }
# print "\n";
exit 0;
}
{
# left boundary N
# left_boundary_n_pred(14);
# ### exit 0
my $path = Math::PlanePath::TerdragonCurve->new;
my %non_values;
my %n_values;
my @n_values;
my @values;
foreach my $k (4){
print "k=$k\n";
my $n_limit = 2*3**$k;
foreach my $n (0 .. $n_limit-1) {
$non_values{$n} = 1;
}
my $points = MyOEIS::path_boundary_points ($path, $n_limit,
lattice_type => 'triangular',
side => 'left',
);
@$points = reverse @$points; # for left
### $points
for (my $i = 0; $i+1 <= $#$points; $i++) {
my ($x,$y) = @{$points->[$i]};
my ($x2,$y2) = @{$points->[$i+1]};
# my @n_list = $path->xy_to_n_list($x,$y);
my @n_list = path_xyxy_to_n($path, $x,$y, $x2,$y2);
foreach my $n (@n_list) {
delete $non_values{$n};
if ($n <= $n_limit) { $n_values{$n} = 1; }
my $n3 = Math::BaseCnv::cnv($n,10,3);
my $pred = $path->_UNDOCUMENTED__n_segment_is_left_boundary($n);
my $diff = $pred ? '' : ' ***';
if ($k <= 4) { print "$n $n3$diff\n"; }
}
}
@n_values = keys %n_values;
@n_values = sort {$a<=>$b} @n_values;
my @non_values = keys %non_values;
@non_values = sort {$a<=>$b} @non_values;
my $count = scalar(@n_values);
print "count $count\n";
# push @values, $count;
@values = @n_values;
if ($k <= 4) {
foreach my $n (@non_values) {
my $pred = $path->_UNDOCUMENTED__n_segment_is_left_boundary($n);
my $diff = $pred ? ' ***' : '';
my $n3 = Math::BaseCnv::cnv($n,10,3);
print "non $n $n3$diff\n";
}
}
# @values = @non_values;
print "func ";
foreach my $i (0 .. $count-1) {
my $n = $path->_UNDOCUMENTED__left_boundary_i_to_n($i);
my $n3 = Math::BaseCnv::cnv($n,10,3);
print "$n,";
}
print "\n";
print "vals ";
foreach my $i (0 .. $count-1) {
my $n = $values[$i];
my $n3 = Math::BaseCnv::cnv($n,10,3);
print "$n3,";
}
print "\n";
}
# @values = MyOEIS::first_differences(@values);
# shift @values;
# shift @values;
# shift @values;
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# right boundary N
# $path->_UNDOCUMENTED__n_segment_is_right_boundary(14);
# ### exit 0
my $path = Math::PlanePath::TerdragonCurve->new;
my %non_values;
my %n_values;
my @n_values;
my @values;
foreach my $k (4){
print "k=$k\n";
my $n_limit = 3**$k;
foreach my $n (0 .. $n_limit-1) {
$non_values{$n} = 1;
}
my $points = MyOEIS::path_boundary_points ($path, $n_limit,
lattice_type => 'triangular',
side => 'right',
);
# $points = points_2of3($points);
for (my $i = 0; $i+1 <= $#$points; $i++) {
my ($x,$y) = @{$points->[$i]};
my ($x2,$y2) = @{$points->[$i+1]};
# my @n_list = $path->xy_to_n_list($x,$y);
my @n_list = path_xyxy_to_n($path, $x,$y, $x2,$y2);
foreach my $n (@n_list) {
delete $non_values{$n};
if ($n <= $n_limit) { $n_values{$n} = 1; }
my $n3 = Math::BaseCnv::cnv($n,10,3);
my $pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n);
my $diff = $pred ? '' : ' ***';
if ($k <= 4) { print "$n $n3$diff\n"; }
}
}
@n_values = keys %n_values;
@n_values = sort {$a<=>$b} @n_values;
my @non_values = keys %non_values;
@non_values = sort {$a<=>$b} @non_values;
my $count = scalar(@n_values);
print "count $count\n";
# push @values, $count;
@values = @n_values;
if ($k <= 4) {
foreach my $n (@non_values) {
my $pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n);
my $diff = $pred ? ' ***' : '';
my $n3 = Math::BaseCnv::cnv($n,10,3);
print "non $n $n3$diff\n";
}
}
# @values = @non_values;
print "func ";
foreach my $i (0 .. $count-1) {
my $n = $path->_UNDOCUMENTED__right_boundary_i_to_n($i);
my $n3 = Math::BaseCnv::cnv($n,10,3);
print "$n3,";
}
print "\n";
print "vals ";
foreach my $i (0 .. $count-1) {
my $n = $values[$i];
my $n3 = Math::BaseCnv::cnv($n,10,3);
print "$n,";
}
print "\n";
}
# @values = MyOEIS::first_differences(@values);
# shift @values;
# shift @values;
# shift @values;
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
exit 0;
sub path_xyxy_to_n {
my ($path, $x1,$y1, $x2,$y2) = @_;
### path_xyxy_to_n(): "$x1,$y1, $x2,$y2"
my @n_list = $path->xy_to_n_list($x1,$y1);
### @n_list
my $arms = $path->arms_count;
foreach my $n (@n_list) {
my ($x,$y) = $path->n_to_xy($n + $arms);
if ($x == $x2 && $y == $y2) {
return $n;
}
}
return;
}
}
{
=head2 Boundary Straight 2s
1 x straight
Right
j=2 010 left j == 2 mod 8
j=3 11 straight i == 3 mod 12
j= 1100 straight trailing 0s >= 2
j= 1101 left
2 x straight
Right
i=9 j=6 110
i=10 j=7 111
even ...110 so j == 6 mod 8
odd ...111 i == 9 mod 12
i=21 +12
i=22 +12
Left
odd even
N and N+1 both bit-above-low-1 = 1 both straight
2m-1 2m
odd must be ...11
odd+1 x100
must be ...1100
so odd 1011 is 11 mod 16
=cut
# A083575 length=1
# 2^(k-2) - 1 length=2
# 2^(k-3) length=3
#
# 3*2^(k-1) - 2*(2^(k-2) - 1) - 3*2^(k-3)
# = 12*2^(k-3) - 4*2^(k-3) + 1 - 3*2^(k-3)
# = 5*2^(k-3) + 1
#
require Math::NumSeq::PlanePathTurn;
my $path = Math::PlanePath::TerdragonCurve->new;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath_object => $path,
turn_type => 'LSR');
my @values;
foreach my $k (1 .. 12) {
print "k=$k\n";
my $points = MyOEIS::path_boundary_points ($path, 3**$k,
lattice_type => 'triangular',
side => 'right',
);
my $run = 0;
my @count = (0,0,0);
for (my $i = 0; $i+2 <= $#$points; $i++) {
my $tturn6 = points_to_tturn6($points->[$i], $points->[$i+1], $points->[$i+2]);
if ($tturn6 == 0) {
$run++;
} else {
$count[$run]++;
$run = 0;
}
}
print "$count[0] $count[1] $count[2]\n";
push @values, $count[0];
}
shift @values;
shift @values;
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
=head2 Boundary Isolated Triangles
When the boundary visits a point twice it does so by enclosing a single unit
triangle. This is seen for example in the turn sequence diagram above where
turns 5 and 8 are at the same point and the turns go -1, 1, 1, -1 to enclose
a single unit triangle.
\ 7 Rt(7)=1
\ / \
\8/ \
*-----6 Rt(6)=1
\5 Rt(5)=-1
\
\
* *
/ \ / \
/ \ / \
\ *-----*-----*
\ / \ / \
\ / \ / \
* *-----*
\
\
\
=cut
{
# shortcut boundary length = 2^k area = 2*3^(k-1)
#
# *-----*
# \
# \
# *-----*
#
my $path = Math::PlanePath::TerdragonCurve->new;
my @values;
foreach my $k (1 .. 7) {
print "k=$k\n";
my $points = MyOEIS::path_boundary_points ($path, 3**$k,
lattice_type => 'triangular',
# side => 'right',
);
$points = points_2of3($points);
# points_shortcut_triangular($points);
if (@$points < 10) {
print join(" ", map{"$_->[0],$_->[1]"} @$points),"\n";
}
my $length = scalar(@$points) - 0;
require Math::Geometry::Planar;
my $polygon = Math::Geometry::Planar->new;
$polygon->points($points);
my $area = $polygon->area;
print " shortcut boundary $length area $area\n";
push @values, $area;
}
Math::OEIS::Grep->search(array => \@values);
exit 0;
sub points_2of3 {
my ($points) = @_;
my @ret;
foreach my $i (0 .. $#$points) {
if ($i % 3 != 2) { push @ret, $points->[$i]; }
}
return \@ret;
}
sub points_shortcut_triangular {
my ($points) = @_;
my $print = (@$points < 20);
my $i = 0;
while ($i+2 <= $#$points) {
my $tturn6 = points_to_tturn6($points->[$i], $points->[$i+1], $points->[$i+2]);
if ($tturn6 == 4) {
splice @$points, $i+1, 1;
if ($print) { print " delete point ",$i+1,"\n"; }
} else {
if ($print) { print " keep point ",$i+1,"\n"; }
$i++;
}
# my $p1 = $points->[$i];
# my $p2 = $points->[$i+2];
# if (abs($p1->[0] - $p2->[0]) + abs($p1->[1] - $p2->[1]) == 2) {
# splice @$points, $i+1, 1;
# if ($print) { print " delete point ",$i+1,"\n"; }
# } else {
# if ($print) { print " keep point ",$i+1,"\n"; }
# $i++;
# }
}
}
}
{
# shortcut turn sequence, is dragon turn sequence by 60 degrees
#
my $path = Math::PlanePath::TerdragonCurve->new;
my @values;
foreach my $k (1 .. 7) {
print "k=$k\n";
my $points = MyOEIS::path_boundary_points ($path, 3**$k,
lattice_type => 'triangular',
side => 'right',
);
points_shortcut_triangular($points);
for (my $i = 0; $i+2 <= $#$points; $i++) {
my $tturn6 = points_to_tturn6($points->[$i], $points->[$i+1], $points->[$i+2]);
print "$tturn6";
if ($k == 5) {
push @values, ($tturn6 == 1 ? 1 : $tturn6 == 5 ? -1 : die);
}
}
print "\n";
}
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
{
# boundary turn sequence
# 26----27 0 to 8 2 4 2 0 4
# \ 9 to 26 2 2 4 0 0 4
# \ 27 2 2 4 2 0 4 0 2 4 0 0 4
# 22 81 2 2 4 2 0 4 2 2 4 0 0 4 0 2 4 2 0 4 0 2 4 0 0 4
# \ 2 2 4 2 0 4 2 2 4 0 0 4 2 2 4 2 0 4 0 2 4 0 0 4 0 2 4 2 0 4 2 2 4 0 0 4 0 2 4 2 0 4 0 2 4 0 0 4
# \
# 12 10
# / \ / \
# / \ / \
# 18 13-----8-----9 Rlen = 1, 3*2^(k-1)
# \ / \ / \ V Vlen = 2, 3*2^(k-1)
# \ / \ / \
# 17 6----7,4 R -> R,2,V R[1] = 2,4
# \ / \ R V -> R,0,V V[1] = 0,4
# \ / \
# 5,2----3 R[2] = 2,4 2 0,4
# \ V V[2] = 2,4 0 0,4
# \
# 0-----1 bit above lowest 1 like dragon
# R
#
# R[k+1]
my $side = 'left';
my (@R, @V);
if ($side eq 'right') {
@R = ('');
@V = ('4');
} else {
@R = ('');
@V = ('2');
}
# 2 4 0 0 turn = ternary lowest non-zero 1=left 2=right
# 2 0 4 1 1
# 2 2 4 10 2
# 0 0 4 11 10
# 2 2 4 100 11
# 2 0 4 101 12
# 0 2 4 110 20
# 0 0 4 111 21
# 2 2 4 1000 22
# 2 0 4 100
# 2 2 4 101
# 0 0 4 102
# 0 2 4 110
# 2 0 4 111
# 0 2 4 112
# 0 0 4 120
# 2 2 4 121
# 2 0 4 122
# 2 2 4 200
# 0 0 4 201
# 2 2 4
# 2 0 4
# 0 2 4
# 0 0 4
# 0 2 4
# 2 0 4
# 2 2 4
# 0 0 4
# 0 2 4
# 2 0 4
# 0 2 4
# 0 0 4
sub Tt_to_tturn6 {
if ($side eq 'right') {
goto &Rt_to_tturn6;
} else {
goto &Lt_to_tturn6;
}
}
sub Rt_to_tturn6 {
my ($i) = @_;
{
if ($i % 3 == 2) { return 4; }
my $j = $i - int($i/3);
return (bit_above_lowest_zero($j) ? 0 : 2);
}
{
my $mod = _divrem_mutate($i, 3);
if ($mod == 2) { return 4; }
if ($mod == 1) { return ($i % 2 ? 0 : 2); }
do {
$mod = _divrem_mutate($i, 2);
} while ($mod == 0);
$mod = _divrem_mutate($i, 2);
return ($mod % 2 ? 0 : 2);
}
}
# i=0
# i=1 2
# i=2 j=1
# i=3 j=2
# i=4 2
# i=5 j=3
# i=6 j=4
# i=7 2
# i=8 j=5
# i=9 j=6
sub Lt_to_tturn6 {
my ($i) = @_;
{
if ($i % 3 == 1) { return 2; }
my $j = $i - int(($i+1)/3);
# print "i=$i j=$j\n";
return (bit_above_lowest_one($j) ? 4 : 0);
}
}
sub bit_above_lowest_one {
my ($n) = @_;
for (;;) {
if (! $n || ($n % 2) != 0) {
last;
}
$n = int($n/2);
}
$n = int($n/2);
return ($n % 2);
}
sub bit_above_lowest_zero {
my ($n) = @_;
for (;;) {
if (($n % 2) == 0) {
last;
}
$n = int($n/2);
}
$n = int($n/2);
return ($n % 2);
}
my @dir6_to_dx = (2, 1,-1,-2, -1, 1);
my @dir6_to_dy = (0, 1, 1, 0, -1,-1);
my $path = Math::PlanePath::TerdragonCurve->new;
require Math::NumSeq::PlanePathTurn;
require Math::NumSeq::PlanePathDelta;
foreach my $k (1 .. 7) {
print "k=$k\n";
if ($side eq 'right') {
$R[$k] = $R[$k-1] . '2' . $V[$k-1];
$V[$k] = $R[$k-1] . '0' . $V[$k-1];
} else {
$V[$k] = $V[$k-1] . '0' . $R[$k-1];
$R[$k] = $V[$k-1] . '4' . $R[$k-1];
}
my $n_limit = ($side eq 'right' ? 3**$k : 2*3**$k);
my $points = MyOEIS::path_boundary_points ($path, $n_limit,
lattice_type => 'triangular',
side => $side);
if ($side eq 'left') {
@$points = reverse @$points;
}
if (@$points < 20) {
print "points";
foreach my $p (@$points) {
print " $p->[0],$p->[1]";
}
print "\n";
}
my @values;
foreach my $i (1 .. $#$points - 1) {
my $tturn6 = points_to_tturn6($points->[$i-1], $points->[$i], $points->[$i+1]);
# if ($tturn6 > 3) { $tturn6 -= 6; }
# my $dir6 = Math::NumSeq::PlanePathDelta::_delta_func_TDir6($dx,$dy);
# if ($dir6 > 3) { $dir6 -= 6; }
push @values, $tturn6;
}
# {
# my @new_values;
# for (my $i = 2; $i <= $#values; $i += 3) {
# push @new_values, $values[$i] / 2;
# }
# @values = @new_values;
# }
Math::OEIS::Grep->search(array => \@values);
my $v = join('',@values);
print "p $v\n";
if ($side eq 'right') {
print "R $R[$k]\n";
if ($v ne $R[$k]) {
print " wrong\n";
}
} else {
print "V $V[$k]\n";
if ($v ne $V[$k]) {
print " wrong\n";
}
}
my $f = join('', map {Tt_to_tturn6($_)} 1 .. scalar(@values));
print "f $f\n";
if ($v ne $f) {
print " wrong\n";
}
}
foreach my $i (1 .. 18) {
my $tturn6 = Tt_to_tturn6($i);
my $pn = ($tturn6 == 2 ? 1 : $tturn6 == 0 ? 0 : $tturn6 == 4 ? -1 : die);
print "$pn, ";
}
print "\n";
exit 0;
sub points_to_tturn6 {
my ($p1,$p2,$p3) = @_;
my ($x1,$y1) = @$p1;
my ($x2,$y2) = @$p2;
my ($x3,$y3) = @$p3;
my $dx = $x2-$x1;
my $dy = $y2-$y1;
my $next_dx = $x3-$x2;
my $next_dy = $y3-$y2;
require Math::NumSeq::PlanePathTurn;
return Math::NumSeq::PlanePathTurn::_turn_func_TTurn6($dx,$dy, $next_dx,$next_dy);
}
}
{
# dRadius range
my $n = 118088;
require Math::PlanePath::TerdragonMidpoint;
my $path = Math::PlanePath::TerdragonMidpoint->new;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
print "$x1,$y1 $x2,$y2\n";
exit 0;
}
{
# A+Yw A=X-Y
require Math::BaseCnv;
my $path = Math::PlanePath::TerdragonCurve->new;
my $dx_min = 0;
my $dx_max = 0;
foreach my $n (1 .. 3**10) {
my ($dx,$dy) = $path->n_to_dxdy($n);
if ($dx == 299) {
my $n3 = Math::BaseCnv::cnv($n,10,3);
printf "%3d %s\n", $n, $n3;
}
$dx_min = min($dx_min,$dx);
$dx_max = max($dx_max,$dx);
}
print "$dx_min $dx_max\n";
exit 0;
}
{
# A+Yw A=X-Y
require Math::BaseCnv;
my $path = Math::PlanePath::TerdragonCurve->new;
my @values;
foreach my $n (1 .. 3**6) {
my ($x,$y) = $path->n_to_xy($n);
my @n_list = $path->xy_to_n_list($x,$y);
if (@n_list == 1) {
push @values, $n;
}
if (@n_list == 1 && $n == $n_list[0]) {
my $n3 = Math::BaseCnv::cnv($n,10,3);
printf "%3d %s\n", $n, $n3;
}
}
print join(',',@values),"\n";
Math::OEIS::Grep->search(array=>\@values);
exit 0;
}
{
# A+Yw A=X-Y
my $path = Math::PlanePath::TerdragonCurve->new;
my @values;
foreach my $n (1 .. 20) {
my ($x,$y) = $path->n_to_xy($n);
push @values, ($x-$y);
}
Math::OEIS::Grep->search(array=>\@values);
exit 0;
}
{
# TerdragonCurve direction away from a point
require Image::Base::Text;
my $arms = 6;
my $path = Math::PlanePath::TerdragonCurve->new (arms => $arms);
my $width = 78;
my $height = 40;
my $x_lo = -$width/2;
my $y_lo = -$height/2;
my $x_hi = $x_lo + $width - 1;
my $y_hi = $y_lo + $height - 1;
my $image = Image::Base::Text->new (-width => $width,
-height => $height);
my $plot = sub {
my ($x,$y,$char) = @_;
$x -= $x_lo;
$y -= $y_lo;
return if $x < 0 || $y < 0 || $x >= $width || $y >= $height;
$image->xy ($x,$height-1-$y,$char);
};
my ($n_lo, $n_hi) = $path->rect_to_n_range($x_lo-2,$y_lo-2, $x_hi+2,$y_hi+2);
print "n_hi $n_hi\n";
for my $n (0 .. $n_hi) {
my $arm = $n % $arms;
my ($x,$y) = $path->n_to_xy($n);
next if $x < $x_lo || $y < $y_lo || $x > $x_hi || $y > $y_hi;
my ($nx,$ny) = $path->n_to_xy($n + $arms);
my $dir = dxdy_to_dir6($nx-$x,$ny-$y);
if ($dir == 2) {
$plot->($x, $y, $dir);
}
}
$plot->(0,0, '+');
$image->save('/dev/stdout');
exit 0;
}
{
# TerdragonCurve xy_to_n offsets to Midpoint
require Math::PlanePath::TerdragonMidpoint;
my $arms = 6;
my $curve = Math::PlanePath::TerdragonCurve->new (arms => $arms);
my $midpoint = Math::PlanePath::TerdragonMidpoint->new (arms => $arms);
my %seen;
for my $n (0 .. 1000) {
my ($x,$y) = $curve->n_to_xy($n);
$x *= 2;
$y *= 2;
for my $dx (-2 .. 2) {
for my $dy (-1 .. 1) {
my $m = $midpoint->xy_to_n($x+$dx,$y+$dy) // next;
if ($m == $n) {
$seen{"$dx,$dy"} = 1;
}
}
}
}
### %seen
exit 0;
}
{
# TerdragonCurve xy cf Midpoint
require Image::Base::Text;
require Math::PlanePath::TerdragonMidpoint;
my $arms = 6;
my $curve = Math::PlanePath::TerdragonCurve->new (arms => $arms);
my $midpoint = Math::PlanePath::TerdragonMidpoint->new (arms => $arms);
my $width = 50;
my $height = 30;
my $x_lo = -$width/2;
my $y_lo = -$height/2;
my $x_hi = $x_lo + $width - 1;
my $y_hi = $y_lo + $height - 1;
my $image = Image::Base::Text->new (-width => $width,
-height => $height);
my $plot = sub {
my ($x,$y,$char) = @_;
$x -= $x_lo;
$y -= $y_lo;
return if $x < 0 || $y < 0 || $x >= $width || $y >= $height;
$image->xy ($x,$height-1-$y,$char);
};
my ($n_lo, $n_hi) = $curve->rect_to_n_range($x_lo-2,$y_lo-2, $x_hi+2,$y_hi+2);
print "n_hi $n_hi\n";
for my $y ($y_lo .. $y_hi) {
for my $x ($x_lo .. $x_hi) {
my $n = $curve->xy_to_n($x,$y) // next;
my $arm = $n % $arms;
my ($nx,$ny) = $curve->n_to_xy($n + $arms);
my $dir = dxdy_to_dir6($nx-$x,$ny-$y);
$plot->($x, $y, $dir);
}
}
$plot->(0,0, '+');
$image->save('/dev/stdout');
exit 0;
}
{
# TerdragonMidpoint xy absolute direction
require Image::Base::Text;
require Math::PlanePath::TerdragonMidpoint;
my $arms = 6;
my $path = Math::PlanePath::TerdragonMidpoint->new (arms => $arms);
my $width = 50;
my $height = 30;
my $x_lo = -$width/2;
my $y_lo = -$height/2;
my $x_hi = $x_lo + $width - 1;
my $y_hi = $y_lo + $height - 1;
my $image = Image::Base::Text->new (-width => $width,
-height => $height);
my $plot = sub {
my ($x,$y,$char) = @_;
$x -= $x_lo;
$y -= $y_lo;
return if $x < 0 || $y < 0 || $x >= $width || $y >= $height;
$image->xy ($x,$height-1-$y,$char);
};
my ($n_lo, $n_hi) = $path->rect_to_n_range($x_lo-2,$y_lo-2, $x_hi+2,$y_hi+2);
print "n_hi $n_hi\n";
for my $n (0 .. $n_hi) {
my $arm = $n % $arms;
my ($x,$y) = $path->n_to_xy($n);
# if (($n % $arms) == 1) {
# $x += 1;
# $y += 1;
# }
next if $x < $x_lo || $y < $y_lo || $x > $x_hi || $y > $y_hi;
my ($nx,$ny) = $path->n_to_xy($n + $arms);
# if (($n % $arms) == 1) {
# $nx += 1;
# $ny += 1;
# }
# if ($nx == $x+1) {
# $image->xy($x,$y,$n&3);
# }
# if ($ny == $y+1) {
# $image->xy($x,$y,$n&3);
# }
# if ($ny == $y) {
# }
my $show;
my $dir = dxdy_to_dir6($nx-$x,$ny-$y);
my $digit = (($x + 3*$y) + 0) % 3;
my $d9 = ((2*$x + $y) + 0) % 9;
my $c = ($x+$y)/2;
my $flow = sprintf "%X", ($x + 3*$y) % 12;
my $prev_dir = -1;
if ($n >= $arms) {
my ($px,$py) = $path->n_to_xy($n - $arms);
$prev_dir = dxdy_to_dir6($x-$px,$y-$py);
}
foreach my $r (0,1,2) {
$flow = ($r == 0 ? '-'
: $r == 1 ? '/'
: '\\');
if ($arm & 1) {
if (($digit == 0 || $digit == 1)
&& (($dir%3) == $r)) {
$show = $flow;
}
if (($digit == 2)
&& (($prev_dir%3) == $r)) {
$show = $flow;
}
} else {
if (($digit == 0 || $digit == 2)
&& (($dir%3) == $r)) {
$show = $flow;
}
if (($digit == 1)
&& (($prev_dir%3) == $r)) {
$show = $flow;
}
}
}
if (! defined $show) {
$show = '.';
}
# if ($digit == 1) {
# if ($dir == 0 || $dir == 3) {
# $show = $dir;
# $show = 'x';
# }
# }
# if ($digit == 2) {
# if ($dir == 0 || $dir == 3) {
# $show = $prev_dir;
# $show = 'x';
# }
# }
# if ($digit == 0) {
# $show = 'x';
# }
my $mod = (int($n/$arms) % 3);
# if (($arm == 0 && $mod == 0)
# || ($arm == 1 && $mod == 2)
# || ($arm == 2 && $mod == 0)
# || ($arm == 3 && $mod == 2)
# || ($arm == 4 && $mod == 0)
# || ($arm == 5 && $mod == 2)) {
# # $show = '0';
# # $show = $digit;
# if ($n < 3*$arms) {
# print "n=$n $x,$y mod=$mod\n";
# }
# }
# if (($arm == 0 && $mod == 1)
# || ($arm == 1 && $mod == 1)
# || ($arm == 2 && $mod == 1)
# || ($arm == 3 && $mod == 1)
# || ($arm == 4 && $mod == 1)
# || ($arm == 5 && $mod == 1)) {
# # $show = '1';
# }
# if (($arm == 0 && $mod == 2)
# || ($arm == 1 && $mod == 0)
# || ($arm == 2 && $mod == 2)
# || ($arm == 3 && $mod == 0)
# || ($arm == 4 && $mod == 2)
# || ($arm == 5 && $mod == 0)) {
# # $show = '2';
# }
if (defined $show) {
$plot->($x, $y, $show);
}
# if ($dir == 0) {
# $image->xy($x-$x_lo,$y-$y_lo, $dir);
# }
}
# $plot->(0,0, '+');
$image->save('/dev/stdout');
exit 0;
}
{
require Math::PlanePath::TerdragonMidpoint;
my $path = Math::PlanePath::TerdragonMidpoint->new;
$path->xy_to_n(5,3);
exit 0;
}
{
# TerdragonMidpoint modulo
require Math::PlanePath::TerdragonMidpoint;
my $arms = 2;
my $path = Math::PlanePath::TerdragonMidpoint->new (arms => $arms);
for my $n (0 .. 3**4) {
my $arm = $n % $arms;
my $mod = (int($n/$arms) % 3);
my ($x,$y) = $path->n_to_xy($n);
my $digit = (($x + 3*$y) + 0) % 3;
print "n=$n $x,$y mod=$mod k=$digit\n";
}
exit 0;
}
{
# cumulative turn +/- 1 list
require Math::BaseCnv;
my $path = Math::PlanePath::TerdragonCurve->new;
my $cumulative = 0;
for (my $n = $path->n_start + 1; $n < 35; $n++) {
my $n3 = Math::BaseCnv::cnv($n,10,3);
my $turn = calc_n_turn ($n);
# my $turn = path_n_turn($path, $n);
if ($turn == 2) { $turn = -1 }
$cumulative += $turn;
printf "%3s %4s %d\n", $n, $n3, $cumulative;
}
print "\n";
exit 0;
}
{
# cumulative turn +/- 1
my $path = Math::PlanePath::TerdragonCurve->new;
my $cumulative = 0;
my $max = 0;
my $min = 0;
for (my $n = $path->n_start + 1; $n < 35; $n++) {
my $turn = calc_n_turn ($n);
# my $turn = path_n_turn($path, $n);
if ($turn == 2) { $turn = -1 }
$cumulative += $turn;
$max = max($cumulative,$max);
$min = min($cumulative,$min);
print "$cumulative,";
}
print "\n";
print "min $min max $max\n";
exit 0;
sub calc_n_turn {
my ($n) = @_;
die if $n == 0;
while (($n % 3) == 0) {
$n = int($n/3); # skip low 0s
}
return ($n % 3); # next digit is the turn
}
}
{
# turn
my $path = Math::PlanePath::TerdragonCurve->new;
my $n = $path->n_start;
# my ($n0_x, $n0_y) = $path->n_to_xy ($n);
# $n++;
# my ($prev_x, $prev_y) = $path->n_to_xy ($n);
# my ($prev_dx, $prev_dy) = ($prev_x - $n0_x, $prev_y - $n0_y);
# my $prev_dir = dxdy_to_dir ($prev_dx, $prev_dy);
$n++;
my $pow = 3;
for ( ; $n < 128; $n++) {
# my ($x, $y) = $path->n_to_xy ($n);
# my $dx = $x - $prev_x;
# my $dy = $y - $prev_y;
# my $dir = dxdy_to_dir ($dx, $dy);
# my $turn = ($dir - $prev_dir) % 3;
#
# $prev_dir = $dir;
# ($prev_x,$prev_y) = ($x,$y);
my $turn = path_n_turn($path, $n);
my $azeros = digit_above_low_zeros($n);
my $azx = ($azeros == $turn ? '' : '*');
# my $aones = digit_above_low_ones($n-1);
# if ($aones==0) { $aones=1 }
# elsif ($aones==1) { $aones=0 }
# elsif ($aones==2) { $aones=2 }
# my $aox = ($aones == $turn ? '' : '*');
#
# my $atwos = digit_above_low_twos($n-2);
# if ($atwos==0) { $atwos=1 }
# elsif ($atwos==1) { $atwos=2 }
# elsif ($atwos==2) { $atwos=0 }
# my $atx = ($atwos == $turn ? '' : '*');
#
# my $lzero = digit_above_low_zeros($n);
# my $lone = digit_above_lowest_one($n);
# my $ltwo = digit_above_lowest_two($n);
# print "$n $turn ones $aones$aox twos $atwos$atx zeros $azeros${azx}[$lzero] $lone $ltwo\n";
print "$n $turn zeros got=$azeros ${azx}\n";
}
print "\n";
exit 0;
sub digit_above_low_zeros {
my ($n) = @_;
if ($n == 0) {
return 0;
}
while (($n % 3) == 0) {
$n = int($n/3);
}
return ($n % 3);
}
sub path_n_turn {
my ($path, $n) = @_;
my $prev_dir = path_n_dir ($path, $n-1);
my $dir = path_n_dir ($path, $n);
return ($dir - $prev_dir) % 3;
}
sub path_n_dir {
my ($path, $n) = @_;
my ($prev_x, $prev_y) = $path->n_to_xy ($n);
my ($x, $y) = $path->n_to_xy ($n+1);
return dxdy_to_dir($x - $prev_x, $y - $prev_y);
}
}
{
# min/max for level
require Math::BaseCnv;
my $path = Math::PlanePath::TerdragonCurve->new;
my $prev_min = 1;
my $prev_max = 1;
for (my $level = 1; $level < 25; $level++) {
my $n_start = 3**($level-1);
my $n_end = 3**$level;
my $min_hypot = 128*$n_end*$n_end;
my $min_x = 0;
my $min_y = 0;
my $min_pos = '';
my $max_hypot = 0;
my $max_x = 0;
my $max_y = 0;
my $max_pos = '';
print "level $level n=$n_start .. $n_end\n";
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
my $h = $x*$x + 3*$y*$y;
if ($h < $min_hypot) {
$min_hypot = $h;
$min_pos = "$x,$y";
}
if ($h > $max_hypot) {
$max_hypot = $h;
$max_pos = "$x,$y";
}
}
# print " min $min_hypot at $min_x,$min_y\n";
# print " max $max_hypot at $max_x,$max_y\n";
{
my $factor = $min_hypot / $prev_min;
my $min_hypot3 = Math::BaseCnv::cnv($min_hypot,10,3);
print " min h= $min_hypot [$min_hypot3] at $min_pos factor $factor\n";
my $calc = (4/3/3) * 2.9**$level;
print " cf $calc\n";
}
# {
# my $factor = $max_hypot / $prev_max;
# my $max_hypot3 = Math::BaseCnv::cnv($max_hypot,10,3);
# print " max h= $max_hypot [$max_hypot3] at $max_pos factor $factor\n";
# # my $calc = 4 * 3**($level*.9) * 4**($level*.1);
# # print " cf $calc\n";
# }
$prev_min = $min_hypot;
$prev_max = $max_hypot;
}
exit 0;
}
{
# turn
my $path = Math::PlanePath::TerdragonCurve->new;
my $n = $path->n_start;
my ($n0_x, $n0_y) = $path->n_to_xy ($n);
$n++;
my ($prev_x, $prev_y) = $path->n_to_xy ($n);
my ($prev_dx, $prev_dy) = ($prev_x - $n0_x, $prev_y - $n0_y);
my $prev_dir = dxdy_to_dir ($prev_dx, $prev_dy);
$n++;
my $pow = 3;
for ( ; $n < 128; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
my $dx = ($x - $prev_x);
my $dy = ($y - $prev_y);
my $dir = dxdy_to_dir ($dx, $dy);
my $turn = ($dir - $prev_dir) % 3;
$prev_dir = $dir;
($prev_x,$prev_y) = ($x,$y);
print "$turn";
if ($n-1 == $pow) {
$pow *= 3;
print "\n";
}
}
print "\n";
exit 0;
}
sub path_to_dir6 {
my ($path,$n) = @_;
my ($x,$y) = $path->n_to_xy($n);
my ($nx,$ny) = $path->n_to_xy($n + $path->arms_count);
return dxdy_to_dir6($nx-$x,$ny-$y);
}
sub dxdy_to_dir6 {
my ($dx,$dy) = @_;
if ($dy == 0) {
if ($dx == 2) { return 0; }
if ($dx == -2) { return 3; }
}
if ($dy == 1) {
if ($dx == 1) { return 1; }
if ($dx == -1) { return 2; }
}
if ($dy == -1) {
if ($dx == 1) { return 5; }
if ($dx == -1) { return 4; }
}
die "unrecognised $dx,$dy";
}
# per KochCurve.t
sub dxdy_to_dir {
my ($dx,$dy) = @_;
if ($dy == 0) {
if ($dx == 2) { return 0/2; }
# if ($dx == -2) { return 3; }
}
if ($dy == 1) {
# if ($dx == 1) { return 1; }
if ($dx == -1) { return 2/2; }
}
if ($dy == -1) {
# if ($dx == 1) { return 5; }
if ($dx == -1) { return 4/2; }
}
die "unrecognised $dx,$dy";
}
sub digit_above_low_ones {
my ($n) = @_;
if ($n == 0) {
return 0;
}
while (($n % 3) == 1) {
$n = int($n/3);
}
return ($n % 3);
}
sub digit_above_low_twos {
my ($n) = @_;
if ($n == 0) {
return 0;
}
while (($n % 3) == 2) {
$n = int($n/3);
}
return ($n % 3);
}
sub digit_above_lowest_zero {
my ($n) = @_;
for (;;) {
if (($n % 3) == 0) {
last;
}
$n = int($n/3);
}
$n = int($n/3);
return ($n % 3);
}
sub digit_above_lowest_one {
my ($n) = @_;
for (;;) {
if (! $n || ($n % 3) != 0) {
last;
}
$n = int($n/3);
}
$n = int($n/3);
return ($n % 3);
}
sub digit_above_lowest_two {
my ($n) = @_;
for (;;) {
if (! $n || ($n % 3) != 0) {
last;
}
$n = int($n/3);
}
$n = int($n/3);
return ($n % 3);
}
Math-PlanePath-122/devel/cellular-rule-oeis.pl 0000644 0001750 0001750 00000004406 12611264071 017044 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use HTML::Entities::Interpolate;
use List::Util;
use URI::Escape;
use Tie::IxHash;
use Math::BigInt;
use Math::PlanePath::CellularRule;
# uncomment this to run the ### lines
#use Smart::Comments;
{
# greps
my %done;
tie %done, 'Tie::IxHash';
foreach my $rule (0 .. 255) {
my $path = Math::PlanePath::CellularRule->new(rule=>$rule);
my @values;
# {
# # 0/1 cells
# Y01: foreach my $y (0 .. 10) {
# foreach my $x (-$y .. $y) {
# if (defined ($path->xy_to_n($x,$y))) {
# push @values, 1;
# } else {
# push @values, 0;
# }
# last Y01 if (@values > 100);
# }
# }
# }
{
# bignum rows
my $base = 10; # 2 or 10
Y01: foreach my $y (0 .. 20) {
my $n = '';
foreach my $x (-$y .. $y) {
$n .= defined $path->xy_to_n($x,$y) ? '1' : '0';
}
$n =~ s/^0+//;
if ($n eq '') { $n = 0; }
if ($base == 10) {
Math::BigInt->new("0b$n");
}
push @values, $n;
}
}
my $values = join(',',@values);
$done{$values} .= ",$rule";
}
foreach my $values (keys %done) {
my $name = $done{$values};
$name =~ s/^,//;
$name = "rule=".$name;
print "$name\n";
print "values $values\n";
my @values = split /,/, $values;
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values,
name => $name,
verbose => 0,
);
}
exit 0;
}
Math-PlanePath-122/devel/sierpinski-triangle.pl 0000644 0001750 0001750 00000026727 12536646441 017347 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::SierpinskiTriangle;
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh',
'digit_join_lowtohigh';
# uncomment this to run the ### lines
# use Smart::Comments;
#
#
#
#
#
#
#
#
#
#
#
#
#
#
# 8 14
# 7 10 11 12 13
# 6 8 9
# 5 6 7
# 4 5
# 3 3 4
# 2 2
# 1 1
# 0 0
#
{
# number of children
my $path = Math::PlanePath::SierpinskiTriangle->new;
for (my $n = $path->n_start; $n < 180; $n++) {
my @n_children = $path->tree_n_children($n);
my $num_children = scalar(@n_children);
print "$num_children,";
print "\n" if path_tree_n_is_depth_end($path,$n);
}
print "\n";
exit 0;
sub path_tree_n_is_depth_end {
my ($path, $n) = @_;
my $depth = $path->tree_n_to_depth($n);
return defined($depth) && $n == $path->tree_depth_to_n_end($depth);
}
}
{
# Pascal's triangle as a graph
my $max_row = 4;
require Graph::Easy;
require Math::BigInt;
my $graph = Graph::Easy->new;
foreach my $row (0 .. $max_row) {
foreach my $col (0 .. $row) {
my $n = Math::BigInt->new($row)->bnok($col);
next unless $n % 2;
$graph->add_vertex("$row,$col=$n");
next if $row >= $max_row;
my $row2 = $row + 1;
foreach my $col2 ($col, $col+1) {
my $n2 = Math::BigInt->new($row2)->bnok($col2);
### consider: "$row2,$col2=$n2"
next unless $n2 % 2;
$graph->add_edge("$row,$col=$n", "$row2,$col2=$n2");
}
}
}
print $graph->as_ascii();
exit 0;
}
{
# 41 81
# 33 34 35 36 37 38 39 40 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 15
# 29 30 31 32 57 58 59 60 61 62 63 64 14
# 25 26 27 28 49 50 51 52 53 54 55 56 13
# 23 24 45 46 47 48 12
# 19 20 21 22 37 38 39 40 41 42 43 44 11
# 17 18 33 34 35 36 10
# 15 16 29 30 31 32 9
# 14 8 27 28
# 10 11 12 13 7 19 20 21 22 23 24 25 26
# 8 9 6 15 16 17 18
# 6 7 5 11 12 13 14
# 5 4 9 10
# 3 4 3 5 6 7 8
# 2 2 3 4
# 1 1 1 2
# 0 <- Y=0 0
#
# 0,1,2,3,3, 4,5,5
Math::PlanePath::SierpinskiTriangle::_n0_to_depthbits(81,'all');
my $parts = 'left';
foreach my $n (0 .. 41) {
my ($depthbits, $ndepth, $nwidth) = Math::PlanePath::SierpinskiTriangle::_n0_to_depthbits($n,$parts);
my $depth = digit_join_lowtohigh ($depthbits, 2);
print "n=$n depth= $depth ndepth= $ndepth\n";
}
exit 0;
}
{
# centroid
# X = 0 midpoint
# Y = (2^n - 2)/3
# I = (4*12^n-3^n)/3 * 24/9
# = 8/9 * (4*12^n-3^n)
# = 8/3 * 3^k * (4*4^k - 1)/3
my $path = Math::PlanePath::SierpinskiTriangle->new;
my @values;
foreach my $level (0 .. 7) {
my ($n_lo, $n_hi) = $path->level_to_n_range($level);
my $gx = 0;
my $gy = 0;
my $count = 0;
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
$gx += $x;
$gy += $y;
$count++;
}
$gx = to_bigrat($gx);
$gy = to_bigrat($gy);
$gx /= $count;
$gy /= $count;
my $I = 0;
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
$I += ($x - $gx)**2 + ($y - $gy)**2;
}
$I /= 3**$level;
push @values, $I*9/24;
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose => 1);
exit 0;
sub to_bigrat {
my ($n) = @_;
require Math::BigRat;
return Math::BigRat->new($n);
# return $n;
}
}
{
# Pascal's triangle
require Math::BigInt;
my @array;
my $rows = 10;
my $width = 0;
foreach my $y (0 .. $rows) {
foreach my $x (0 .. $y) {
my $n = Math::BigInt->new($y);
my $k = Math::BigInt->new($x);
$n->bnok($k);
my $str = "$n";
$array[$x][$y] = $str;
$width = max($width,length($str));
}
}
$width += 2;
if ($width & 1) { $width++; }
# $width |= 1;
foreach my $y (0 .. $rows) {
print ' ' x (($rows-$y) * int($width/2));
foreach my $x (0 .. $y) {
my $value = $array[$x][$y];
unless ($value & 1) { $value = ''; }
printf "%*s", $width, $value;
}
print "\n";
}
exit 0;
}
{
# NumSiblings run lengths
# lowest 1-bit of pos k
# NumChildren run lengths
# is same lowest 1-bit if NumChildren=0 leaf coalesced with NumChildren=1
my $path = Math::PlanePath::SierpinskiTriangle->new (align => 'diagonal');
require Math::NumSeq::PlanePathCoord;
my $seq = Math::NumSeq::PlanePathCoord->new (planepath_object => $path,
# coordinate_type => 'NumChildren',
coordinate_type => 'NumSiblings',
);
my $prev = 0;
my $run = 1;
for (my $n = $path->n_start+1; $n < 500; $n++) {
my ($i,$value) = $seq->next;
$value = 1-$value;
# if ($value == 1) { $value = 0; }
# if ($value == $prev) {
# $run++;
# } else {
# print "$run,";
# $run = 1;
# $prev = $value;
# }
# printf "%4b %d\n", $i, $value;
print "$value,";
}
print "\n";
exit 0;
sub path_tree_n_num_siblings {
my ($path, $n) = @_;
$n = $path->tree_n_parent($n);
return (defined $n
? $path->tree_n_num_children($n) - 1 # not including self
: 0); # any tree root considered to have no siblings
}
}
{
# height
use constant _INFINITY => do {
my $x = 999;
foreach (1 .. 20) {
$x *= $x;
}
$x;
};
my $path = Math::PlanePath::SierpinskiTriangle->new (align => 'diagonal');
require Math::NumSeq::PlanePathCoord;
my $seq = Math::NumSeq::PlanePathCoord->new (planepath_object => $path,
coordinate_type => 'SubHeight');
for (my $n = $path->n_start; $n < 500; $n++) {
my ($x,$y) = $path->n_to_xy($n);
my $s = $seq->ith($n);
# my $c = $path->_UNTESTED__NumSeq__tree_n_to_leaflen($n);
my $c = n_to_subheight($n);
if (! defined $c) { $c = _INFINITY; }
my $diff = ($s == $c ? '' : ' ***');
print "$x,$y $s $c$diff\n";
}
print "\n";
exit 0;
sub n_to_subheight {
my ($n) = @_;
# this one correct based on diagonal X,Y bits
my ($x,$y) = $path->n_to_xy($n);
if ($x == 0 || $y == 0) {
return _INFINITY();
}
my $mx = ($x ^ ($x-1)) >> 1;
my $my = ($y ^ ($y-1)) >> 1;
return max ($mx - ($y & $mx),
$my - ($x & $my));
# Must stretch out $n remainder to make X.
# my ($depthbits, $ndepth, $nwidth) = Math::PlanePath::SierpinskiTriangle::_n0_to_depthbits($n);
# $n -= $ndepth; # X
# my $y = digit_join_lowtohigh ($depthbits, 2, $n*0) - $n;
#
# if ($n == 0 || $y == 0) {
# return undef;
# }
# my $mx = ($n ^ ($n-1)) >> 1;
# my $my = ($y ^ ($y-1)) >> 1;
# return max ($mx - ($y & $mx),
# $my - ($n & $my));
# my $h = high_bit($y);
# my $m = ($h<<1)-1;
# return $y ^ $m;
# # return count_0_bits($y); # - count_0_bits($x);
}
sub high_bit {
my ($n) = @_;
my $bit = 1;
while ($bit <= $n) {
$bit <<= 1;
}
return $bit >> 1;
}
sub count_0_bits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += ($n & 1) ^ 1;
$n >>= 1;
}
return $count;
}
sub count_1_bits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += ($n & 1);
$n >>= 1;
}
return $count;
}
}
{
# number of children in replicate style
my $levels = 5;
my $height = 2**$levels;
sub replicate_n_to_xy {
my ($n) = @_;
my $zero = $n * 0;
my @xpos_bits;
my @xneg_bits;
my @y_bits;
foreach my $ndigit (digit_split_lowtohigh($n,3)) {
if ($ndigit == 0) {
push @xpos_bits, 0;
push @xneg_bits, 0;
push @y_bits, 0;
} elsif ($ndigit == 1) {
push @xpos_bits, 0;
push @xneg_bits, 1;
push @y_bits, 1;
} else {
push @xpos_bits, 1;
push @xneg_bits, 0;
push @y_bits, 1;
}
}
return (digit_join_lowtohigh(\@xpos_bits, 2, $zero)
- digit_join_lowtohigh(\@xneg_bits, 2, $zero),
digit_join_lowtohigh(\@y_bits, 2, $zero));
}
# xxx0 = 2 low digit 0 then num children = 2
# xxx0111 = 1 \ low digit != 0 then all low non-zeros must be same
# xxx0222 = 1 /
# other = 0 otherwise num children = 0
sub replicate_tree_n_num_children {
my ($n) = @_;
$n = int($n);
my $low_digit = _divrem_mutate($n,3);
if ($low_digit == 0) {
return 2;
}
while (my $digit = _divrem_mutate($n,3)) {
if ($digit != $low_digit) {
return 0;
}
}
return 1;
}
my $path = Math::PlanePath::SierpinskiTriangle->new;
my %grid;
for (my $n = 0; $n < 3**$levels; $n++) {
my ($x,$y) = replicate_n_to_xy($n);
my $path_num_children = path_xy_num_children($path,$x,$y);
my $repl_num_children = replicate_tree_n_num_children($n);
if ($path_num_children != $repl_num_children) {
print "$x,$y $path_num_children $repl_num_children\n";
exit 1;
}
$grid{$x}{$y} = $repl_num_children;
}
foreach my $y (0 .. $height) {
foreach my $x (-$height .. $y) {
print $grid{$x}{$y} // ' ';
}
print "\n";
}
exit 0;
sub path_xy_num_children {
my ($path, $x,$y) = @_;
my $n = $path->xy_to_n($x,$y);
return (defined $n
? $path->tree_n_num_children($n)
: undef);
}
}
{
my $path = Math::PlanePath::SierpinskiTriangle->new;
foreach my $y (0 .. 10) {
foreach my $x (-$y .. $y) {
if ($path->xy_to_n($x,$y)) {
print "1,";
} else {
print "0,";
}
}
}
print "\n";
exit 0;
}
Math-PlanePath-122/devel/fibonacci-word.pl 0000644 0001750 0001750 00000016317 12150501071 016221 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
# uncomment this to run the ### lines
use Smart::Comments;
{
# Knot overlapping points
# 0,1, 4,16,68,288,1220,5168
# /4 1,4,17,72,305,1292 = A001076 a(n) = 4a(n-1) + a(n-2)
# denom continued fract converg to sqrt(5), 4-Fibonacci
# each next = this*4 + prev
require Math::PlanePath::FibonacciWordKnott;
require Math::BaseCnv;
require Math::NumSeq::BalancedBinary;
my $path = Math::PlanePath::FibonacciWordKnott->new;
my %seen;
my %diffs; require Tie::IxHash; tie %diffs, 'Tie::IxHash';
foreach my $n ($path->n_start .. 10000) {
my ($x,$y) = $path->n_to_xy($n);
if (my $p = $seen{$x,$y}) {
my $d = $n - $p;
# print "$x,$y $p $n diff $d\n";
$diffs{$d} ||= 1;
}
$seen{$x,$y} = $n;
}
my $bal = Math::NumSeq::BalancedBinary->new;
foreach my $d (keys %diffs) {
my $b = Math::BaseCnv::cnv($d,10,2);
my $z = $bal->ith($d);
$z = Math::BaseCnv::cnv($z,10,2);
print "$d bin=$b zeck=$z\n";
}
exit 0;
}
{
# Dense Fibonacci Word turns
require Math::NumSeq::FibonacciWord;
require Image::Base::Text;
my $image = Image::Base::Text->new (-width => 79, -height => 40);
my $foreground = '*';
my $doubleground = '+';
# require Image::Base::GD;
# $image = Image::Base::GD->new (-width => 200, -height => 200);
# $image->rectangle (0,0, 200,200, 'black');
# $foreground = 'white';
# $doubleground = 'red';
my $seq = Math::NumSeq::FibonacciWord->new (fibonacci_word_type => 'dense');
my $dx = 1;
my $dy = 0;
my $x = 1;
my $y = 1;
my $transpose = 1;
my $char = sub {
if ($transpose) {
if (($image->xy($y,$x)//' ') eq $foreground) {
$image->xy ($y,$x, $doubleground);
} else {
$image->xy ($y,$x, $foreground);
}
} else {
if (($image->xy($x,$y)//' ') eq $foreground) {
$image->xy ($x,$y, $doubleground);
} else {
$image->xy ($x,$y, $foreground);
}
}
};
my $draw = sub {
&$char ($x,$y);
$x += $dx;
$y += $dy;
&$char ($x,$y);
$x += $dx;
$y += $dy;
# &$char ($x,$y);
# $x += $dx;
# $y += $dy;
};
my $natural = sub {
my ($value) = @_;
&$draw();
if ($value == 1) {
($dx,$dy) = (-$dy,$dx);
} elsif ($value == 2) {
($dx,$dy) = ($dy,-$dx);
}
};
my $apply;
$apply = sub {
# dfw natural, rot +45
my ($i, $value) = $seq->next;
&$natural($value);
};
# # plus, rot -45
# $apply = sub {
# my ($i, $value) = $seq->next;
# if ($value == 0) {
# # empty
# } else {
# &$natural($value);
# }
# };
# $x += 20;
# $y += 20;
$apply = sub {
# standard
my ($i, $value) = $seq->next;
if ($value == 0) {
&$natural(1);
&$natural(2);
} elsif ($value == 1) {
&$natural(1);
&$natural(0);
} else {
&$natural(0);
&$natural(2);
}
};
# $x += 2;
# $y += int ($image->get('-height') / 2);
# $apply = sub {
# # rot pi/5 = 36deg curly
# my ($i, $value) = $seq->next;
# if ($value == 0) {
# &$natural(2);
# &$natural(1);
# } elsif ($value == 1) {
# &$natural(0);
# &$natural(2);
# } else {
# &$natural(1);
# &$natural(0);
# }
# };
# $x += 20;
# $y += 20;
$apply = sub {
# expanded
my ($i, $value) = $seq->next;
if ($value == 0) {
&$natural(0);
&$natural(1);
&$natural(0);
&$natural(2);
} elsif ($value == 1) {
&$natural(0);
&$natural(1);
&$natural(0);
} else {
&$natural(0);
&$natural(0);
&$natural(2);
}
};
$apply = sub {
# Ron Knott
my ($i, $value) = $seq->next;
if ($value == 0) {
&$natural(1);
&$natural(2);
} else {
&$natural($value);
}
};
print "$x,$y\n";
for (1 .. 2000) {
&$apply();
}
# $image->save('/tmp/x.png');
# system('xzgv /tmp/x.png');
my $lines = $image->save_string;
my @lines = split /\n/, $lines;
$, = "\n";
print reverse @lines;
exit 0;
}
{
my @xend = (0,0,1);
my @yend = (0,1,1);
my $f0 = 1;
my $f1 = 2;
my $level = 1;
my $transpose = 0;
my $rot = 0;
### at: "$xend[-1],$xend[-1] for $f1"
foreach (1 .. 20) {
($f1,$f0) = ($f1+$f0,$f1);
my $six = $level % 6;
$transpose ^= 1;
my ($x,$y);
if (($level % 6) == 0) {
$x = $yend[-2]; # T
$y = $xend[-2];
} elsif (($level % 6) == 1) {
$x = $yend[-2]; # -90
$y = - $xend[-2];
} elsif (($level % 6) == 2) {
$x = $xend[-2]; # T -90
$y = - $yend[-2];
} elsif (($level % 6) == 3) {
### T
$x = $yend[-2]; # T
$y = $xend[-2];
} elsif (($level % 6) == 4) {
$x = - $yend[-2]; # +90
$y = $xend[-2];
} elsif (($level % 6) == 5) {
$x = - $xend[-2]; # T +90
$y = $yend[-2];
}
push @xend, $xend[-1] + $x;
push @yend, $yend[-1] + $y;
### new: ($level%6)." add $x,$y for $xend[-1],$yend[-1] for $f1"
$level++;
}
exit 0;
}
{
my @xend = (0, 1);
my @yend = (1, 1);
my $f0 = 1;
my $f1 = 2;
foreach (1 .. 10) {
{
($f1,$f0) = ($f1+$f0,$f1);
my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] + $xend[-2]); # T
push @xend, $nx;
push @yend, $ny;
### new 1: "$nx, $ny for $f1"
}
{
($f1,$f0) = ($f1+$f0,$f1);
my ($nx,$ny) = ($xend[-1] + $xend[-2], $yend[-1] - $yend[-2]); # T ...
push @xend, $nx;
push @yend, $ny;
### new 2: "$nx, $ny for $f1"
}
{
($f1,$f0) = ($f1+$f0,$f1);
my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] + $xend[-2]); # T
push @xend, $nx;
push @yend, $ny;
### new 3: "$nx, $ny for $f1"
}
{
($f1,$f0) = ($f1+$f0,$f1);
my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] + $xend[-2]); # T
push @xend, $nx;
push @yend, $ny;
### new 1b: "$nx, $ny for $f1"
}
{
($f1,$f0) = ($f1+$f0,$f1);
my ($nx,$ny) = ($xend[-1] - $xend[-2], $yend[-1] + $yend[-2]); # T +90
push @xend, $nx;
push @yend, $ny;
### new 2b: "$nx, $ny for $f1"
}
{
($f1,$f0) = ($f1+$f0,$f1);
my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] + $xend[-2]); # T
push @xend, $nx;
push @yend, $ny;
### new 1c: "$nx, $ny for $f1"
}
{
($f1,$f0) = ($f1+$f0,$f1);
my ($nx,$ny) = ($xend[-1] + $yend[-2], $yend[-1] - $xend[-2]); # rot -90
push @xend, $nx;
push @yend, $ny;
### new 2c: "$nx, $ny for $f1"
}
}
exit 0;
}
Math-PlanePath-122/devel/bignums.pl 0000644 0001750 0001750 00000005765 12136655673 015032 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use POSIX ();
# uncomment this to run the ### lines
use Devel::Comments;
# my $inf = 2**99999;
# my $nan = $inf/$inf;
# print "$inf, $nan","\n";
# print $nan==$nan,"\n";
# print $nan<=>0,"\n";
# print 0<=>$nan,"\n";
{
use Math::BigFloat;
Math::BigFloat->accuracy(15);
my $n = Math::BigFloat->new(1);
$n->accuracy(50);
$n->batan2(.00000000, 100);
print "$n\n";
exit 0;
}
{
use Math::BigFloat;
my $n = Math::BigFloat->new('1.234567892345678923456789');
$n->accuracy(15);
# my $pi = $n->bpi(undef);
# my $pi = Math::BigFloat->bpi;
$n = Math::BigFloat->new(1);
print "$n\n";
$n->accuracy(10);
my $pi = $n->batan2(.0000001);
print "$pi\n";
exit 0;
}
{
use Math::BigFloat;
# Math::BigFloat->precision(5);
# Math::BigFloat->precision(-5);
Math::BigFloat->accuracy(13);
# my $n = Math::BigFloat->new('123456789.987654321');
my $n = Math::BigFloat->bpi(50);
print "$n\n";
exit 0;
}
{
use Math::BigFloat;
my $n = Math::BigFloat->new(1234);
### accuracy: $n->accuracy()
### precision: $n->precision()
my $global_accuracy = Math::BigFloat->accuracy();
my $global_precision = Math::BigFloat->precision();
### $global_accuracy
### $global_precision
my $global_div_scale = Math::BigFloat->div_scale();
### $global_div_scale
Math::BigFloat->div_scale(500);
$global_div_scale = Math::BigFloat->div_scale();
### $global_div_scale
### div_scale: $n->div_scale
$n = Math::BigFloat->new(1234);
### div_scale: $n->div_scale
exit 0;
}
{
require Math::Complex;
my $c = Math::Complex->new(123);
### $c
print $c,"\n";
print $c * 0,"\n";;
### int: int($c)
print int($c),"\n";;
exit 0;
}
{
require Math::BigRat;
use Math::BigFloat;
Math::BigFloat->precision(2000); # digits right of decimal point
Math::BigFloat->accuracy(2000);
{
my $x = Math::BigRat->new('1/2') ** 512;
print "$x\n";
my $r = sqrt($x);
print "$r\n";
print $r*$r,"\n";
# my $r = 8*$x-3;
# print "$r\n";
}
exit 0;
{
my $x = Math::BigInt->new(2) ** 128 - 1;
print "$x\n";
my $r = 8*$x-3;
print "$r\n";
}
{
my $x = Math::BigRat->new('100000000000000000000'.('0'x200));
$x = $x*$x-1;
print "$x\n";
my $r = sqrt($x);
print "$r\n";
$r = int($r);
print "$r\n";
}
}
Math-PlanePath-122/devel/tree.pl 0000644 0001750 0001750 00000014031 11765112630 014273 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.006;
use strict;
use warnings;
use POSIX qw(floor ceil);
use List::Util qw(min max);
use Module::Load;
use App::MathImage::LinesTree;
# uncomment this to run the ### lines
#use Smart::Comments;
{
my $path_class;
require Math::PlanePath::Hypot;
require Math::PlanePath::HypotOctant;
require Math::PlanePath::PythagoreanTree;
require Math::PlanePath::GreekKeySpiral;
require Math::PlanePath::PixelRings;
require Math::PlanePath::TriangularHypot;
require Math::PlanePath::Diagonals;
require Math::PlanePath::SquareArms;
require Math::PlanePath::CellularRule54;
require Math::PlanePath::SquareReplicate;
require Math::PlanePath::KochSquareflakes;
require Math::PlanePath::SierpinskiTriangle;
require Math::PlanePath::DivisibleColumns;
require Math::PlanePath::DiamondSpiral;
require Math::PlanePath::DigitGroups;
require Math::PlanePath::DekkingCurve;
require Math::PlanePath::DekkingStraight;
require Math::PlanePath::HilbertCurve;
require Math::PlanePath::SierpinskiArrowheadCentres;
require Math::PlanePath::SquareSpiral;
require Math::PlanePath::PentSpiral;
require Math::PlanePath::PentSpiralSkewed;
require Math::PlanePath::HexArms;
require Math::PlanePath::TriangleSpiral;
require Math::PlanePath::TriangleSpiralSkewed;
require Math::PlanePath::KochelCurve;
require Math::PlanePath::MPeaks;
require Math::PlanePath::CincoCurve;
require Math::PlanePath::DiagonalRationals;
require Math::PlanePath::FactorRationals;
require Math::PlanePath::VogelFloret;
require Math::PlanePath::CellularRule;
require Math::PlanePath::ComplexPlus;
require Math::PlanePath::AnvilSpiral;
require Math::PlanePath::CellularRule57;
require Math::PlanePath::CretanLabyrinth;
require Math::PlanePath::PeanoHalf;
require Math::PlanePath::StaircaseAlternating;
require Math::PlanePath::SierpinskiCurveStair;
require Math::PlanePath::AztecDiamondRings;
require Math::PlanePath::PyramidRows;
require Math::PlanePath::MultipleRings;
require Math::PlanePath::SacksSpiral;
require Math::PlanePath::TheodorusSpiral;
require Math::PlanePath::FilledRings;
require Math::PlanePath::ImaginaryHalf;
require Math::PlanePath::MooreSpiral;
require Math::PlanePath::QuintetSide;
require Math::PlanePath::PeanoRounded;
require Math::PlanePath::GosperSide;
$path_class = 'Math::PlanePath::ComplexMinus';
$path_class = 'Math::PlanePath::QuadricCurve';
$path_class = 'Math::PlanePath::QuintetReplicate';
$path_class = 'Math::PlanePath::SierpinskiCurve';
$path_class = 'Math::PlanePath::LTiling';
$path_class = 'Math::PlanePath::ImaginaryHalf';
$path_class = 'Math::PlanePath::ImaginaryBase';
$path_class = 'Math::PlanePath::TerdragonCurve';
$path_class = 'Math::PlanePath::TerdragonMidpoint';
$path_class = 'Math::PlanePath::TerdragonRounded';
$path_class = 'Math::PlanePath::DragonCurve';
$path_class = 'Math::PlanePath::SierpinskiArrowhead';
$path_class = 'Math::PlanePath::DragonMidpoint';
$path_class = 'Math::PlanePath::QuintetCentres';
$path_class = 'Math::PlanePath::QuintetCurve';
$path_class = 'Math::PlanePath::GosperReplicate';
$path_class = 'Math::PlanePath::HIndexing';
$path_class = 'Math::PlanePath::CornerReplicate';
$path_class = 'Math::PlanePath::WunderlichMeander';
$path_class = 'Math::PlanePath::ComplexRevolving';
$path_class = 'Math::PlanePath::AlternatePaper';
$path_class = 'Math::PlanePath::WunderlichSerpentine';
$path_class = 'Math::PlanePath::PeanoCurve';
$path_class = 'Math::PlanePath::Flowsnake';
$path_class = 'Math::PlanePath::FlowsnakeCentres';
$path_class = 'Math::PlanePath::FractionsTree';
$path_class = 'Math::PlanePath::RationalsTree';
$path_class = 'Math::PlanePath::GrayCode';
$path_class = 'Math::PlanePath::CubicBase';
$path_class = 'Math::PlanePath::R5DragonCurve';
$path_class = 'Math::PlanePath::R5DragonMidpoint';
$path_class = 'Math::PlanePath::HilbertSpiral';
$path_class = 'Math::PlanePath::BetaOmega';
$path_class = 'Math::PlanePath::AR2W2Curve';
$path_class = 'Math::PlanePath::CCurve';
$path_class = 'Math::PlanePath::GcdRationals';
$path_class = 'Math::PlanePath::DiagonalsOctant';
$path_class = 'Math::PlanePath::KochSnowflakes';
$path_class = 'Math::PlanePath::GosperIslands';
$path_class = 'Math::PlanePath::Corner';
$path_class = 'Math::PlanePath::KochCurve';
$path_class = 'Math::PlanePath::QuadricIslands';
$path_class = 'Math::PlanePath::KochPeaks';
$path_class = 'Math::PlanePath::UlamWarburton';
$path_class = 'Math::PlanePath::DragonRounded';
Module::Load::load($path_class);
my $path = $path_class->new
(
);
### $path
my ($prev_x, $prev_y);
my %seen;
my $n_start = $path->n_start;
my $arms_count = $path->arms_count;
print "n_start $n_start arms_count $arms_count ",ref($path),"\n";
for (my $i = $n_start+0; $i <= 32; $i+=1) {
#for (my $i = $n_start; $i <= $n_start + 800000; $i=POSIX::ceil($i*2.01+1)) {
my @n_children = $path->MathImage__tree_n_children($i);
my $n_children = join(', ', @n_children);
my $iwidth = ($i == int($i) ? 0 : 2);
printf "%.*f %s\n",
$iwidth,$i,
$n_children;
foreach my $n_child (@n_children) {
my $n_parent = $path->MathImage__tree_n_parent($n_child);
if (! defined $n_parent || $n_parent != $i) {
$n_parent //= 'undef';
print " oops child=$n_child, parent=$n_parent\n";
}
}
}
exit 0;
}
Math-PlanePath-122/devel/multiple-rings.pl 0000644 0001750 0001750 00000035520 12601460724 016315 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::Libm 'hypot';
use Math::Trig 'pi','tan';
use Math::PlanePath::MultipleRings;
# uncomment this to run the ### lines
use Smart::Comments;
{
my $path = Math::PlanePath::MultipleRings->new (step => 8,
ring_shape => 'polygon');
my $n = 10;
my ($prev_dx,$prev_dy) = $path->n_to_dxdy($n - 1) or die;
my ($dx,$dy) = $path->n_to_dxdy($n) or die;
my $LSR = $dy*$prev_dx - $dx*$prev_dy;
### $LSR
if (abs($LSR) < 1e-10) { $LSR = 0; }
$LSR = ($LSR <=> 0); # 1,undef,-1
print "path_n_to_LSR dxdy $prev_dx,$prev_dy then $dx,$dy is LSR=$LSR\n";
exit 0;
}
{
require Math::NumSeq::PlanePathDelta;
foreach my $step (3 .. 10) {
print "$step\n";
my $path = Math::PlanePath::MultipleRings->new (step => $step,
ring_shape => 'polygon');
foreach my $n (0 .. $step-1) {
my ($dx,$dy) = $path->n_to_dxdy($n+$path->n_start);
my $dir4 = Math::NumSeq::PlanePathDelta::_delta_func_Dir4($dx,$dy);
printf "%2d %6.3f,%6.3f %6.3f\n", $n, $dx,$dy, $dir4;
}
# my $m = int((3*$step-3)/4);
# $m = int((2*$step-4)/4);
my $m = 2*$step - 2 + ($step%2);
my ($cx,$cy) = Math::PlanePath::MultipleRings::_circlefrac_to_xy
(1, $m, 2*$step, pi());
# $cx = -$cx;
my $dir4 = Math::NumSeq::PlanePathDelta::_delta_func_Dir4($cx,$cy);
print "$m $cx, $cy $dir4\n";
print "\n";
}
exit 0;
}
{
foreach my $step (0 .. 10) {
my $path = Math::PlanePath::MultipleRings->new (step => $step,
ring_shape => 'polygon');
for (my $n = $path->n_start; $n < 10; $n++) {
my ($x, $y) = $path->n_to_xy($n);
my $g = gcd($x,$y);
printf "%2d %6.3f,%6.3f %.8g\n", $n, $x,$y, $g;
}
print "\n";
}
use POSIX 'fmod';
sub gcd {
my ($x,$y) = @_;
$x = abs($x);
$y = abs($y);
unless ($x > 0) {
return $y;
}
# if (is_infinite($x)) { return $x; }
# if (is_infinite($y)) { return $y; }
if ($y > $x) {
$y = fmod($y,$x);
}
for (;;) {
### gcd at: "x=$x y=$y"
if ($y == 0) {
return $x; # gcd(x,0)=x
}
if ($y < 0.0001) {
return 0.00001;
}
($x,$y) = ($y, fmod($x,$y));
}
}
exit 0;
}
{
require Math::BigFloat;
# Math::BigFloat->precision(-3);
my $n = Math::BigFloat->new(4);
# $n->accuracy(5);
$n->precision(-3);
my $pi = Math::PlanePath::MultipleRings::_pi($n);
print "$pi\n";
exit 0;
}
{
my $pi = pi();
my $offset = 0.0;
foreach my $step (3,4,5,6,7,8) {
my $path = Math::PlanePath::MultipleRings->new (step => $step,
ring_shape => 'polygon');
my $d = 1;
my $n0base = Math::PlanePath::MultipleRings::_d_to_n0base($path,$d);
my $next_n0base = Math::PlanePath::MultipleRings::_d_to_n0base($path,$d+10);
my ($pbase, $pinc);
if ($step > 6) {
$pbase = 0;
$pinc = Math::PlanePath::MultipleRings::_numsides_to_r($step,$pi);
} else {
$pbase = Math::PlanePath::MultipleRings::_numsides_to_r($step,$pi);
$pinc = 1/cos($pi/$step);
}
print "step=$step pbase=$pbase pinc=$pinc\n";
for (my $n = $n0base+$path->n_start; $n < $next_n0base; $n += 1.0) {
my ($x, $y) = $path->n_to_xy($n);
my $revn = $path->xy_to_n($x-$offset,$y) // 'undef';
my $r = hypot ($x, $y);
my $theta_frac = Math::PlanePath::MultipleRings::_xy_to_angle_frac($x,$y);
$theta_frac -= int($theta_frac*$step) / $step; # modulo 1/step
my $alpha = 2*$pi/$step;
my $theta = 2*$pi * $theta_frac;
### $r
### x=r*cos(theta): $r*cos($theta)
### y=r*sin(theta): $r*sin($theta)
my $p = $r*cos($theta) + $r*sin($theta) * sin($alpha/2)/cos($alpha/2);
$d = ($p - $pbase) / $pinc + 1;
printf "%5.1f thetafrac=%.4f r=%.4f p=%.4f d=%.2f revn=%s\n",
$n, $theta_frac, $r, $p, $d, $revn;
if ($n==int($n) && (! defined $revn || $revn != $n)) {
print "\n";
die "oops, revn=$revn != n=$n";
}
}
print "\n";
}
exit 0;
}
{
# dir_minimum_dxdy() position
require Math::PlanePath::MultipleRings;
require Math::NumSeq::PlanePathDelta;
foreach my $step (3 .. 100) {
my $path = Math::PlanePath::MultipleRings->new (step => $step,
ring_shape => 'polygon');
my $min_dir4 = 99;
my $min_n = 1;
my $max_dir4 = 0;
my $max_n = 1;
foreach my $n (1 .. $step) {
my ($dx,$dy) = $path->n_to_dxdy($n);
my $dir4 = Math::NumSeq::PlanePathDelta::_delta_func_Dir4($dx,$dy);
if ($dir4 > $max_dir4) {
$max_dir4 = $dir4;
$max_n = $n;
}
if ($dir4 < $min_dir4) {
$min_dir4 = $dir4;
$min_n = $n;
}
}
my $min_diff = $step - $min_n;
my $max_diff = $step - $max_n;
print "$step min N=$min_n $min_diff max N=$max_n $max_diff\n";
}
exit 0;
}
{
# Dir4 minimum, maximum
require Math::PlanePath::MultipleRings;
foreach my $step (3 .. 20) {
my $path = Math::PlanePath::MultipleRings->new (step => $step,
ring_shape => 'polygon');
my $min = $path->dir4_minimum();
my $max = $path->dir4_maximum();
my $den = 2*$step;
$min *= $den;
$max *= $den;
my $md = 4*$den - $max;
print "$step $min $max($md) / $den\n";
}
exit 0;
}
{
# polygon pack
my $poly = 5;
# w/c = tan(angle/2)
# w = c*tan(angle/2)
# (c/row)^2 + (c-prev)^2 = 1
# 1/row^2 * c^2 + (c^2 - 2cp + p^2) = 1
# 1/row^2 * c^2 + c^2 - 2cp + p^2 - 1 = 0
# (1/row^2 + 1) * c^2 - 2p*c + (p^2 - 1) = 0
# A = (1 + 1/row^2)
# B = -2p
# C = (p^2-1)
# c = (2p + sqrt(4p^2 - 4*(p^2+1)*(1 + 1/row^2))) / (2*(1 + 1/row^2))
# d = c-prev
# c = d+prev
# ((d+prev)/row)^2 + d^2 = 1
# (d^2+2dp+p^2)/row^2 + d^2 = 1
# d^2/row^2 + 2p/row^2 * d + p^2/row^2 + d^2 - 1 = 0
# (1+1/row^2)*d^2 + 2p/row^2 * d + (p^2/row^2 - 1) = 0
# A = (1+1/row^2)
# B = 2p/row^2
# C = (p^2/row^2 - 1)
my $angle_frac = 1/$poly;
my $angle_degrees = $angle_frac * 360;
my $angle_radians = 2*pi * $angle_frac;
my $slope = 1/cos($angle_radians/2); # e = slope*c
my $tan = tan($angle_radians/2);
print "angle $angle_degrees slope $slope tan=$tan\n";
my @c = (0);
my @e = (0);
my @points_on_row;
my $delta_minimum = 1/$slope;
my $delta_minimum_hypot = hypot($delta_minimum, $delta_minimum*$tan);
print "delta_minimum = $delta_minimum (hypot $delta_minimum_hypot)\n";
# tan a/2 = 0.5/c
# c = 0.5 / tan(a/2)
my $c = 0.5 / tan($angle_radians/2);
my $e = $c * $slope;
$c[1] = $c;
$e[1] = $e;
my $w = $c*$tan;
print "row=1 initial c=$c e=$e w=$w\n";
{
my $delta_equil = sqrt(3)/2;
my $delta_side = cos($angle_radians/2);
print " delta equil=$delta_equil side=$delta_side\n";
if ($delta_equil > $delta_side) {
$c += $delta_equil;
$w = $c*$tan;
print "row=2 equilateral to c=$c w=$w\n";
} else {
$c += $delta_side;
$w = $c*$tan;
print "row=2 side to c=$c w=$w\n";
}
}
$e = $c * $slope;
$c[2] = $c;
$e[2] = $e;
# for (my $row = 3; $row < 27; $row += 2) {
# my $p = $c;
#
# # # (p - (row-2)/row * c)^2 + (c-p)^2 = 1
# # # p^2 - 2*rf*p*c + rf^2*c^2 + c^2 - 2cp + p^2 - 1 = 0
# # # rf^2*c^2 + c^2 - 2*rf*p*c - 2*p*c + p^2 + p^2 - 1 = 0
# # # (rf^2 + 1)*c^2 + (- 2*rf*p - 2*p)*c + (p^2 + p^2 - 1) = 0
# # # (rf^2 + 1)*c^2 + -2*p*(rf+1)*c + (p^2 + p^2 - 1) = 0
# # #
# # my $rf = ($row-2)/$row;
# # my $A = ($rf^2 + 1);
# # my $B = -2*$rf*$p - 2*$p;
# # my $C = (2*$p**2 - 1);
# # print "A=$A B=$B C=$C\n";
# # my $next_c;
# # my $delta;
# # if ($B*$B - 4*$A*$C >= 0) {
# # $next_c = (-$B + sqrt($B*$B - 4*$A*$C))/(2*$A);
# # $delta = $next_c - $c;
# # } else {
# # $delta = .7;
# # $next_c = $c + $delta;
# #
# # my $side = ($c - $rf*$next_c);
# # my $h = hypot($side, $delta);
# # print " h=$h\n";
# # }
#
# # delta of i=0 j=1
# #
# # (p - (row-2)/row * c)^2 + d^2 = 1
# # (p - rf*(p+d))^2 + d^2 = 1
# # (p - rf*p - rf*d))^2 + d^2 = 1
# # (-p + rf*p + rf*d))^2 + d^2 = 1
# # (rf*d -p + rf*p)^2 + d^2 = 1
# # (rf*d + (rf-1)p)^2 + d^2 = 1
# # rf^2*d^2 + 2*rf*(rf-1)*p * d + (rf-1)^2*p^2 + d^2 - 1 = 0
# # (rf^2+1)*d^2 + rf*(rf-1)*p * d + ((rf-1)^2*p^2 - 1) = 0
# #
# my $rf = ($row-2)/$row;
# $rf = ($row+1 -2)/($row+1);
# my $A = $rf**2 + 1;
# my $B = 2*$rf*($rf-1)*$p;
# my $C = ($rf-1)**2 * $p**2 - 1;
# my $delta;
# if ($B*$B - 4*$A*$C >= 0) {
# $delta = (-$B + sqrt($B*$B - 4*$A*$C))/(2*$A);
# } else {
# print "discrim: ",$B*$B - 4*$A*$C,"\n";
# $delta = 0;
# }
#
# # delta of i=0 j=0
# # (c - p)^2 + d^2 = 1
# #
# if ($delta < $delta_minimum+.0) {
# print " side minimum $delta < $delta_minimum\n";
# $delta = $delta_minimum;
# }
# my $next_c = $delta + $c;
#
#
# # my $A = (1 + ($tan/$row)**2);
# # my $B = -2*$c;
# # my $C = ($c**2 - 1);
# # my $next_c = (-$B + sqrt($B*$B - 4*$A*$C))/(2*$A);
# # my $delta = $next_c - $c;
# #
# # $A = (1 + ($tan/$row)**2);
# # $B = 2*$c/$row**2;
# # $C = ($c**2/$row**2 - 1);
# # my $delta_2 = 0; # (-$B + sqrt($B*$B - 4*$A*$C))/(2*$A);
# # printf "row=$row delta=%.5f=%.5f next_c=%.5f\n", $delta, $delta_2, $next_c;
# printf "row=$row delta=%.5f next_c=%.5f\n", $delta, $next_c;
#
# $c[$row] = $c + $delta;
# $c[$row+1] = $c + 2*$delta;
#
# $e[$row] = $c[$row] * $slope;
# $e[$row+1] = $c[$row+1] * $slope;
#
# $c += 2*$delta;
# }
for (my $row = 3; $row < 138; $row++) {
my $p = $c;
# # (p - (row-2)/row * c)^2 + (c-p)^2 = 1
# # p^2 - 2*rf*p*c + rf^2*c^2 + c^2 - 2cp + p^2 - 1 = 0
# # rf^2*c^2 + c^2 - 2*rf*p*c - 2*p*c + p^2 + p^2 - 1 = 0
# # (rf^2 + 1)*c^2 + (- 2*rf*p - 2*p)*c + (p^2 + p^2 - 1) = 0
# # (rf^2 + 1)*c^2 + -2*p*(rf+1)*c + (p^2 + p^2 - 1) = 0
# #
# my $rf = ($row-2)/$row;
# my $A = ($rf^2 + 1);
# my $B = -2*$rf*$p - 2*$p;
# my $C = (2*$p**2 - 1);
# print "A=$A B=$B C=$C\n";
# my $next_c;
# my $delta;
# if ($B*$B - 4*$A*$C >= 0) {
# $next_c = (-$B + sqrt($B*$B - 4*$A*$C))/(2*$A);
# $delta = $next_c - $c;
# } else {
# $delta = .7;
# $next_c = $c + $delta;
#
# my $side = ($c - $rf*$next_c);
# my $h = hypot($side, $delta);
# print " h=$h\n";
# }
# delta of i=0 j=1
#
# (p*tan - (row-2)/row * tan*c)^2 + d^2 = 1
# tt*(p - rf*(p+d))^2 + d^2 = 1
# tt*(p - rf*p - rf*d)^2 + d^2 = 1
# tt*(-p + rf*p + rf*d)^2 + d^2-1 = 0
# tt*(rf*d -p + rf*p)^2 + d^2-1 = 0
# tt*(rf*d + (rf-1)p)^2 + d^2-1 = 0
# tt*rf^2*d^2 + tt*2*rf*(rf-1)*p * d + tt*(rf-1)^2*p^2 + d^2 - 1 = 0
# (tt*rf^2+1)*d^2 + tt*rf*(rf-1)*p * d + (tt*(rf-1)^2*p^2 - 1) = 0
#
# print " rf ",($row-2),"/$row\n";
my $rf = ($row-2)/($row);
my $A = $tan**2 * $rf**2 + 1;
my $B = $tan**2 * 2*$rf*($rf-1)*$p;
my $C = $tan**2 * ($rf-1)**2 * $p**2 - 1;
my $delta;
if ($B*$B - 4*$A*$C >= 0) {
$delta = (-$B + sqrt($B*$B - 4*$A*$C))/(2*$A);
my $next_c = $delta + $c;
my $pw = $p * $tan;
my $next_w = $next_c * $tan;
my $rem = $pw - $next_w*($row-2)/$row;
my $h = hypot ($delta, $rem);
# print " h^2=$h pw=$pw nw=$next_w rem=$rem\n";
} else {
print "discrim: ",$B*$B - 4*$A*$C,"\n";
my $w = $p*$tan / $row;
print " at d=0 w=$w\n";
$delta = 0;
}
# delta of i=0 j=0
# (c - p)^2 + d^2 = 1
#
if ($delta < $delta_minimum+.0) {
print " side minimum $delta < $delta_minimum\n";
$delta = $delta_minimum;
}
my $next_c = $delta + $c;
printf "row=$row delta=%.5f next_c=%.5f\n", $delta, $next_c;
$c += $delta;
$c[$row] = $c;
$e[$row] = $c[$row] * $slope;
}
# print "c ",join(', ',@c),"\n";
# print "e ",join(', ',@e),"\n";
my (@x,@y);
foreach my $row (1 .. $#c) {
my $x1 = $e[$row];
my $y1 = 0;
my ($x2,$y2) = Math::Trig::cylindrical_to_cartesian($e[$row],
$angle_radians, 0);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
foreach my $p (0 .. $row) {
$x[$row][$p] = $x1 + $dx*$p/$row;
$y[$row][$p] = $y1 + $dy*$p/$row;
}
# print "row=$row x ",join(', ',@{$x[$row]}),"\n";
}
foreach my $row (1 .. $#c-1) {
print "\n";
my $min_dist = 9999;
my $min_dist_at_i = -1;
my $min_dist_at_j = -1;
foreach my $i (0 .. $row) {
foreach my $j (0 .. $row+1) {
my $dist = hypot($x[$row][$i] - $x[$row+1][$j],
$y[$row][$i] - $y[$row+1][$j]);
if ($dist < $min_dist) {
# print " dist=$dist at i=$i j=$j\n";
$min_dist = $dist;
$min_dist_at_i = $i;
$min_dist_at_j = $j;
}
}
}
if ($min_dist_at_i > $row/2) {
$min_dist_at_i = $row - $min_dist_at_i;
$min_dist_at_j = $row+1 - $min_dist_at_j;
}
print "row=$row min_dist=$min_dist at i=$min_dist_at_i j=$min_dist_at_j\n";
my $zdist = hypot($x[$row][0] - $x[$row+1][0],
$y[$row][0] - $y[$row+1][0]);
my $odist = hypot($x[$row][0] - $x[$row+1][1],
$y[$row][0] - $y[$row+1][1]);
print " zdist=$zdist odist=$odist\n";
}
open OUT, '>', '/tmp/multiple-rings.tmp' or die;
foreach my $row (1 .. $#c-1) {
foreach my $i (0 .. $row) {
print OUT "$x[$row][$i], $y[$row][$i]\n";
}
}
close OUT or die;
system ('math-image --wx --path=File,filename=/tmp/multiple-rings.tmp --all --scale=25 --figure=ring');
exit 0;
}
{
# max dx
require Math::PlanePath::MultipleRings;
my $path = Math::PlanePath::MultipleRings->new (step => 37);
my $n = $path->n_start;
my $dx_max = 0;
my ($prev_x, $prev_y) = $path->n_to_xy($n++);
foreach (1 .. 1000000) {
my ($x, $y) = $path->n_to_xy($n++);
my $dx = $y - $prev_y;
if ($dx > $dx_max) {
print "$n $dx\n";
$dx_max = $dx;
}
$prev_x = $x;
$prev_y = $y;
}
exit 0;
}
Math-PlanePath-122/devel/gray.pl 0000644 0001750 0001750 00000020036 12514570663 014307 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::Prime::XS 0.23 'is_prime'; # version 0.23 fix for 1928099
use Math::PlanePath::GrayCode;
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh',
'digit_join_lowtohigh';
# uncomment this to run the ### lines
use Smart::Comments;
{
my $from = from_gray(2**8-1,2);
require Math::BaseCnv;
print Math::BaseCnv::cnv($from,10,2),"\n";
exit 0;
}
{
# turn Left
# 1,1,0,0,1,1,1,
# left at N=1,2 then 180 at N=3
# 7to8
# N=2,3,4 same Y
# parity of A065883
require Math::NumSeq::PlanePathTurn;
my $planepath;
$planepath = "GrayCode";
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => $planepath,
turn_type => 'LSR');
my $path = $seq->{'planepath_object'};
for (1 .. 60) {
my ($n, $turn) = $seq->next;
# next if $value;
my ($x,$y) = $path->n_to_xy($n);
my ($dx,$dy) = $path->n_to_dxdy($n);
my $calc = calc_left_turn($n);
print "$n $x,$y $turn $calc dxdy=$dx,$dy\n";
# printf "%d,", $value;
# printf " i-1 gray %6b\n",to_gray($n-1,2);
# printf " i gray %6b\n",to_gray($n,2);
# printf " i+1 gray %6b\n",to_gray($n+1,2);
}
print "\n";
exit 0;
sub calc_left_turn {
my ($n) = @_;
return count_low_0_bits(($n+1)>>1) % 2 ? 0 : 1;
}
sub count_low_1_bits {
my ($n) = @_;
my $count = 0;
while ($n % 2) {
$count++;
$n = int($n/2);
}
return $count;
}
sub count_low_0_bits {
my ($n) = @_;
if ($n == 0) { die; }
my $count = 0;
until ($n % 2) {
$count++;
$n /= 2;
}
return $count;
}
}
{
# cf GRS
require Math::NumSeq::GolayRudinShapiro;
require Math::NumSeq::DigitCount;
my $seq = Math::NumSeq::GolayRudinShapiro->new;
my $dc = Math::NumSeq::DigitCount->new (radix => 2);
for (my $n = 0; $n < 2000; $n++) {
my $grs = $seq->ith($n);
my $gray = from_binary_gray($n);
my $gbit = $dc->ith($gray) & 1;
printf "%3d %2d %2d\n", $n, $grs, $gbit;
}
exit 0;
}
{
# X,Y,Diagonal values
foreach my $apply_type ('TsF','Ts','sT','sF') {
print "$apply_type\n";
my $path = Math::PlanePath::GrayCode->new (apply_type => $apply_type);
foreach my $i (0 .. 40) {
my $nx = $path->xy_to_n(0,$i);
printf "%d %d %b\n", $i, $nx, $nx;
}
}
exit 0;
}
{
# path sameness
require Tie::IxHash;
my @apply_types = ('TsF','Ts','Fs','FsT','sT','sF');
my @gray_types = ('reflected',
'modular',
);
for (my $radix = 2; $radix <= 10; $radix++) {
print "radix $radix\n";
my %xy;
tie %xy, 'Tie::IxHash';
foreach my $apply_type (@apply_types) {
foreach my $gray_type (@gray_types) {
my $path = Math::PlanePath::GrayCode->new
(radix => $radix,
apply_type => $apply_type,
gray_type => $gray_type);
my $str = '';
foreach my $n (0 .. $radix ** 4) {
my ($x,$y) = $path->n_to_xy($n);
$str .= " $x,$y";
}
push @{$xy{$str}}, "$apply_type,$gray_type";
}
}
my @distinct;
foreach my $aref (values %xy) {
if (@$aref > 1) {
print " same: ",join(' ',@$aref),"\n";
} else {
push @distinct, @$aref;
}
}
print " distinct: ",join(' ',@distinct),"\n";
}
exit 0;
}
{
# to_gray() same as from_gray() in some radices
for (my $radix = 2; $radix < 20; $radix++) {
my $result = "same";
for (my $n = 0; $n < 2000; $n++) {
my $to = to_gray($n,$radix);
my $from = from_gray($n,$radix);
if ($to != $from) {
$result = "different";
last;
}
}
print "radix=$radix to/from $result\n";
}
exit 0;
sub to_gray {
my ($n, $radix) = @_;
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,$radix);
return digit_join_lowtohigh($digits,$radix);
}
sub from_gray {
my ($n, $radix) = @_;
my $digits = [ digit_split_lowtohigh($n,$radix) ];
Math::PlanePath::GrayCode::_digits_from_gray_reflected($digits,$radix);
return digit_join_lowtohigh($digits,$radix);
}
}
{
for (my $n = 0; $n < 2000; $n++) {
next unless is_prime($n);
my $gray = to_binary_gray($n);
next unless is_prime($gray);
printf "%3d %3d\n", $n, $gray;
}
exit 0;
sub to_binary_gray {
my ($n) = @_;
my $digits = [ digit_split_lowtohigh($n,2) ];
Math::PlanePath::GrayCode::_digits_to_gray_reflected($digits,2);
return digit_join_lowtohigh($digits,2);
}
}
{
my $radix = 10;
my $num = 3;
my $width = length($radix)*2*$num;
foreach my $i (0 .. $radix ** $num - 1) {
my $i_digits = [ digit_split_lowtohigh($i,$radix) ];
my @gray_digits = @$i_digits;
my $gray_digits = \@gray_digits;
Math::PlanePath::GrayCode::_digits_to_gray_reflected($gray_digits,$radix);
# Math::PlanePath::GrayCode::_digits_to_gray_modular($gray_digits,$radix);
my @rev_digits = @gray_digits;
my $rev_digits = \@rev_digits;
Math::PlanePath::GrayCode::_digits_from_gray_reflected($rev_digits,$radix);
# Math::PlanePath::GrayCode::_digits_from_gray_modular($rev_digits,$radix);
my $i_str = join(',', reverse @$i_digits);
my $gray_str = join(',', reverse @$gray_digits);
my $rev_str = join(',', reverse @$rev_digits);
my $diff = ($i_str eq $rev_str ? '' : ' ***');
printf "%*s %*s %*s%s\n",
$width,$i_str, $width,$gray_str, $width,$rev_str,
$diff;
}
exit 0;
}
{
foreach my $i (0 .. 32) {
printf "%05b %05b\n", $i, from_binary_gray($i);
}
sub from_binary_gray {
my ($n) = @_;
my @digits;
while ($n) {
push @digits, $n & 1;
$n >>= 1;
}
my $xor = 0;
my $ret = 0;
while (@digits) {
my $digit = pop @digits;
$ret <<= 1;
$ret |= $digit^$xor;
$xor ^= $digit;
}
return $ret;
}
exit 0;
}
# integer modular
# 000 000
# 001 001
# 002 002
# 010 012
# 011 010
# 012 011
# 020 021
# 021 022
# 022 020
# integer reflected
# 000 000
# 001 001
# 002 002
# 010 012
# 011 011
# 012 010
# 020 020
# 021 021
# 022 022
# 100 122
# 101 121
# 102 120
# 110 110
# 111 111
# 112 112
# 120 102
# 121 101
# 122 100
#
# 200 200
# A128173 ternary reverse
# 0, 000
# 1, 001
# 2, 002
# 5, 012
# 4, 011
# 3, 010
# 6, 020
# 7, 021
# 8, 022
# 17, 122
# 16, 121
# 15, 120
# 12, 110
# 13, 111
# 14, 112
# 11, 102
# 10, 101
# 9, 100
# 18, 200
# A105530 ternary cyclic
# 0, 000
# 1, 001
# 2, 002
# 5, 012
# 3, 010
# 4, 011
# 7, 021
# 8, 022
# 6, 020
# 15, 120
# 16, 121
# 17, 122
# 11, 102
# 9, 100
# 10, 101
# 13, 111
# 14, 112
# 12, 110
# 21, 210
# 22, 211
#
sub _to_gray {
my ($n) = @_;
### _to_gray(): $n
return ($n >> 1) ^ $n;
}
sub _from_gray {
my ($n) = @_;
### _from_gray(): $n
my $shift = 1;
for (;;) {
my $xor = ($n >> $shift) || return $n;
$n ^= $xor;
$shift *= 2;
}
# my @digits;
# while ($n) {
# push @digits, $n & 1;
# $n >>= 1;
# }
# my $xor = 0;
# my $ret = 0;
# while (@digits) {
# my $digit = pop @digits;
# $ret <<= 1;
# $ret |= $digit^$xor;
# $xor ^= $digit;
# }
# return $ret;
}
Math-PlanePath-122/devel/quadric.pl 0000644 0001750 0001750 00000007613 11753407263 015002 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
{
# QuadricIslands X negative axis N increasing
require Math::PlanePath::QuadricIslands;
my $path = Math::PlanePath::QuadricIslands->new;
my $prev_n = 0;
for (my $x = 0; $x > -1000000000; $x--) {
my $n = $path->xy_to_n($x,0) // next;
if ($n < $prev_n) {
print "decrease N at X=$x N=$n prev_N=$prev_n\n";
}
$prev_n = $n;
}
}
{
# min/max for level
require Math::PlanePath::QuadricIslands;
my $path = Math::PlanePath::QuadricIslands->new;
my $prev_min = 1;
my $prev_max = 1;
for (my $level = 1; $level < 25; $level++) {
my $n_start = (4*8**$level + 3)/7;
my $n_end = (4*8**($level+1) + 3)/7 - 1;
$n_end = $n_start + 8**$level;
my $min_width = $n_start ** 2;
my $min_pos = '';
my $max_width = 0;
my $max_pos = '';
print "level $level n=$n_start .. $n_end\n";
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
#my $w = -$y-$x/2;
my $w = abs($y);
if ($w > $max_width) {
$max_width = $w;
$max_pos = "$x,$y n=$n (oct ".sprintf('%o',$n).")";
}
if ($w < $min_width) {
$min_width = $w;
$min_pos = "$x,$y n=$n (oct ".sprintf('%o',$n).")";
}
}
{
my $factor = $max_width / $prev_max;
print " max width $max_width oct ".sprintf('%o',$max_width)." at $max_pos factor $factor\n";
}
{
my $factor = $min_width / ($prev_min||1);
print " min width $min_width oct ".sprintf('%o',$min_width)." at $min_pos factor $factor\n";
}
{
my $formula = (2*4**($level-1) + 1) / 3;
print " cf min formula $formula\n";
}
{
my $formula = (10*4**($level-1) - 1) / 3;
print " cf max formula $formula\n";
}
$prev_max = $max_width;
$prev_min = $min_width;
}
exit 0;
}
{
# min/max for level
require Math::PlanePath::QuadricCurve;
my $path = Math::PlanePath::QuadricCurve->new;
my $prev_min = 1;
my $prev_max = 1;
for (my $level = 1; $level < 25; $level++) {
my $n_start = 8**($level-1);
my $n_end = 8**$level;
my $max_width = 0;
my $max_pos = '';
my $min_width;
my $min_pos = '';
print "level $level n=$n_start .. $n_end\n";
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
$x -= 4**$level / 2; # for Rings
$y -= 4**$level / 2; # for Rings
my $w = -2*$y-$x;
#my $w = -$y-$x/2;
if ($w > $max_width) {
$max_width = $w;
$max_pos = "$x,$y n=$n (oct ".sprintf('%o',$n).")";
}
if (! defined $min_width || $w < $min_width) {
$min_width = $w;
$min_pos = "$x,$y n=$n (oct ".sprintf('%o',$n).")";
}
}
# print " max $max_width at $max_x,$max_y\n";
my $factor = $max_width / $prev_max;
print " min width $min_width oct ".sprintf('%o',$min_width)." at $min_pos factor $factor\n";
# print " max width $max_width oct ".sprintf('%o',$max_width)." at $max_pos factor $factor\n";
# print " cf formula ",(10*4**($level-1) - 1)/3,"\n";
# print " cf formula ",2* (4**($level-0) - 1)/3,"\n";
print " cf formula ",2*4**($level-1),"\n";
$prev_max = $max_width;
}
exit 0;
}
Math-PlanePath-122/devel/dragon.pl 0000644 0001750 0001750 00000271520 12447345064 014625 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use List::MoreUtils;
use POSIX 'floor';
use Math::BaseCnv;
use Math::Libm 'M_PI', 'hypot', 'cbrt';
use List::Util 'min', 'max', 'sum';
use Math::PlanePath::DragonCurve;
use Math::PlanePath::Base::Digits
'round_down_pow';
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::KochCurve;
*_digit_join_hightolow = \&Math::PlanePath::KochCurve::_digit_join_hightolow;
use lib 'xt';
use MyOEIS;
use Memoize;
# uncomment this to run the ### lines
# use Smart::Comments;
# A003229 area left side extra over doubling a(n) = a(n-1) + 2*a(n-3).
# A003230 area enclosed Expansion of 1/((1-x)*(1-2*x)*(1-x-2*x^3)).
# A003476 right boundary squares a(n) = a(n-1) + 2a(n-3).
# A003477 area of connected blob Expansion of 1/((1-2x)(1+x^2)(1-x-2x^3)).
# A003478 area on left side Expansion of 1/(1-2x)(1-x-2x^3 ).
# A003479 join area Expansion of 1/((1-x)*(1-x-2*x^3)).
# A203175 left boundary squares
# A227036
# A077949 join area increments
{
# right boundary N
my $path = Math::PlanePath::DragonCurve->new;
my %non_values;
my %n_values;
my @n_values;
my @values;
foreach my $k (5) {
my $n_limit = 2**$k;
print "k=$k n_limit=$n_limit\n";
foreach my $n (0 .. $n_limit-1) {
$non_values{$n} = 1;
}
my $points = MyOEIS::path_boundary_points ($path, $n_limit,
side => 'right',
);
### $points
for (my $i = 0; $i+1 <= $#$points; $i++) {
my ($x,$y) = @{$points->[$i]};
my ($x2,$y2) = @{$points->[$i+1]};
# my @n_list = $path->xy_to_n_list($x,$y);
my @n_list = path_xyxy_to_n($path, $x,$y, $x2,$y2);
foreach my $n (@n_list) {
delete $non_values{$n};
if ($n <= $n_limit) { $n_values{$n} = 1; }
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n);
my $diff = $pred ? '' : ' ***';
if ($k <= 5 || $diff) { print "$n $n2$diff\n"; }
}
}
@n_values = keys %n_values;
@n_values = sort {$a<=>$b} @n_values;
my @non_values = keys %non_values;
@non_values = sort {$a<=>$b} @non_values;
my $count = scalar(@n_values);
print "count $count\n";
# push @values, $count;
@values = @n_values;
foreach my $n (@non_values) {
my $pred = $path->_UNDOCUMENTED__n_segment_is_right_boundary($n);
my $diff = $pred ? ' ***' : '';
my $n2 = Math::BaseCnv::cnv($n,10,2);
if ($k <= 5 || $diff) {
print "non $n $n2$diff\n";
}
}
# @values = @non_values;
# print "func ";
# foreach my $i (0 .. $count-1) {
# my $n = $path->_UNDOCUMENTED__right_boundary_i_to_n($i);
# my $n2 = Math::BaseCnv::cnv($n,10,2);
# print "$n,";
# }
# print "\n";
print "vals ";
foreach my $i (0 .. $count-1) {
my $n = $values[$i];
my $n2 = Math::BaseCnv::cnv($n,10,2);
print "$n,";
}
print "\n";
}
# @values = MyOEIS::first_differences(@values);
splice @values,0,16;
# shift @values;
# shift @values;
print join(',',@values),"\n";
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose=>1);
exit 0;
sub path_xyxy_to_n {
my ($path, $x1,$y1, $x2,$y2) = @_;
### path_xyxy_to_n(): "$x1,$y1, $x2,$y2"
my @n_list = $path->xy_to_n_list($x1,$y1);
### @n_list
my $arms = $path->arms_count;
foreach my $n (@n_list) {
my ($x,$y) = $path->n_to_xy($n + $arms);
if ($x == $x2 && $y == $y2) {
return $n;
}
}
return;
}
}
{
# Midpoint tiling, PNG
require Math::PlanePath::DragonMidpoint;
require Image::Base::Text;
require Image::Base::PNGwriter;
my $scale = 4;
my $arms = 1;
my $path = Math::PlanePath::DragonMidpoint->new (arms => $arms);
# my $width = 78;
# my $height = 48;
# my $xoffset = $width/2;
# my $yoffset = $height/2;
# my $image = Image::Base::Text->new (-width => $width,
# -height => $height);
my $width = 1000;
my $height = 800;
my $xoffset = $width/2;
my $yoffset = $height/2;
my $image = Image::Base::PNGwriter->new (-width => $width,
-height => $height);
my $colour = '#00FF00';
my ($nlo,$nhi) = $path->rect_to_n_range(-$xoffset,-$yoffset,
$xoffset,$yoffset);
$nhi = 16384*2;
print "nhi $nhi\n";
for (my $n = 0; $n <= $nhi; $n++) {
# next if int($n/$arms) % 2;
next unless int($n/$arms) % 2;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+$arms);
$x1 *= $scale;
$y1 *= $scale;
$x2 *= $scale;
$y2 *= $scale;
$x1 += $xoffset;
$x2 += $xoffset;
$y1 += $yoffset;
$y2 += $yoffset;
$image->line($x1,$y1,$x2,$y2,$colour);
}
# $image->save('/dev/stdout');
$image->save('/tmp/x.png');
system('xzgv /tmp/x.png');
exit 0;
}
{
# DragonMidpoint abs(dY) sequence
# A073089 n=N+2 value = lowbit(N) XOR bit-above-lowest-zero(N)
# dX = 1 - A073089 inverse
require Math::NumSeq::PlanePathDelta;
my $seq = Math::NumSeq::PlanePathDelta->new (planepath => 'DragonMidpoint',
delta_type => 'dY');
my @values;
foreach (0 .. 64) {
my ($i,$value) = $seq->next;
my $p = $i+2;
# while ($p && ! ($p&1)) {
# $p/=2;
# }
my $v = calc_n_midpoint_vert($i+1);
printf "%d %d %7b\n", abs($value), $v, $p;
push @values, 1-abs($value);
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose => 1);
exit 0;
}
{
# DragonMidpoint abs(dY) sequence
require Math::PlanePath::DragonMidpoint;
my $path = Math::PlanePath::DragonMidpoint->new;
foreach my $n (0 .. 64) {
my ($x,$y) = $path->n_to_xy($n);
my ($nx,$ny) = $path->n_to_xy($n+1);
if ($nx == $x) {
my $p = $n+2;
# while ($p && ! ($p&1)) {
# $p/=2;
# }
my $v = calc_n_midpoint_vert($n);
printf "%d %7b\n", $v, $p;
}
}
exit 0;
sub calc_n_midpoint_vert {
my ($n) = @_;
if ($n < 0) { return 0; }
my $vert = ($n & 1);
my $right = calc_n_turn($n);
return ((($vert && !$right)
|| (!$vert && $right))
? 0
: 1);
}
# return 0 for left, 1 for right
sub calc_n_turn {
my ($n) = @_;
my ($mask,$z);
$mask = $n & -$n; # lowest 1 bit, 000100..00
$z = $n & ($mask << 1); # the bit above it
my $turn = ($z == 0 ? 0 : 1);
# printf "%b %b %b %d\n", $n,$mask, $z, $turn;
return $turn;
}
}
{
# direction which curve enters and leaves an X axis point
# all 4 arms
#
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new (arms => 4);
my $width = 30;
my ($n_lo, $n_hi) = $path->rect_to_n_range(0,0,$width+2,0);
my (@enter, @leave);
print "n_hi $n_hi\n";
for my $n (0 .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
if ($y == 0 && $x >= 0) {
{
my ($nx,$ny) = $path->n_to_xy($n+4);
if ($ny > $y) {
$leave[$x] .= 'u';
}
if ($ny < $y) {
$leave[$x] .= 'd';
}
if ($nx > $x) {
$leave[$x] .= 'r';
}
if ($nx < $x) {
$leave[$x] .= 'l';
}
}
if ($n >= 4) {
my ($px,$py) = $path->n_to_xy($n-4);
if ($y > $py) {
$enter[$x] .= 'u';
}
if ($y < $py) {
$enter[$x] .= 'd';
}
if ($x > $px) {
$enter[$x] .= 'r';
}
if ($x < $px) {
$enter[$x] .= 'l';
}
}
}
}
foreach my $x (0 .. $width) {
print "$x ",sort_str($enter[$x])," ",sort_str($leave[$x]),"\n";
}
sub sort_str {
my ($str) = @_;
if (! defined $str) {
return '-';
}
return join ('', sort split //, $str);
}
exit 0;
}
{
# repeat/unrepeat 0,1
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
foreach my $n (0 .. 256) {
my ($x, $y) = $path->n_to_xy ($n);
my @n_list = $path->xy_to_n_list($x,$y);
my $num = scalar(@n_list) - 1;
print "$num,";
}
exit 0;
}
{
# repeat points
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my %seen;
my %first;
foreach my $n (0 .. 2**10 - 1) {
my ($x, $y) = $path->n_to_xy ($n);
my @n_list = $path->xy_to_n_list($x,$y);
next unless $n_list[0] == $n;
next unless @n_list >= 2;
my $dn = abs($n_list[0] - $n_list[1]);
++$seen{$dn};
$first{$dn} ||= "$x,$y";
}
foreach my $dn (sort {$a<=>$b} keys %seen) {
my $dn2 = sprintf '%b', $dn;
print "dN=${dn}[$dn2] first at $first{$dn} count $seen{$dn}\n";
}
my @seen = sort {$a<=>$b} keys %seen;
print join(',',@seen),"\n";
foreach (@seen) { $_ /= 4; }
print join(',',@seen),"\n";
exit 0;
}
{
# unrepeated points
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
foreach my $n (0 .. 256) {
my ($x, $y) = $path->n_to_xy ($n);
my @n_list = $path->xy_to_n_list($x,$y);
next unless @n_list == 1;
#printf "%9b\n", $n;
print "$n,";
}
exit 0;
}
{
# area left side = first differences
my $path = Math::PlanePath::DragonCurve->new;
my $prev = 0;
$| = 1;
foreach my $k (0 .. 15) {
my $a = A_from_path($path,$k);
my $al = A_from_path($path,$k) - $prev;
print "$al, ";
$prev = $a;
}
print "\n";
exit 0;
}
{
# boundary squares
# k=0 k=1 * k=2
# |
# left=1 * left=1 *---* left=2
# right=1 | right=2 | right=3
# *---* *---* *---*
#
my $path = Math::PlanePath::DragonCurve->new;
foreach my $side ('left',
'right',
) {
my @values;
foreach my $k (
# 1,
0 .. 10
) {
my $n_limit = 2**$k;
# print "k=$k n_limit=$n_limit\n";
my $points = MyOEIS::path_boundary_points ($path, $n_limit,
side => $side,
);
# if ($side eq 'left') {
# @$points = reverse @$points;
# }
my %seen;
my $count_edges = 0;
my $count_squares = 0;
foreach my $i (1 .. $#$points) {
my $p1 = $points->[$i-1];
my $p2 = $points->[$i];
my ($x1,$y1) = @$p1;
my ($x2,$y2) = @$p2;
### edge: "$x1,$y1 to $x2,$y2"
my $dx = $x2-$x1;
my $dy = $y2-$y1;
my $sx = 2*$x1 + ($dx + $dy);
my $sy = 2*$y1 + ($dy - $dx);
### square: "$sx,$sy"
$count_edges++;
if (! $seen{"$sx,$sy"}++) {
$count_squares++;
}
}
print "k=$k edges=$count_edges squares=$count_squares\n";
push @values, $count_squares;
}
# shift @values; shift @values; shift @values; shift @values;
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array=>\@values);
}
exit 0;
}
{
# convex hull iterations
#
require Math::Geometry::Planar;
my $points = [ [0,0], [1,0], [1,1] ];
my $nx = 1;
my $ny = 1;
foreach my $k (1 .. 20) {
($nx,$ny) = ($nx-$ny, $ny+$nx); # add rotate +90
my $num_points = scalar(@$points);
print "k=$k nxy=$nx,$ny count=$num_points\n";
my @new_points = @$points;
foreach my $p (@$points) {
my ($x,$y) = @$p;
($x,$y) = ($y,-$x); # rotate -90
$x += $nx;
$y += $ny;
print " $x,$y";
push @new_points, [ $nx + $x, $ny + $y ];
}
print "\n";
$points = \@new_points;
# foreach my $i (0 .. $#new_points) {
# my $p = $new_points[$i];
# my ($x,$y) = @$p;
# }
my $planar = Math::Geometry::Planar->new;
$planar->points($points);
$planar = $planar->convexhull2;
$points = $planar->points;
next if @$points < 10;
my $max_i = 0;
my $max_p = $points->[0];
foreach my $j (1 .. $#$points) {
if ($points->[$j]->[0] > $max_p->[0]
|| ($points->[$j]->[0] == $max_p->[0]
&& $points->[$j]->[1] < $max_p->[1])) {
$max_i = $j;
$max_p = $points->[$j];
}
}
$points = points_sort_by_dir($points, [$nx,$ny]);
foreach my $i (0 .. $#$points) {
my $p = $points->[$i - $max_i];
my ($x,$y) = @$p;
print " $x,$y";
}
print "\n";
}
exit 0;
sub points_sort_by_dir {
my ($points, $point_start) = @_;
### $points
require Math::NumSeq::PlanePathDelta;
my $start = Math::NumSeq::PlanePathDelta::_dxdy_to_dir4(@$point_start) + 0;
return [ sort {
my $a_dir = (Math::NumSeq::PlanePathDelta::_dxdy_to_dir4(@$a) + $start) % 4;
my $b_dir = (Math::NumSeq::PlanePathDelta::_dxdy_to_dir4(@$b) + $start) % 4;
$a_dir <=> $b_dir
} @$points ];
}
}
{
# mean X,Y
# at 2/5 - 1/5*i relative to endpoint
require Math::Complex;
my $path = Math::PlanePath::DragonCurve->new;
my @values;
foreach my $k (0 .. 30) {
my ($n_start, $n_end) = $path->level_to_n_range($k);
my $x_total = 0;
my $y_total = 0;
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
$x_total += $x;
$y_total += $y;
}
my ($x_end,$y_end) = $path->n_to_xy($n_end);
$x_total -= $x_end/2;
$y_total -= $y_end/2;
my $total = 2**$k;
my $x = $x_total / $total;
my $y = $y_total / $total;
my $f = Math::Complex->make($x,$y);
my $rot = Math::Complex::root(1,8,$k);
my $div = Math::Complex->make($x_end,$y_end);
my $fr = $f / $div;
print "k=$k X=$x_total Y=$y_total x=$x y=$y\n";
print " f=$f rot=$rot div=$div $fr\n";
print " fr=$fr\n";
push @values, $y_total;
}
shift @values; shift @values; shift @values; shift @values;
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array=>\@values);
exit 0;
}
{
# mean X,Y by replication
#
# 1/2 --- 1/2 = .5, 0
#
# 1/2 X = (1+1/2) / 2 = 3/4
# | Y = 1/2 / 2 = 1/4
# 1/2 --- 1
my $fx = 0;
my $fy = 0;
for my $k (0 .. 40) {
my ($ax,$ay) = (($fx + $fy)/sqrt(2), # rotate -45
($fy - $fx)/sqrt(2));
my ($bx,$by) = ((-$fx + $fy)/sqrt(2) + 1, # rotate -135
(-$fy - $fx)/sqrt(2));
print "$fx $fy $ax $ay $bx $by\n";
($fx,$fy) = ($ax/2 + $bx/2,
$ay/2 + $by/2);
}
exit 0;
}
{
# fractal convex hull Benedek and Panzone
# perimeter 4.12927310015371
# = (9 + sqrt(13) + sqrt(26) + 5*sqrt(2)) / 6
#
require Math::BigRat;
require Math::Geometry::Planar;
my $polygon = Math::Geometry::Planar->new;
my $points = [ [Math::BigRat->new('2/3')->copy, Math::BigRat->new('2/3')->copy],
[Math::BigRat->new('0')->copy, Math::BigRat->new('2/3')->copy],
[Math::BigRat->new('-1/3')->copy, Math::BigRat->new('1/3')->copy],
[Math::BigRat->new('-1/3')->copy, Math::BigRat->new('0')->copy],
[Math::BigRat->new('-1/6')->copy, Math::BigRat->new('-1/6')->copy],
[Math::BigRat->new('2/3')->copy, Math::BigRat->new('-1/3')->copy],
[Math::BigRat->new('1')->copy, Math::BigRat->new('-1/3')->copy],
[Math::BigRat->new('7/6')->copy, Math::BigRat->new('-1/6')->copy],
[Math::BigRat->new('7/6')->copy, Math::BigRat->new('0')->copy],
[Math::BigRat->new('5/6')->copy, Math::BigRat->new('3/6')->copy],
];
$polygon->points($points);
print "area = ",$polygon->area,"\n";
print "perimeter = ",$polygon->perimeter,"\n";
my %root;
foreach my $i (0 .. $#$points) {
my $hsquared = ($points->[$i]->[0] - $points->[$i-1]->[0])**2
+ ($points->[$i]->[1] - $points->[$i-1]->[1])**2;
$hsquared *= 36;
my $root = square_free_part($hsquared);
my $factor = sqrt($hsquared / $root);
$root{$root} ||= 0;
$root{$root} += $factor;
print "$hsquared $root $factor\n";
}
foreach my $root (keys %root) {
print "$root{$root} * sqrt($root)\n";
}
print "\nminrectangle\n";
my $minrect = $polygon->minrectangle;
my $p = $minrect->points;
print "$p->[0]->[0],$p->[0]->[1] $p->[1]->[0],$p->[1]->[1] $p->[2]->[0],$p->[2]->[1] $p->[3]->[0],$p->[3]->[1]\n";
print "area = ",$minrect->area,"\n";
print "perimeter = ",$minrect->perimeter,"\n";
exit 0;
sub square_free_part {
my ($n) = @_;
my $ret = 1;
for (my $p = 2; $p <= $n; $p++) {
while ($n % ($p*$p) == 0) {
$n /= ($p*$p);
}
if ($n % $p == 0) {
$ret *= $p;
$n /= $p;
}
}
return $ret;
}
}
{
# (i-1)^k
use lib 'xt';
require MyOEIS;
require Math::Complex;
my $b = Math::Complex->make(-1,1);
my $c = Math::Complex->make(1);
my @values = (0,0,0);
foreach (0 .. 160) {
push @values, $c->Re;
$c *= $b;
}
print join(',',@values),"\n";
Math::OEIS::Grep->search(array=>\@values);
print "\n";
exit 0;
}
{
# L,R,T,U,V by path boundary
require MyOEIS;
$| = 1;
# L
my $path = Math::PlanePath::DragonCurve->new;
foreach my $part ('B','A','L','R','T','U','V') {
print "$part ";
my $name = "${part}_from_path";
my $coderef = __PACKAGE__->can($name) || die $name;
my @values;
foreach my $k (0 .. 14) {
my $value = $coderef->($path,$k);
push @values, $value;
print "$value,";
# if ($value < 10) { print "\n",join(' ',map{join(',',@$_)} @$points),"\n"; }
}
print "\n";
shift @values;
shift @values;
shift @values;
shift @values;
shift @values;
Math::OEIS::Grep->search (array => \@values,
name => $part);
print "\n";
}
exit 0;
sub A_from_path {
my ($path, $k) = @_;
return MyOEIS::path_enclosed_area($path, 2**$k);
}
sub B_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit);
return scalar(@$points);
}
sub L_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'left');
return scalar(@$points) - 1;
}
sub R_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my $points = MyOEIS::path_boundary_points($path, $n_limit, side => 'right');
return scalar(@$points) - 1;
}
sub T_from_path {
my ($path, $k) = @_;
# 2 to 4
my $n_limit = 2**$k;
my ($x,$y) = $path->n_to_xy(2*$n_limit);
my ($to_x,$to_y) = $path->n_to_xy(4*$n_limit);
my $points = MyOEIS::path_boundary_points_ft($path, 4*$n_limit,
$x,$y, $to_x,$to_y,
dir => 2);
return scalar(@$points) - 1;
}
sub U_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my ($x,$y) = $path->n_to_xy(3*$n_limit);
my ($to_x,$to_y) = $path->n_to_xy(0);
my $points = MyOEIS::path_boundary_points_ft($path, 4*$n_limit,
$x,$y, $to_x,$to_y,
dir => 1);
return scalar(@$points) - 1;
}
sub V_from_path {
my ($path, $k) = @_;
my $n_limit = 2**$k;
my ($x,$y) = $path->n_to_xy(6*$n_limit);
my ($to_x,$to_y) = $path->n_to_xy(3*$n_limit);
my $points = MyOEIS::path_boundary_points_ft($path, 8*$n_limit,
$x,$y, $to_x,$to_y,
dir => 0);
return scalar(@$points) - 1;
}
}
{
# drawing with Language::Logo
require Language::Logo;
require Math::NumSeq::PlanePathTurn;
my $lo = Logo->new(update => 20, port => 8200 + (time % 100));
my $len = 20;
my $level = 4;
if (0) {
my $seq = Math::NumSeq::PlanePathTurn->new(planepath=>'DragonCurve',
turn_type => 'Right');
my $angle = 60;
$lo->command("pendown");
$lo->command("color green");
$lo->command("right 90");
foreach my $n (0 .. 2**$level) {
my ($i,$value) = $seq->next;
my $turn_angle = ($value ? $angle : -$angle);
$lo->command("forward $len; right $turn_angle");
}
}
{
my $seq = Math::NumSeq::PlanePathTurn->new(planepath=>'TerdragonCurve',
turn_type => 'Right');
my $angle = 120;
$lo->command("penup");
$lo->command("setxy 400 200");
$lo->command("seth 90");
$lo->command("color red");
$lo->command("pendown");
foreach my $n (0 .. 3**$level-1) {
my ($i,$value) = $seq->next;
my $turn_angle = ($value ? $angle : -$angle);
$lo->command("forward $len; right $turn_angle");
}
$lo->command("home");
$lo->command("hideturtle");
}
$lo->disconnect("Finished...");
exit 0;
}
{
# arms=2 boundary
# math-image --path=DragonCurve,arms=4 --expression='i<=67?i:0' --output=numbers_dash --size=50x80
# 5
# |
# 6 --- 0,1,2,3 --- 4
# |
# 7
my $path = Math::PlanePath::DragonCurve->new (arms=>4);
sub Ba2_from_path {
my ($path, $k) = @_;
my ($n_start, $n_end) = $path->level_to_n_range($k);
my $points = MyOEIS::path_boundary_points($path, $n_end);
print join(" ", map{"$_->[0],$_->[1]"} @$points),"\n";
return scalar(@$points);
}
sub Aa2_from_path {
my ($path, $k) = @_;
my ($n_start, $n_end) = $path->level_to_n_range($k);
return MyOEIS::path_enclosed_area($path, $n_end);
}
foreach my $k (1) {
print "$k ",Ba2_from_path($path,$k),"\n";
# ," ",Aa2_from_path($path,$k)
}
exit 0;
}
{
# poly trial division
require Math::Polynomial;
Math::Polynomial->string_config({ ascending => 1,
fold_sign => 1 });
my $p;
$p = Math::Polynomial->new(1,-4,5,-4,6,-4); # dragon area denom
$p = Math::Polynomial->new(2,-5,3,-4,5); # dragon visited
$p = Math::Polynomial->new(1,-3,-1,-5); # ComplexMinus r=2 boundary
$p = Math::Polynomial->new(6, -4,, 2, -8); # DragonMidpoint boundary
$p = Math::Polynomial->new(1,2,0,-1,1,0,2,4,-1); # C curve e
$p = Math::Polynomial->new(2,2,4,8,2,4); # Ba2 gf
print "$p\n";
foreach my $a (-15 .. 15) {
foreach my $b (1 .. 15) {
next if $a == 0 && $b == 0;
next if abs($a) == 1 && $b == 0;
my $d = Math::Polynomial->new($a,$b);
my ($q,$r) = $p->divmod($d);
if ($r == 0 && poly_is_integer($q)) {
print "/ $d = $q rem $r\n";
$p = $q;
}
}
}
foreach my $a (-15 .. 15) {
foreach my $b (-15 .. 15) {
foreach my $c (1 .. 15) {
next if $a == 0 && $b == 0 && $c == 0;
next if abs($a) == 1 && $b == 0 && $c == 0;
my $d = Math::Polynomial->new($a,$b,$c);
my ($q,$r) = $p->divmod($d);
if ($r == 0 && poly_is_integer($q)) {
print "/ $d = $q rem $r\n";
$p = $q;
}
}
}
}
print "final $p\n";
exit 0;
sub poly_is_integer {
my ($p) = @_;
foreach my $coeff ($p->coefficients) {
unless ($coeff == int($coeff)) {
return 0;
}
}
return 1;
}
}
{
my $path = Math::PlanePath::DragonCurve->new;
sub level_to_join_area {
my ($level) = @_;
{
if ($level == 0) { return 0; }
if ($level == 1) { return 0; }
if ($level == 2) { return 0; }
if ($level == 3) { return 1; }
my $j0 = 0;
my $j1 = 0;
my $j2 = 0;
my $j3 = 1;
foreach (4 .. $level) {
($j3,$j2,$j1,$j0) = (2*$j3 - $j2 + 2*$j1 - 2*$j0, $j3, $j2, $j1);
}
return $j3;
}
return ($path->_UNDOCUMENTED_level_to_right_line_boundary($level+1)
- $path->_UNDOCUMENTED_level_to_left_line_boundary($level+1)) / 4;
return ($path->_UNDOCUMENTED_level_to_line_boundary($level) / 2
- $path->_UNDOCUMENTED_level_to_line_boundary($level+1) / 4);
return ($path->_UNDOCUMENTED_level_to_enclosed_area($level+1)
- 2*$path->_UNDOCUMENTED_level_to_enclosed_area($level));
}
sub level_to_join_points_by_formula {
my ($level) = @_;
{
if ($level == 0) { return 1; }
if ($level == 1) { return 1; }
if ($level == 2) { return 1; }
if ($level == 3) { return 2; }
my $j0 = 1;
my $j1 = 1;
my $j2 = 1;
my $j3 = 2;
foreach (4 .. $level) {
($j3,$j2,$j1,$j0) = (2*$j3 - $j2 + 2*$j1 - 2*$j0, $j3, $j2, $j1);
}
return $j3;
}
return level_to_join_area($level) + 1;
}
my @values;
my $prev_visited = 0;
foreach my $k (0 .. 11) {
my $n_end = 2**$k;
# my %seen;
# foreach my $n (0 .. $n_end) {
# my ($x,$y) = $path->n_to_xy($n);
# $seen{"$x,$y"}++;
# }
my $u = $path->_UNDOCUMENTED_level_to_u_left_line_boundary($k);
my $ru = $path->_UNDOCUMENTED_level_to_u_right_line_boundary($k);
my $bu = $path->_UNDOCUMENTED_level_to_u_line_boundary($k);
my $ja = level_to_join_area($k);
my $join_points = path_level_to_join_points($path,$k);
my $join_area = $join_points - 1;
my $j = level_to_join_points_by_formula($k);
my $da = level_to_denclosed($k);
my $area = $path->_UNDOCUMENTED_level_to_enclosed_area($k);
my $area_next = $path->_UNDOCUMENTED_level_to_enclosed_area($k+1);
my $darea = $area_next - $area;
my $v = $path->_UNDOCUMENTED_level_to_visited($k);
my $visited = $v; # MyOEIS::path_n_to_visited($path,$n_end);
my $dvisited = $visited - $prev_visited;
my $singles = 0 && MyOEIS::path_n_to_singles($path, $n_end-1);
my $doubles = 0 && MyOEIS::path_n_to_doubles($path, $n_end-1);
print "$k join=$join_points,$j da=$area_next-$area=$da $visited $v\n";
push @values, ($dvisited-1)/2;
$prev_visited = $visited;
# dvisited = 2,1,2,4,7,13,25,47,89,171,329,635,1233,2403,4697
# dvisited-1 = 1,0,1,3,6,12,24,46,88,170,328,634,1232,2402,4696
# (dvisited-1)/2 = 0.5,0,0.5,1.5, 3,6,12,23,44,85,164,317
# (dvisited-1)/2 differs from A001630 tetranacci at k=11
}
print join(',',@values),"\n";
shift @values;
shift @values;
shift @values;
shift @values;
shift @values;
Math::OEIS::Grep->search(array => \@values);
exit 0;
sub level_to_denclosed {
my ($k) = @_;
return ($path->_UNDOCUMENTED_level_to_enclosed_area($k+1)
- $path->_UNDOCUMENTED_level_to_enclosed_area($k));
}
sub path_level_to_join_points {
my ($path, $k) = @_;
my $n_level = 2**$k;
my $join;
foreach my $n ($n_level .. 2*$n_level) {
foreach my $n ($path->xy_to_n_list($path->n_to_xy($n))) {
$join += ($n <= $n_level);
}
}
return $join;
}
}
{
# singles positions
my $path = Math::PlanePath::DragonCurve->new;
foreach my $k (0 .. 6) {
my $n_end = 2**$k;
foreach my $n (0 .. $n_end) {
my ($x,$y) = $path->n_to_xy($n) or return 0;
my @n_list = $path->xy_to_n_list($x,$y);
if (@n_list == 1
|| (@n_list == 2 && $n_list[1] > $n_end)) {
# my $n = $n ^ ($n >> 1);
my $str = sprintf "%8b", $n;
my $match = ($str =~ /0101|0001/ ? ' ****' : '');
print "$str $match\n";
}
}
print "\n";
}
exit 0;
}
{
# root of x^3 - x^2 - 2
# real root D^(1/3) + (1/9)*D^(-1/3) + 1/3 = 1.6956207695598620
# where D=28/27 + (1/9)*sqrt(29*3) = 28/27 + sqrt(29/27)
use constant D => 28/27 + sqrt(29/27);
use constant REAL_ROOT => D**(1/3) + (1/9)*D**(-1/3) + 1/3;
print "REAL_ROOT: ",REAL_ROOT,"\n";
# x^3 - x^2 - 2
# x = y+1/3
# y^3 - 1/3*y - 56/27 = 0
# y^3 + p*y + q = 0
# p=-1/3; q=-56/27
# p^3/27 + q^2/4 = 29/27
# q/2 = 28/27
# y=a-b
# a^3 - 3*b*a^2 + 3*b^2*a + p*a + -b^3 - p*b + q = 0
# a^3 - b^3 - a(3*b*a - p) + b(3*b*a - p) + q = 0
# a^3 - b^3 + (b-a)(3*b*a - p) + q = 0
# a^3 - b^3 + (a-b)(-3*b*a + p) + q = 0
# take -3*b*a + p = 0 so p = 3ab
# a^3 - b^3 + q = 0
# 27a^6 - (3ab)^3 + 27a^3q = 0 times (3a)^3
# 27a^6 - p^3 + 27a^3*q = 0
# 27a^6 + 27a^3*q - p^3 = 0 quadratic in a^3
# A = 27; B = 27*q; C = -p^3
# a^3 = (-27*q +/- sqrt((27*q)^2 - 4*27*-p^3) ) / 2*27
# = -q/2 +/- sqrt((27*q)^2 - 4*27*-p^3)/2*27
# = -q/2 +/- sqrt(q^2/4 - -p^3/27)
# a^3 = -q/2 +/- sqrt(q^2/4 + p^3/27)
#
# 27*a^3*b^3 = p^3
# b^3 = p^3/27*a^3
# b^3 = p^3 / (-q/2 +/- sqrt(q^2/4 + p^3/27))
# b^3 = p^3 * (-q/2 -/+ sqrt(q^2/4 + p^3/27))
# / 27*((-q/2)^2 - (q^2/4 + p^3/27))
# / 27*(q^2/4 - q^2/4 - p^3/27)
# / - p^3
# b^3 = q/2 +/- sqrt(q^2/4 + p^3/27)
my $p = -1/3;
my $q = -56/27;
my $a3 = -$q/2 + sqrt($q**2/4 + $p**3/27);
print "a^3 $a3\n";
my $a3poly = nearly_zero(27*($a3**2) + 27*$a3*$q - $p**3);
print "a^3 poly: $a3poly\n";
my $b3 = $q/2 + sqrt($q**2/4 + $p**3/27);
my $b3p = $p**3 / (27*$a3);
print "b^3 $b3 $b3p\n";
my $a = cbrt($a3);
my $b = cbrt($b3);
print "a $a b $b\n";
print "a-b ",$a-$b,"\n";
my $y = cbrt(-$q/2 + sqrt($p**3/27 + $q**2/4))
- cbrt($q/2 + sqrt($p**3/27 + $q**2/4));
print "y $y\n";
my $ypoly = nearly_zero($y**3 - 1/3*$y - 56/27);
print "y poly $ypoly\n";
my $x = $y+1/3;
print "x $x\n";
my $xpoly = nearly_zero($x**3 - $x&&2 - 2);
print "x poly $xpoly\n";
# y = cbrt(28/27 + sqrt(29/27)) + cbrt(28/27 - sqrt(29/27))
# x = 1/3 + cbrt(28/27 + sqrt(29/27)) + cbrt(28/27 - sqrt(29/27))
my $yf = cbrt(28/27 + sqrt(29/27)) + cbrt(28/27 - sqrt(29/27));
my $xf = 1/3 + cbrt(28/27 + sqrt(29/27)) + cbrt(28/27 - sqrt(29/27));
print "yf $yf\n";
print "xf $xf\n";
# cbrt(x)=(x^(1/3))
# f = 1/3 + cbrt(28/27 + sqrt(29/27)) + cbrt(28/27 - sqrt(29/27))
# (x^3 - x^2 - 2)/(x-f)
# x^3 - x^2 - 2 quot = x^2
# - x^3 + x^2*f
# = (-1+f)x^2 - 2 quot = x^2 + (-1+f)x
# - (-1+f)x^2 + (-1+f)fx
# = (-1+f)fx - 2 quot = x^2 + (-1+f)x + (-1+f)f
# - (-1+f)fx + (-1+f)ff
# = 0 since (-1+f)ff = f^3-f^2 = 2
#
# (x^2 + (-1+f)*x + (-1+f)*f)*(x-f) + f^3-f^2-2
# = x^3 - x^2 - 2
#
# x^2 + (f-1)*x + f*(f-1)
# xb = (1-f + sqrt((f-1)^2 - 4f(f-1)))/2
# = (1-f + sqrt(f^2-2f+1 - 4f^2 +4f))/2
# xb = (1-f + sqrt(-3*f^2 + 2*f + 1))/2
# xb = (1-f + sqrt((3*f+1)*(-f+1)))/2
# xb^3 - xb^2 - 2
require Math::Complex;
my $f = Math::Complex->new($x);
my $xb = (1-$f + sqrt(-3*$f*$f + 2*$f + 1))/2;
my $xc = (1-$f - sqrt(-3*$f*$f + 2*$f + 1))/2;
print "xb $xb\n";
print "xc $xc\n";
my $xbpoly = ($xb**3 - $xb**2 - 2);
my $xcpoly = ($xc**3 - $xc**2 - 2);
print "xb poly $xbpoly\n";
print "xc poly $xcpoly\n";
# y^3 - 1/3*y - 56/27 = 0
# f^3 - 1/3*f - 56/27
# f = cbrt(28/27 + sqrt(29/27)) + cbrt(28/27 - sqrt(29/27))
# y^3 - 1/3*y - 56/27 - (y^2 + f*y + f^2 - 1/3)*(y-f) -(f^3-1/3*f-56/27)
# y^2 + f*y + f^2-1/3
# yb = (-f + sqrt(f^2 - 4*(f^2-1/3)))/2
# = (-f + sqrt(f^2 - 4*f^2 + 4/3))/2
# yb = (-f + sqrt(-3*f^2 + 4/3))/2
# yb^3 - 1/3*yb - 56/27
$f = Math::Complex->new($y);
my $yb = (-$f + sqrt(-3*$f*$f + 4/3))/2;
my $yc = (-$f - sqrt(-3*$f*$f + 4/3))/2;
print "yb $yb\n";
print "yc $yc\n";
my $ybpoly = nearly_zero($yb**3 - 1/3*$yb - 56/27);
my $ycpoly = nearly_zero($yc**3 - 1/3*$yc - 56/27);
print "yb poly $ybpoly\n";
print "yc poly $ycpoly\n";
# f^2 = (cbrt(28/27 + sqrt(29/27)) + cbrt(28/27 - sqrt(29/27)))^2
# = cbrt(28/27 + sqrt(29/27))^2
# + cbrt(28/27 - sqrt(29/27))^2
# + cbrt(28/27 + sqrt(29/27)) * cbrt(28/27 - sqrt(29/27))
# cbrt( (28/27 + sqrt(29/27))*(28/27 - sqrt(29/27)) )
# cbrt( (28/27)^2 - 29/27 )
exit 0;
sub nearly_zero {
my ($x) = @_;
if (abs($x) < 1e-12) {
return 0;
} else {
return $x;
}
}
}
{
# 3 8 area=2 boundary=8 right
# count=9 0,0 1,0 1,1 0,1 0,2 -1,2 -1,1 -2,1 -2,2
# 4 16 area=4 boundary=16 right
# 5 32 area=9 boundary=28 right
# 6 64 area=20 boundary=48 right
# 7 128 area=43 boundary=84 right
# 8 256 area=92 boundary=144 right
# 9 512 area=195 boundary=244 right
# 10 1024 area=408 boundary=416 right
# 11 2048 area=847 boundary=708 right
# 12 4096 area=1748 boundary=1200 right
# 13 8192 area=3587 boundary=2036 right
# 3 8 area=2 boundary=8 left
# count=9 -2,2 -2,1 -1,1 -1,2 0,2 0,1 1,1 1,0 0,0
# 4 16 area=3 boundary=12 left
# 5 32 area=5 boundary=20 left
# 6 64 area=9 boundary=36 left
# 7 128 area=15 boundary=60 left
# 8 256 area=25 boundary=100 left
# 9 512 area=43 boundary=172 left
# 10 1024 area=73 boundary=292 left
# 11 2048 area=123 boundary=492 left
# 12 4096 area=209 boundary=836 left
# 13 8192 area=355 boundary=1420 left
# Left boundary/2
# A203175 a(n) = a(n-1) + 2*a(n-3)
# Right boundary
# A227036 = whole boundary
# because R[k+1] = R[k]+L[k] = B[k-1]
my $B_by_power = sub {
my ($k) = @_;
return 3.6 * REAL_ROOT ** $k;
};
my ($R,$L,$T,$U,$V);
$R = sub {
my ($k) = @_;
die if $k < 0;
if ($k == 0) { return 1; }
{ if ($k == 1) { return 2; }
if ($k == 2) { return 4; }
if ($k == 3) { return 8; }
if ($k == 4) { return 16; }
# R[k+4] = 2*R[k+3] -R[k+2] + 2*R[k+1] - 2*R[k] ok
return 2*$R->($k-1) - $R->($k-2) + 2*$R->($k-3) - 2*$R->($k-4);
return $R->($k-1) - $R->($k-1) + $R->($k-2) + $R->($k-1) - $R->($k-2) + $R->($k-3) + $R->($k-1)-$R->($k-2) - $R->($k-4) + $R->($k-3)-$R->($k-4);
return 2*$R->($k-1) - $R->($k-2) + 2*$R->($k-3) - 2*$R->($k-4); }
return $R->($k-1) + $L->($k-1);
};
$R = Memoize::memoize($R);
$L = sub {
my ($k) = @_;
die if $k < 0;
if ($k == 0) { return 1; }
{ if ($k == 1) { return 2; }
if ($k == 2) { return 4; }
if ($k == 3) { return 8; }
# L[k+3] = L[k+2] + 2*L[k] ok
return $L->($k-1) + 2*$L->($k-3);
# L[k+3]-R[k+1] = L[k+2]-R[k] + L[k] ok
return $R->($k-2) + $L->($k-1) - $R->($k-3) + $L->($k-3); }
{ if ($k == 1) { return 2; }
return $R->($k-2) + $U->($k-2); }
return $T->($k-1);
};
$L = Memoize::memoize($L);
$T = sub {
my ($k) = @_;
die if $k < 0;
if ($k == 0) { return 2; }
return $R->($k-1) + $U->($k-1);
};
$T = Memoize::memoize($T);
$U = sub {
my ($k) = @_;
die if $k < 0;
if ($k == 0) { return 3; }
# return $U->($k-1) + $L->($k-1);
return $U->($k-1) + $V->($k-1);
};
$U = Memoize::memoize($U);
my $U2 = sub {
my ($k) = @_;
die if $k < 0;
if ($k == 0) { return 3; }
{ if ($k == 1) { return 6; }
if ($k == 2) { return 8; }
if ($k == 3) { return 12; }
if ($k == 4) { return 20; }
# U[k+4] = 2*U[k+3] -U[k+2] + 2*U[k+1] - 2*U[k] ok
return 2*$U->($k-1) - $U->($k-2) + 2*$U->($k-3) - 2*$U->($k-4);
}
# return $U->($k-1) + $L->($k-1);
return $U->($k-1) + $V->($k-1);
};
$U2 = Memoize::memoize($U2);
my $U_from_LsubR = sub {
my ($k) = @_;
die if $k < 0;
return $L->($k+2) - $R->($k);
};
$V = sub {
my ($k) = @_;
if ($k == 0) { return 3; }
return $T->($k-1);
};
$V = Memoize::memoize($V);
my $B = sub {
my ($k) = @_;
return $R->($k) + $L->($k);
};
$B = Memoize::memoize($B);
my $A = sub {
my ($k) = @_;
if ($k < 1) { return 0; }
return 2**($k-1) - $B->($k)/4;
};
foreach my $k (0 .. 20) {
print $A->($k),", ";
}
print "\n";
my $path = Math::PlanePath::DragonCurve->new;
my $prev_dl = 0;
my $prev_ddl = 0;
foreach my $k (0 .. 24) {
# my $p = MyOEIS::path_boundary_length($path, 2**$k);
# my $b = $B->($k);
# my $r = $R->($k);
# my $l = $L->($k);
# my $t = $T->($k);
# my $u = $U->($k);
# my $u2 = $U2->($k);
# my $u_lr = $U_from_LsubR->($k);
# my $v = $V->($k);
# print "$k $p $b R=$r L=$l T=$t U=$u,$u2,$u_lr V=$v\n";
# my $dl = $L->($k+1) - $L->($k);
# my $ddl = $dl - $prev_dl;
# printf "%28b\n", $ddl-$prev_ddl;
# $prev_dl = $dl;
# $prev_ddl = $ddl;
my $b = $B->($k);
my $best = $B_by_power->($k);
my $f = $b/$best;
print "$b $best $f\n";
}
exit 0;
}
{
# LLRR variation
my $reverse = sub {
my ($str) = @_;
$str = reverse $str;
$str =~ tr/+-/-+/;
return $str;
};
my $str = 'F';
while (length($str) < 8192) {
$str = $str . '+' . $reverse->($str); # unfold left
$str = $str . '+' . $reverse->($str); # unfold left
$str = $str . '-' . $reverse->($str); # unfold right
$str = $str . '-' . $reverse->($str); # unfold right
}
require Language::Logo;
my $lo = Logo->new(update => 2, port => 8200 + (time % 100));
my $draw;
$lo->command("right 45; backward 200; seth 90");
$lo->command("pendown; hideturtle");
my %char_to_command = (F => 'forward 5',
'+' => 'left 90',
'-' => 'right 90',
);
foreach my $char (split //, $str) {
### $char
$lo->command($char_to_command{$char});
}
$lo->disconnect("Finished...");
exit 0;
exit 0;
}
# {
# [0,1,S 1,1,SW 1,0,W 0,0,- ]);
# [1,1,SW 0,1,S 0,0,- 1,0,W ],
#
# [1,0,W 0,0,- 0,1,S 1,1,SW ],
# my @yx_adj_x = ([0,0,- 1,0,W 1,1,SW 0,1,S ],
# }
{
# visited 0,1
my $path = Math::PlanePath::DragonCurve->new;
foreach my $y (reverse -16 .. 16) {
foreach my $x (-32 .. 32) {
print $path->xy_is_visited($x,$y) ? 1 : 0;
}
print "\n";
}
exit 0;
}
{
foreach my $arms (1 .. 4) {
my $path = Math::PlanePath::DragonCurve->new (arms => $arms);
foreach my $x (-50 .. 50) {
foreach my $y (-50 .. 50) {
my $v = !! $path->xy_is_visited($x,$y);
my $n = defined($path->xy_to_n($x,$y));
$v == $n || die "arms=$arms x=$x,y=$y";
}
}
}
exit 0;
}
{
my @m = ([0,0,0,0],[0,0,0,0],[0,0,0,0],[0,0,0,0]);
foreach my $arms (1 .. 4) {
my $path = Math::PlanePath::DragonCurve->new (arms => $arms);
foreach my $x (-50 .. 50) {
foreach my $y (-50 .. 50) {
next if $x == 0 && $y == 0;
my $xm = $x+$y;
my $ym = $y-$x;
my $a1 = Math::PlanePath::DragonMidpoint::_xy_to_arm($xm,$ym);
my $a2 = Math::PlanePath::DragonMidpoint::_xy_to_arm($xm-1,$ym+1);
$m[$a1]->[$a2] = 1;
}
}
}
foreach my $i (0 .. $#m) {
my $aref = $m[$i];
print "$i ",@$aref,"\n";
}
exit 0;
}
{
require Devel::TimeThis;
require Math::PlanePath::DragonMidpoint;
foreach my $arms (1 .. 4) {
my $path = Math::PlanePath::DragonCurve->new (arms => $arms);
{
my $t = Devel::TimeThis->new("xy_is_visited() arms=$arms");
foreach my $x (0 .. 50) {
foreach my $y (0 .. 50) {
$path->xy_is_visited($x,$y);
}
}
}
{
my $t = Devel::TimeThis->new("xy_to_n() arms=$arms");
foreach my $x (0 .. 50) {
foreach my $y (0 .. 50) {
$path->xy_to_n($x,$y);
}
}
}
}
exit 0;
}
{
# Dir4 is count_runs_1bits()
require Math::NumSeq::PlanePathDelta;
my $path = Math::PlanePath::DragonCurve->new;
my $dir4_seq = Math::NumSeq::PlanePathDelta->new (planepath_object => $path,
delta_type => 'Dir4');
foreach my $n (0 .. 64) {
my $d = $dir4_seq->ith($n);
my $c = count_runs_1bits($n*2+1) % 4;
printf "%2d %d %d\n", $n, $d, $c;
}
my $n = 0b1100111101;
print join(',',$path->n_to_dxdy($n)),"\n";
exit 0;
}
{
# drawing two towards centre segment order
my @values;
print "\n";
my $draw;
$draw = sub {
my ($from, $to) = @_;
my $mid = ($from + $to) / 2;
if ($mid != int($mid)) {
push @values, min($from,$to);
} else {
$draw->($from,$mid);
$draw->($to,$mid);
}
};
$draw->(0, 64);
print join(',',@values),"\n";
my %seen;
foreach my $value (@values) {
if ($seen{$value}++) {
print "duplicate $value\n";
}
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values);
foreach my $i (0 .. $#values) {
printf "%2d %7b\n", $i, $values[$i];
}
exit 0;
}
{
# drawing two towards centre with Language::Logo
require Language::Logo;
require Math::NumSeq::PlanePathTurn;
my $lo = Logo->new(update => 20, port => 8200 + (time % 100));
my $draw;
$lo->command("backward 130; hideturtle");
$draw = sub {
my ($level, $length) = @_;
if (--$level < 0) {
$lo->command("pendown; forward $length; penup; backward $length");
return;
}
my $sidelen = $length / sqrt(2);
$lo->command("right 45");
$draw->($level,$sidelen);
$lo->command("left 45");
$lo->command("penup; forward $length");
$lo->command("right 135");
$draw->($level,$sidelen);
$lo->command("left 135");
$lo->command("penup; backward $length");
};
$draw->(8, 300);
$lo->disconnect("Finished...");
exit 0;
}
# {
# # X,Y recurrence n = 2^k + rem
# # X+iY(n) = (i+1)^k + (i+1)^k +
# my $w = 8;
# my $path = Math::PlanePath::DragonCurve->new;
# foreach my $n (0 .. 1000) {
# my ($x,$y) = $path->n_to_xy($n);
#
# }
# exit 0;
#
sub high_bit {
my ($n) = @_;
my $bit = 1;
while ($bit <= $n) {
$bit <<= 1;
}
return $bit >> 1;
}
# }
{
# d(2n) = d(n)*(i+1)
# d(2n+1) = d(2n) + 1-(transitions(2*$n) % 4)
# 2n to 2n+1 is always horizontal
# transitions(2n) is always even since return to 0 at the low end
#
# X(2n-1) \ = X(n)
# X(2n) /
# X(2n+1) \ = X(2n) + (-1) ** count_runs_1bits($n)
# X(2n+2) /
#
# X(2n-1) \ = X(n)
# X(2n) /
# X(2n+1) \ = X(2n) + (-1) ** count_runs_1bits($n)
# X(2n+2) /
# X(n) = cumulative dx = (-1) ** count_runs_1bits(2n)
# Y(n) = cumulative dy = (-1) ** count_runs_1bits(2n+1)
# Dragon delta = bisection of count runs 1s
# Alternate delta = bisection of count even runs 1s
{
require Math::NumSeq::OEIS;
my $seq = Math::NumSeq::OEIS->new(anum=>'A005811'); # num runs
my @array;
sub A005811 {
my ($i) = @_;
while ($#array < $i) {
my ($i,$value) = $seq->next;
$array[$i] = $value;
}
return $array[$i];
}
}
my $path = Math::PlanePath::DragonCurve->new;
foreach my $n (0 .. 32) {
my ($x,$y) = $path->n_to_xy(2*$n+1);
my ($x1,$y1) = $path->n_to_xy(2*$n+2);
my $dx = $x1-$x;
my $dy = $y1-$y;
# my $transitions = transitions(2*$n);
# my $c = 1 - (A005811(2*$n) % 4);
# my $c = 1 - 2*(count_runs_1bits(2*$n) % 2);
# my $c = (count_runs_1bits($n)%2 ? -1 : 1);
# my $c = 2-(transitions(2*$n+1) % 4); # Y
# my $c = (-1) ** count_runs_1bits(2*$n); # X
my $c = - (-1) ** count_runs_1bits(2*$n+1); # Y
printf "%6b %2d,%2d %d\n", $n, $dx,$dy, $c;
}
print "\n";
exit 0;
}
{
# Recurrence high to low.
# d(2^k + rem) = (i+1)^(k+1) - i*d(2^k-rem)
# = (i+1) * (i+1)^k - i*d(2^k-rem)
# = (i+1)^k + i*(i+1)^k - i*d(2^k-rem)
# = (i+1)^k + i*((i+1)^k - d(2^k-rem))
require Math::Complex;
# print mirror_across_k(Math::Complex->make(2,0),3);
# exit 0;
my $path = Math::PlanePath::DragonCurve->new;
foreach my $n (0 .. 32) {
my ($x,$y) = $path->n_to_xy($n);
my $p = Math::Complex->make($x,$y);
my $d = calc_d_by_high($n);
printf "%6b %8s %8s %s\n", $n, $p,$d, $p-$d;
}
print "\n";
exit 0;
sub calc_d_by_high {
my ($n) = @_;
if ($n == 0) { return 0; }
my $k = high_bit_pos($n);
my $pow = 1<<$k;
my $rem = $n - $pow;
### $k
### $rem
if ($rem == 0) {
return i_plus_1_pow($k);
} else {
return i_plus_1_pow($k+1)
+ Math::Complex->make(0,-1) * calc_d_by_high($pow-$rem);
}
}
sub high_bit_pos {
my ($n) = @_;
die "high_bit_pos $n" if $n <= 0;
my $bit = 1;
my $pos = 0;
while ($n > 1) {
$n >>= 1;
$pos++;
}
return $pos;
}
sub i_plus_1_pow {
my ($k) = @_;
my $b = Math::Complex->make(1,1);
my $c = Math::Complex->make(1);
for (1 .. $k) { $c *= $b; }
return $c;
}
# # no, not symmetric lengthwise
# return i_plus_1_pow($k)
# + Math::Complex->make(0,1) * mirror_across_k(calc_d_by_high($rem),
# 4-$k);
sub mirror_across_k {
my ($c,$k) = @_;
$k %= 8;
$c *= i_plus_1_pow(8-$k);
# ### c: "$c"
$c = ~$c; # conjugate
# ### conj: "$c"
$c *= i_plus_1_pow($k);
# ### mult: "$c"
$c /= 16; # i_plus_1_pow(8) == 16
# ### ret: "$c"
return $c;
}
}
{
# total turn = count 0<->1 transitions of N bits
sub count_runs_1bits {
my ($n) = @_;
my $count = 0;
for (;;) {
last unless $n;
while ($n % 2 == 0) { $n/=2; }
$count++;
while ($n % 2 == 1) { $n-=1; $n/=2; }
}
return $count;
}
# return how many places there are where n bits change 0<->1
sub transitions {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += (($n & 3) == 1 || ($n & 3) == 2);
$n >>= 1;
}
return $count
}
sub transitions2 {
my ($n) = @_;
my $m = low_ones_mask($n);
$n ^= $m; # zap to zeros
my $count = ($m!=0);
while ($n) {
### assert: ($n&1)==0
$m = low_zeros_mask($n);
$n |= $m; # fill to ones
$count++;
$m = low_ones_mask($n);
$n ^= $m; # zap to zeros
$count++;
last unless $n;
}
return $count
}
sub transitions3 {
my ($n) = @_;
my $count = 0;
return count_1_bits($n^($n>>1));
}
sub low_zeros_mask {
my ($n) = @_;
die if $n == 0;
return ($n ^ ($n-1)) >> 1;
}
### assert: low_zeros_mask(1)==0
### assert: low_zeros_mask(2)==1
### assert: low_zeros_mask(3)==0
### assert: low_zeros_mask(4)==3
### assert: low_zeros_mask(12)==3
### assert: low_zeros_mask(10)==1
sub low_ones_mask {
my ($n) = @_;
return ($n ^ ($n+1)) >> 1;
}
### assert: low_ones_mask(1)==1
### assert: low_ones_mask(2)==0
### assert: low_ones_mask(3)==3
### assert: low_ones_mask(5)==1
sub count_1_bits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += ($n&1);
$n >>= 1;
}
return $count;
}
my $path = Math::PlanePath::DragonCurve->new;
require Math::NumSeq::PlanePathDelta;
my $dir4_seq = Math::NumSeq::PlanePathDelta->new (planepath_object => $path,
delta_type => 'Dir4');
require Math::NumSeq::PlanePathTurn;
my $turn_seq = Math::NumSeq::PlanePathTurn->new (planepath_object => $path,
turn_type => 'LSR');
my $total_turn = 0;
for (my $n = 0; $n < 16; ) {
my $t = transitions($n);
my $t2 = transitions2($n);
my $t3 = transitions3($n);
my $good = ($t == $t2 && $t2 == $t3 && $t == $total_turn
? 'good'
: '');
my $dir4 = $dir4_seq->ith($n);
my ($x,$y) = $path->n_to_xy($n);
my $turn = $turn_seq->ith($n+1);
printf "%2d xy=%2d,%2d d=%d total=%d turn=%+d %d,%d,%d %s\n",
$n,$x,$y, $dir4, $total_turn, $turn, $t,$t2,$t3, $good;
$total_turn += $turn;
$n++;
}
exit 0;
}
{
# X,Y recursion
my $w = 8;
my $path = Math::PlanePath::DragonCurve->new;
foreach my $offset (0 .. $w-1) {
my $n = $path->n_start + $offset;
foreach (1 .. 10) {
my ($x,$y) = $path->n_to_xy($n);
print "$x ";
$n += $w;
}
print "\n";
}
exit 0;
}
{
# Midpoint tiling, text lines
require Math::PlanePath::DragonMidpoint;
require Image::Base::Text;
my $scale = 1;
my $arms = 4;
my $path = Math::PlanePath::DragonMidpoint->new (arms => $arms);
my $width = 64;
my $height = 32;
my $xoffset = $width/2;
my $yoffset = $height/2;
my $image = Image::Base::Text->new (-width => $width,
-height => $height);
my ($nlo,$nhi) = $path->rect_to_n_range(-$xoffset,-$yoffset,
$xoffset,$yoffset);
$nhi = 16384;
print "nhi $nhi\n";
for (my $n = 0; $n <= $nhi; $n++) {
# next if int($n/$arms) % 2;
next unless int($n/$arms) % 2;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+$arms);
my $colour = ($x1 == $x2 ? '|' : '-');
$x1 *= $scale;
$x2 *= $scale;
$y1 *= $scale;
$y2 *= $scale;
$x1 += $xoffset;
$x2 += $xoffset;
$y1 += $yoffset;
$y2 += $yoffset;
$image->line($x1,$y1,$x2,$y2,$colour);
}
$image->save('/dev/stdout');
exit 0;
}
{
# Midpoint tiling, text grid
require Math::PlanePath::DragonMidpoint;
require Image::Base::Text;
my $scale = 2;
my $arms = 4;
my $path = Math::PlanePath::DragonMidpoint->new (arms => $arms);
my $width = 64;
my $height = 32;
my $xoffset = $width/2 - 9;
my $yoffset = $height/2 - 10;
my $image = Image::Base::Text->new (-width => $width,
-height => $height);
my ($nlo,$nhi) = $path->rect_to_n_range(-$xoffset,-$yoffset,
$xoffset,$yoffset);
$nhi = 16384;
print "nhi $nhi\n";
for (my $n = 0; $n <= $nhi; $n++) {
# next if int($n/$arms) % 2;
next unless int($n/$arms) % 2;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+$arms);
$y1 = -$y1;
$y2 = -$y2;
my $colour = ($x1 == $x2 ? '|' : '-');
($x1,$x2) = (min($x1,$x2),max($x1,$x2));
($y1,$y2) = (min($y1,$y2),max($y1,$y2));
$x1 *= $scale;
$x2 *= $scale;
$y1 *= $scale;
$y2 *= $scale;
$x1 -= $scale/2;
$x2 += $scale/2;
$y1 -= $scale/2;
$y2 += $scale/2;
$x1 += $xoffset;
$x2 += $xoffset;
$y1 += $yoffset;
$y2 += $yoffset;
### rect: $x1,$y1,$x2,$y2
$image->rectangle($x1,$y1,$x2,$y2,'*');
}
$image->save('/dev/stdout');
exit 0;
}
{
# turn sequence by d(2n) etc
require Math::NumSeq::PlanePathTurn;
my $seq = Math::NumSeq::PlanePathTurn->new(planepath=>'DragonCurve',
turn_type => 'Right');
foreach my $n (0 .. 16) {
my $dn = dseq($n);
my $turn = $seq->ith($n) // 'undef';
print "$n $turn $dn\n";
}
exit 0;
# Knuth vol 2 answer to 4.5.3 question 41, page 607
sub dseq {
my ($n) = @_;
for (;;) {
if ($n == 0) {
return 1;
}
if (($n % 2) == 0) {
$n >>= 1;
next;
}
if (($n % 4) == 1) {
return 0; # bit above lowest 1-bit
}
if (($n % 4) == 3) {
return 1; # bit above lowest 1-bit
}
}
}
}
{
# rect range exact
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
my @digit_to_rev = (0,5,0,5,undef,
5,0,5,0);
my @min_digit_to_rot = (-1,1,1,-1,0,
0,1,-1,-1,1);
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### DragonCurve rect_to_n_range(): "$x1,$y1 $x2,$y2"
my $xmax = int(max(abs($x1),abs($x2)));
my $ymax = int(max(abs($y1),abs($y2)));
my ($level_power, $level_max)
= round_down_pow (($xmax*$xmax + $ymax*$ymax + 1) * 7,
2);
### $level_power
### $level_max
if (is_infinite($level_max)) {
return (0, $level_max);
}
my $zero = $x1 * 0 * $y1 * $x2 * $y2;
my $initial_len = 2**$level_max;
### $initial_len
my ($len, $rot, $x, $y);
my $overlap = sub {
my $extent = ($len == 1 ? 0 : 2*$len);
### overlap consider: "xy=$x,$y extent=$extent"
return ($x + $extent >= $x1
&& $x - $extent <= $x2
&& $y + $extent >= $y1
&& $y - $extent <= $y2);
};
my $find_min = sub {
my ($initial_rev, $extra_rot) = @_;
### find_min() ...
### $initial_rev
### $extra_rot
$rot = $level_max + 1 + $extra_rot;
$len = $initial_len;
if ($initial_rev) {
$rot += 2;
$x = 2*$len * $dir4_to_dx[($rot+2)&3];
$y = 2*$len * $dir4_to_dy[($rot+2)&3];
} else {
$x = $zero;
$y = $zero;
}
my @digits = (-1); # high to low
my $rev = $initial_rev;
for (;;) {
my $digit = ++$digits[-1];
### min at: "digits=".join(',',@digits)." xy=$x,$y len=$len rot=".($rot&3)." rev=$rev"
unless ($initial_rev) {
my $nlo = _digit_join_hightolow ([@digits,(0)x($level_max-$#digits)], 4, $zero);
my ($nx,$ny) = $self->n_to_xy($nlo);
my ($nextx,$nexty) = $self->n_to_xy($nlo + $len*$len);
### nlo: "nlo=$nlo xy=$nx,$ny next xy=$nextx,$nexty"
### assert: $x == $nx
### assert: $y == $ny
# ### assert: $nextx == $nx + ($dir4_to_dx[$rot&3] * $len)
# ### assert: $nexty == $ny + ($dir4_to_dy[$rot&3] * $len)
}
$rot += $min_digit_to_rot[$digit+$rev];
### $digit
### rot increment: $min_digit_to_rot[$digit+$rev]." to $rot"
if ($digit > 3) {
pop @digits;
if (! @digits) {
### not found to level_max ...
if ($x1 <= 0 && $x2 >= 0 && $y1 <= 0 && $y2 >= 0) {
### origin covered: 4**($level_max+1)
return 4**$level_max;
} else {
return;
}
}
$rev = (@digits < 2 ? $initial_rev
: $digits[-2]&1 ? 5 : 0);
### past digit=3, backtrack ...
$len *= 2;
next;
}
if (&$overlap()) {
if ($#digits >= $level_max) {
### yes overlap, found n_lo ...
last;
}
### yes overlap, descend ...
### apply rev: "digit=$digit rev=$rev xor=$digit_to_rev[$digit+$rev]"
push @digits, -1;
$rev = ($digit & 1 ? 5 : 0);
$len /= 2;
# {
# my $state = 0;
# foreach (@digits) { if ($_&1) { $state ^= 5 } }
# ### assert: $rev == $state
# }
} else {
### no overlap, next digit ...
$rot &= 3;
$x += $dir4_to_dx[$rot] * $len;
$y += $dir4_to_dy[$rot] * $len;
}
}
### digits: join(',',@digits)
### found n_lo: _digit_join_hightolow (\@digits, 4, $zero)
return _digit_join_hightolow (\@digits, 4, $zero);
};
my $arms = $self->{'arms'};
my @n_lo;
foreach my $arm (0 .. $arms-1) {
if (defined (my $n = &$find_min(0,$arm))) {
push @n_lo, $n*$arms + $arm;
}
}
if (! @n_lo) {
return (1,0); # rectangle not visited by curve
}
my $n_top = 4 * $level_power * $level_power;
### $n_top
my @n_hi;
foreach my $arm (0 .. $arms-1) {
if (defined (my $n = &$find_min(5,$arm))) {
push @n_hi, ($n_top-$n)*$arms + $arm;
}
}
return (min(@n_lo), max(@n_hi));
}
my $path = Math::PlanePath::DragonCurve->new (arms => 4);
foreach my $n (4 .. 1000) {
my ($x,$y) = $path->n_to_xy($n);
my @n_list = $path->xy_to_n_list($x,$y);
my $want_lo = min(@n_list);
my $want_hi = max(@n_list);
my ($lo,$hi) = rect_to_n_range ($path, $x,$y, $x,$y);
print "n=$n lo=$lo wantlo=$want_lo hi=$hi wanthi=$want_hi\n";
if ($lo != $want_lo) {
die "n=$n lo=$lo wantlo=$want_lo";
}
if ($hi != $want_hi) {
die "n=$n hi=$hi wanthi=$want_hi";
}
}
exit 0;
}
{
# level to ymax, xmin
my $path = Math::PlanePath::DragonCurve->new;
my $target = 4;
my $xmin = 0;
my $ymax = 0;
for (my $n = 0; $n < 2**28; $n++) {
my ($x,$y) = $path->n_to_xy($n);
$xmin = min($x,$xmin);
$ymax = max($y,$ymax);
if ($n == $target) {
printf "%7d %14b %14b\n", $n, -$xmin, $ymax;
$target *= 2;
}
}
exit 0;
}
{
# upwards
# 9----8 5---4
# | | | |
# 10--11,7---6 3---2
# | |
# 16 13---12 0---1
# | |
# 15---14
#
#
#
# 8-----> 4
# | ^
# | |
# 16-----> v |
#
#
#
# 2*(4^2-1)/3 = 10 0b1010
# 4*(4^2-1)/3 = 20 0b10100
#
# (2^3+1)/3
# (2^4-1)/3
# (2^5-2)/3 = 10
# (2^6-4)/3 = 20
# (2^7-2)/3 = 42 = 101010
# (2^8-4)/3 = 84 = 1010100
#
# # new xmax = xmax or ymax
# # new xmin = ymin-4
# # new ymax = ymax or -ymin or 2-xmin
# # new ymin = ymin or -ymax or -xmax
#
# 16
# |
# |
# v
# xmin seg 2 <---8
# |
# |
# v
# --->4 xmax seg0
#
# ymin seg 0
#
# new xmax = len + -xmin
# = len + -ymin
# new xmin = - xmax
# new ymax = 2len + (-ymin) only candidate
# new ymin = -(ymax-len)
#
# xmax,xmin alternate
# ymax-len,ymin alternate
my $xmin = 0;
my $xmax = 0;
my $ymin = 0;
my $ymax = 0;
my $len = 1;
my $exp = 8;
print "level xmin xmax xsize | ymin ymax ysize\n";
for (0 .. $exp) {
printf "%2d %-10s %-10s = %-10s | %-10s %-10s = %-10s\n",
$_,
to_bin($xmin),to_bin($xmax), to_bin(-$xmin+$xmax),
to_bin($ymin),to_bin($ymax), to_bin(-$ymin+$ymax);
my @xmax_candidates = ($ymax, # seg 0 across
$len-$xmin, # seg 1 side <---
$len-$ymin, # seg 2 before <---
);
my $xmax_seg = max_index(@xmax_candidates);
my $xmax_candstr = join(',',@xmax_candidates);
my @xmin_candidates = ($ymin, # seg 0 before
-($ymax-$len), # seg 2 across
-$xmax, # seg 3 side <---
);
my $xmin_seg = min_index(@xmin_candidates);
my $xmin_candstr = join(',',@xmin_candidates);
my @ymin_candidates = (-$xmax, # seg 0 side <---
-($ymax-$len)); # seg 1 extend
my $ymin_seg = min_index(@ymin_candidates);
my $ymin_candstr = join(',',@ymin_candidates);
print "$_ xmax ${xmax_seg}of$xmax_candstr xmin ${xmin_seg}of$xmin_candstr ymin ${ymin_seg}of$ymin_candstr\n";
($xmax,$xmin, $ymax,$ymin)
= (
# xmax
max ($ymax, # seg 0 across
$len-$xmin, # seg 1 side
$len-$ymin, # seg 2 before
),
# xmin
min ($ymin, # seg 0 before
$len-$ymax, # seg 2 across
-$xmax, # seg 3 side
),
# ymax
2*$len-$ymin, # seg 3 before
# ymin
min(-$xmax, # seg 0 side
-($ymax-$len))); # seg 1 extend
### assert: $xmin <= 0
### assert: $ymin <= 0
### assert: $xmax >= 0
### assert: $ymax >= 0
$len *= 2;
}
print 3*$xmin/$len+.001," / 3\n";
print 6*$xmax/$len+.001," / 6\n";
print 3*$ymin/$len+.001," / 3\n";
print 3*$ymax/$len+.001," / 3\n";
exit 0;
sub min_index {
my $min_value = $_[0];
my $ret = 0;
foreach my $i (1 .. $#_) {
my $next = $_[$i];
if ($next == $min_value) {
$ret .= ",$i";
} elsif ($next < $min_value) {
$ret = $i;
$min_value = $next;
}
}
return $ret;
}
sub max_index {
### max_index(): @_
my $max_value = $_[0];
my $ret = 0;
foreach my $i (1 .. $#_) {
my $next = $_[$i];
### $next
if ($next == $max_value) {
### append ...
$ret .= ",$i";
} elsif ($next > $max_value) {
### new max ...
$ret = $i;
$max_value = $next;
}
}
return $ret;
}
}
# n_to_xy ...
# {
# # low to high
# my $rev = 0;
# my @rev;
# foreach my $digit (reverse @digits) {
# push @rev, $rev;
# $rev ^= $digit;
# }
# ### @digits
# my $x = 0;
# my $y = 0;
# my $dy = $rot & 1;
# my $dx = ! $dy;
# if ($rot & 2) {
# $dx = -$dx;
# $dy = -$dy;
# }
# $rev = 0;
# foreach my $digit (@digits) {
# ### at: "$x,$y dxdy=$dx,$dy"
# my $rev = shift @rev;
# if ($digit) {
# if ($rev) {
# ($x,$y) = (-$y,$x); # rotate +90
# } else {
# ($x,$y) = ($y,-$x); # rotate -90
# }
# $x += $dx;
# $y += $dy;
# $rev = $digit;
# }
# # multiply i+1, ie. (dx,dy) = (dx + i*dy)*(i+1)
# ($dx,$dy) = ($dx-$dy, $dx+$dy);
# }
# ### final: "$x,$y dxdy=$dx,$dy"
# return ($x,$y);
# }
{
# inner rectangle touching
# | |
# 751-750 735-734 431-
#
#
#
# 382-383
# |
# 380-385-384
# |
# 379-386-387
# |
# 376-377-388
# |
# 375-374 371-
#
# 368
#
# 367-
#
# 9-- 8 5-- 4
# | |
# 10--11-- 6 3-- 2 190-191
# | |
# 17--16 13--12 0-- 1 188-193-192
# | | |
# 18--19- 22--23 187-194-195
# | | |
# 20- 25--24 184-185-196
# | |
# 26--27 46--47 94--95 183-182-179-
# | | | |
# 33--32 29- 44- 49--48 92- 97--96 108-113-176
# | | | | |
# 34--35- 38- 43- 50--51 54- 91- 98--99 102-107-114-175-
# | | | | | | |
# 36--37 40--41 52- 57- 88--89-100-101 104-105 116
# | |
# 58- 87--86- 83--82
# | |
# 65--64 61- 76--77 80--81 129-128
# | | |
# 66--67- 70- 75--74 130-131-134
# | | |
# 68--69 72--73 132
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
foreach my $k (0 .. 5) {
my $level = 2*$k;
my $Nlevel = 2**$level;
print "k=$k level=$level Nlevel=$Nlevel\n";
# my $c1x = 2**$k - calc_Wmax($k); # <--
# my $c1y = 2**$k + calc_Wmin($k); # <--
# my $c2x = 2**($k+1) - calc_Wmax($k+1);
# my $c2y = 2**($k+1) + calc_Wmin($k+1);
# my $c3x = 2**($k+2) - calc_Wmax($k+2); # <--
# my $c3y = 2**($k+2) + calc_Wmin($k+2); # <--
my $c1x = calc_Wouter($k); # <--
my $c1y = calc_Louter($k); # <--
my $c2x = calc_Wouter($k+1);
my $c2y = calc_Louter($k+1);
my $c3x = calc_Wouter($k+2); # <--
my $c3y = calc_Louter($k+2); # <--
my $step_c2x = 2*$c1x - !($k&1);
unless ($step_c2x == $c2x) {
warn "step X $step_c2x != $c2x";
}
my $step_c2y = 2*$c1y - ($k&1);
unless ($step_c2y == $c2y) {
warn "step Y $step_c2y != $c2y";
}
my $step_c3x = 4 * $c1x - 2 + ($k&1);
unless ($step_c3x == $c3x) {
warn "step X $step_c3x != $c3x";
}
my $step_c3y = 4 * $c1y - 1 - ($k & 1);
unless ($step_c3y == $c3y) {
warn "step Y $step_c3y != $c3y";
}
unless ($c1y == $c2x) {
warn "diff $c1y $c2x";
}
unless ($c2y == $c3x) {
warn "diff $c2y $c3x";
}
my $xmax = $c1x;
my $ymax = $c1y;
my $xmin = -$c3x;
my $ymin = -$c3y;
print " C1 x=$xmax,y=$ymax C2 x=$c2x,y=$c2y C3 x=$c3x,y=$c3y\n";
print " out x=$xmin..$xmax y=$ymin..$ymax\n";
foreach (1 .. $k) {
print " rotate\n";
($xmax, # rotate +90
$ymax,
$xmin,
$ymin) = (-$ymin,
$xmax,
-$ymax,
$xmin);
}
print " out x=$xmin..$xmax y=$ymin..$ymax\n";
my $in_xmax = $xmax - 1;
my $in_xmin = $xmin + 1;
my $in_ymax = $ymax - 1;
my $in_ymin = $ymin + 1;
print " in x=$in_xmin..$in_xmax y=$in_ymin..$in_ymax\n";
# inner edges, Nlevel or higher is bad
foreach my $y ($in_ymax, $in_ymin) {
foreach my $x ($in_xmin .. $in_xmax) {
foreach my $n ($path->xy_to_n_list ($x, $y)) {
if ($n >= $Nlevel) {
print "$n $x,$y horiz ***\n";
}
}
}
}
# inner edges, Nlevel or higher is bad
foreach my $x ($in_xmax, $in_xmin) {
foreach my $y ($in_ymin .. $in_ymax) {
foreach my $n ($path->xy_to_n_list ($x, $y)) {
if ($n >= $Nlevel) {
print "$n $x,$y vert ***\n";
}
}
}
}
# outer edges, Nlevel or higher touched
my $touch = 0;
foreach my $y ($ymax, $ymin) {
foreach my $x ($xmin .. $xmax) {
foreach my $n ($path->xy_to_n_list ($x, $y)) {
if ($n >= $Nlevel) {
$touch++;
}
}
}
}
# inner edges, Nlevel or higher is bad
foreach my $x ($xmax, $xmin) {
foreach my $y ($ymin .. $ymax) {
foreach my $n ($path->xy_to_n_list ($x, $y)) {
if ($n >= $Nlevel) {
$touch++;
}
}
}
}
my $diff_touch = ($touch == 0 ? ' ***' : '');
print " touch $touch$diff_touch\n";
}
exit 0;
sub calc_Louter {
my ($k) = @_;
# Louter = 2^k - abs(Lmin)
# = 2^k - (2^k - 1 - (k&1))/3
# = (3*2^k - (2^k - 1 - (k&1)))/3
# = (3*2^k - 2^k + 1 + (k&1))/3
# = (2*2^k + 1 + (k&1))/3
return (2*2**$k + 1 + ($k&1)) / 3;
# return 2**$k + calc_Lmin($k);
}
sub calc_Wouter {
my ($k) = @_;
# Wouter = 2^k - Wmax
# = 2^k - (2*2^k - 2 + (k&1)) / 3
# = (3*2^k - (2*2^k - 2 + (k&1))) / 3
# = (3*2^k - 2*2^k + 2 - (k&1)) / 3
# = (2^k + 2 - (k&1)) / 3
return (2**$k + 2 - ($k&1)) / 3;
# return 2**$k - calc_Wmax($k);
}
sub calc_Lmax {
my ($k) = @_;
# Lmax = (7*2^k - 4)/6 if k even
# (7*2^k - 2)/6 if k odd
if ($k & 1) {
return (7*2**$k - 2) / 6;
} else {
return (7*2**$k - 4) / 6;
}
}
sub calc_Lmin {
my ($k) = @_;
# Lmin = - (2^k - 1)/3 if k even
# - (2^k - 2)/3 if k odd
# = - (2^k - 2 - (k&1))/3
if ($k & 1) {
return - (2**$k - 2) / 3;
} else {
return - (2**$k - 1) / 3;
}
}
sub calc_Wmax {
my ($k) = @_;
# Wmax = (2*2^k - 1) / 3 if k odd
# (2*2^k - 2) / 3 if k even
# = (2*2^k - 2 + (k&1)) / 3
if ($k & 1) {
return (2*2**$k - 1) / 3;
} else {
return (2*2**$k - 2) / 3;
}
}
sub calc_Wmin {
my ($k) = @_;
return calc_Lmin($k);
}
}
{
# inner Wmin/Wmax
foreach my $k (0 .. 10) {
my $wmax = calc_Wmax($k);
my $wmin = calc_Wmin($k);
my $submax = 2**$k - $wmax;
my $submin = 2**$k + $wmin;
printf "%2d %4d %4d %4d %4d\n",
$k, abs($wmin), $wmax, $submax, $submin;
# printf "%2d %8b %8b %8b %8b\n",
# $k, abs($wmin), $wmax, $submax, $submin;
}
exit 0;
}
{
# width,height extents
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my @xend = (1);
my @yend = (0);
my @xmin = (0);
my @xmax = (1);
my @ymin = (0);
my @ymax = (0);
extend();
sub extend {
my $xend = $xend[-1];
my $yend = $yend[-1];
($xend,$yend) = ($xend-$yend, # rotate +45
$xend+$yend);
push @xend, $xend;
push @yend, $yend;
my $xmax = $xmax[-1];
my $xmin = $xmin[-1];
my $ymax = $ymax[-1];
my $ymin = $ymin[-1];
### assert: $xmax >= $xmin
### assert: $ymax >= $ymin
# ### at: "end=$xend,$yend $xmin..$xmax $ymin..$ymax"
push @xmax, max($xmax, $xend + $ymax);
push @xmin, min($xmin, $xend + $ymin);
push @ymax, max($ymax, $yend - $xmin);
push @ymin, min($ymin, $yend - $xmax);
}
my $level = 0;
my $n_level = 1;
my $n = 0;
my $xmin = 0;
my $xmax = 0;
my $ymin = 0;
my $ymax = 0;
my $prev_r = 1;
for (;;) {
my ($x,$y) = $path->n_to_xy($n);
$xmin = min($xmin,$x);
$xmax = max($xmax,$x);
$ymin = min($ymin,$y);
$ymax = max($ymax,$y);
if ($n == $n_level) {
my $width = $xmax - $xmin + 1;
my $height = $ymax - $ymin + 1;
my $r = ($width/2)**2 + ($height/2)**2;
my $rf = $r / $prev_r;
my $xmin2 = to_bin($xmin);
my $ymin2 = to_bin($ymin);
my $xmax2 = to_bin($xmax);
my $ymax2 = to_bin($ymax);
my $xrange= sprintf "%9s..%9s", $xmin2, $xmax2;
my $yrange= sprintf "%9s..%9s", $ymin2, $ymax2;
printf "%2d n=%-7d %19s %19s r=%.2f (%.3f)\n",
$level, $n, $xrange, $yrange, $r, $rf;
extend();
$xrange="$xmin[$level]..$xmax[$level]";
$yrange="$ymin[$level]..$ymax[$level]";
# printf " %9s %9s\n",
# $xrange, $yrange;
$level++;
$n_level *= 2;
$prev_r = $r;
last if $level > 30;
}
$n++;
}
exit 0;
sub to_bin {
my ($n) = @_;
return ($n < 0 ? '-' : '') . sprintf('%b', abs($n));
}
}
{
# diagonal
#
# |---8
# |
# v
# 6<--
# |
# |
# 0 |---4
# | |
# | v
# |-->2
#
# new xmax = ymax or -ymin or 2L-xmin
# new xmin = ymin
# new ymax = 2L-ymin
# new ymin = -xmax or -ymax same
my $xmax = 1;
my $xmin = 0;
my $ymax = 1;
my $ymin = 0;
my $len = 1;
my $exp = 8;
for (1 .. $exp) {
printf "%2d %-18s %-18s %-18s %-18s\n",
$_, to_bin($xmin),to_bin($xmax), to_bin($ymin),to_bin($ymax);
($xmax,
$xmin,
$ymax,
$ymin)
=
(max($ymax, -$ymin, 2*$len-$xmin),
min($ymin),
2*$len-$ymin,
min(-$xmax,-$ymax));
### assert: $xmin <= 0
### assert: $ymin <= 0
### assert: $xmax >= 0
### assert: $ymax >= 0
$len *= 2;
}
print 3*$xmin/$len+.001," / 3\n";
print 6*$xmax/$len+.001," / 6\n";
print 3*$ymin/$len+.001," / 3\n";
print 3*$ymax/$len+.001," / 3\n";
}
{
# A073089 midpoint vertical/horizontal formula
require Math::NumSeq::OEIS::File;
my $A073089 = Math::NumSeq::OEIS::File->new (anum => 'A073089');
my $A014577 = Math::NumSeq::OEIS::File->new (anum => 'A014577'); # 0=left n=0
my $A014707 = Math::NumSeq::OEIS::File->new (anum => 'A014707'); # 1=left
my $A038189 = Math::NumSeq::OEIS::File->new (anum => 'A038189');
my $A082410 = Math::NumSeq::OEIS::File->new (anum => 'A082410');
my $A000035 = Math::NumSeq::OEIS::File->new (anum => 'A000035'); # n mod 2
my $count = 0;
foreach my $n (0 .. 1000) {
my $got = $A073089->ith($n) // next;
# works except for n=1
# my $turn = $A014707->ith($n-2) // next;
# my $flip = $A000035->ith($n-2) // next;
# my $calc = $turn ^ $flip;
# works
# my $turn = $A014577->ith($n-2) // next;
# my $flip = $A000035->ith($n-2) // next;
# my $calc = $turn ^ $flip ^ 1;
# so A073089(n) = A082410(n) xor A000035(n) xor 1
my $turn = $A082410->ith($n) // next;
my $flip = $A000035->ith($n) // next;
my $calc = $turn ^ $flip ^ 1;
if ($got != $calc) {
print "wrong $n got=$got calc=$calc\n";
}
$count++;
}
print "count $count\n";
exit 0;
}
{
# doublings
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my %seen;
for (my $n = 0; $n < 2000; $n++) {
my ($x,$y) = $path->n_to_xy($n);
my $key = "$x,$y";
push @{$seen{$key}}, $n;
if (@{$seen{$key}} == 2) {
my @v2;
my $aref = delete $seen{$key};
my $sum = 0;
foreach my $v (@$aref) {
$sum += $v;
my $v2 = Math::BaseCnv::cnv($v,10,2);
push @v2, $v2;
printf "%4s %12s\n", $v, $v2;
}
printf "%4s %12b sum\n", $sum, $sum;
my $diff = abs($aref->[0]-$aref->[1]);
printf "%4s %12b diff\n", $diff, $diff;
my $lenmatch = 0;
foreach my $i (1 .. length($v2[0])) {
my $want = substr ($v2[0], -$i);
if ($v2[1] =~ /$want$/) {
next;
} else {
$lenmatch = $i-1;
last;
last;
}
}
my $zeros = ($v2[0] =~ /(0*)$/ && $1);
my $lenzeros = length($zeros);
my $same = ($lenmatch == $lenzeros+2 ? "same" : "diff");
print "low same $lenmatch zeros $lenzeros $same\n";
my $new = $aref->[0];
my $first_bit = my $bit = 2 * 2**$lenzeros;
my $change = 0;
while ($bit <= 2*$aref->[0]) {
### $bit
### $change
if ($change) {
$new ^= $bit;
$change = ! ($aref->[0] & $bit);
} else {
$change = ($aref->[0] & $bit);
}
$bit *= 2;
}
my $new2 = Math::BaseCnv::cnv($new,10,2);
if ($new != $aref->[1]) {
print "flip wrong first $first_bit last $bit to $new $new2\n";
}
print "\n";
}
}
exit 0;
}
{
# xy absolute direction nsew
require Math::PlanePath::DragonCurve;
my @array;
my $arms = 4;
my $path = Math::PlanePath::DragonCurve->new (arms => $arms);
my $width = 20;
my $height = 20;
my ($n_lo, $n_hi) = $path->rect_to_n_range(0,0,$width+2,$height+2);
print "n_hi $n_hi\n";
for my $n (0 .. 20*$n_hi) {
# next if ($n % 4) == 0;
# next if ($n % 4) == 1;
# next if ($n % 4) == 2;
# next if ($n % 4) == 3;
my ($x,$y) = $path->n_to_xy($n);
next if $x < 0 || $y < 0 || $x > $width || $y > $height;
my ($nx,$ny) = $path->n_to_xy($n+$arms);
if ($ny == $y+1) {
$array[$x][$y] .= ($n & 1 ? "n" : "N");
}
if ($ny == $y-1) {
$array[$x][$y] .= ($n & 1 ? "s" : "S");
}
# if ($nx == $x+1) {
# $array[$x][$y] .= "w";
# }
# if ($nx == $x-1) {
# $array[$x][$y] .= "e";
# }
}
foreach my $y (reverse 0 .. $height) {
foreach my $x (0 .. $width) {
my $v = $array[$x][$y]//'';
$v = sort_str($v);
printf "%3s", $v;
}
print "\n";
}
exit 0;
}
{
# xy absolute direction
require Image::Base::Text;
require Math::PlanePath::DragonCurve;
my $arms = 1;
my $path = Math::PlanePath::DragonCurve->new (arms => $arms);
my $width = 20;
my $height = 20;
my $image = Image::Base::Text->new (-width => $width,
-height => $height);
my ($n_lo, $n_hi) = $path->rect_to_n_range(0,0,$width+2,$height+2);
print "n_hi $n_hi\n";
for my $n (0 .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
next if $x < 0 || $y < 0 || $x >= $width || $y >= $height;
my ($nx,$ny) = $path->n_to_xy($n+$arms);
# if ($nx == $x+1) {
# $image->xy($x,$y,$n&3);
# }
# if ($ny == $y+1) {
# $image->xy($x,$y,$n&3);
# }
if ($ny == $y+1 || $ny == $y-1) {
# $image->xy($x,$y,$n&3);
$image->xy($x,$y,'|');
}
if ($nx == $x+1 || $nx == $x-1) {
# $image->xy($x,$y,$n&3);
$image->xy($x,$y,'-');
}
}
$image->save('/dev/stdout');
exit 0;
}
{
# Rounded and Midpoint equivalence table
require Math::PlanePath::DragonRounded;
require Math::PlanePath::DragonMidpoint;
my @yx_rtom_dx;
my @yx_rtom_dy;
foreach my $arms (1 .. 4) {
### $arms
my $rounded = Math::PlanePath::DragonRounded->new (arms => $arms);
my $midpoint = Math::PlanePath::DragonMidpoint->new (arms => $arms);
my %seen;
foreach my $n (0 .. 5000) {
my ($x,$y) = $rounded->n_to_xy($n) or next;
my ($mx,$my) = $midpoint->n_to_xy($n);
my $dx = ($x - floor($x/3)) - $mx;
my $dy = ($y - floor($y/3)) - $my;
if (defined $yx_rtom_dx[$y%6][$x%6]
&& $yx_rtom_dx[$y%6][$x%6] != $dx) {
die "oops";
}
if (defined $yx_rtom_dy[$y%6][$x%6]
&& $yx_rtom_dy[$y%6][$x%6] != $dy) {
die "oops";
}
$yx_rtom_dx[$y%6][$x%6] = $dx;
$yx_rtom_dy[$y%6][$x%6] = $dy;
}
print_6x6(\@yx_rtom_dx);
print_6x6(\@yx_rtom_dy);
foreach my $n (0 .. 1000) {
my ($x,$y) = $rounded->n_to_xy($n) or next;
my $mx = $x-floor($x/3) - $yx_rtom_dx[$y%6][$x%6];
my $my = $y-floor($y/3) - $yx_rtom_dy[$y%6][$x%6];
my $m = $midpoint->xy_to_n($mx,$my);
my $good = (defined $m && $n == $m ? "good" : "bad");
printf "n=%d xy=%d,%d -> mxy=%d,%d m=%s %s\n",
$n, $x,$y,
$mx,$my, $m//'undef',
$good;
}
}
exit 0;
sub print_6x6 {
my ($aref) = @_;
foreach my $y (0 .. 5) {
if ($y == 0) {
print "[[";
} else {
print " [";
}
foreach my $x (0 .. 5) {
my $v = $aref->[$y][$x] // 'undef';
printf "%5s", $v;
if ($x != 5) { print ", " }
}
if ($y == 5) {
print "] ]\n";
} else {
print "]\n";
}
}
}
}
{
# Rounded and Midpoint equivalence checks
require Math::PlanePath::DragonRounded;
require Math::PlanePath::DragonMidpoint;
my @yx_rtom_dx;
my @yx_rtom_dy;
foreach my $arms (1 .. 4) {
print "\narms=$arms\n";
my $rounded = Math::PlanePath::DragonRounded->new (arms => $arms);
my $midpoint = Math::PlanePath::DragonMidpoint->new (arms => $arms);
foreach my $y (reverse -10 .. 10) {
foreach my $x (-7 .. 7) {
my $d = '';
my $n = $rounded->xy_to_n($x,$y);
if (defined $n) {
my ($mx,$my) = $midpoint->n_to_xy($n);
my $dx = ($x - floor($x/3)) - $mx;
my $dy = ($y - floor($y/3)) - $my;
$d = "$dx,$dy";
} elsif ($x==0&&$y==0) {
$d = '+';
}
printf "%5s", $d;
}
print "\n";
}
}
exit 0;
}
{
# A059125 "dragon-like"
require MyOEIS;
my ($drag_values) = MyOEIS::read_values('A014707');
my ($like_values) = MyOEIS::read_values('A059125');
my @diff = map {$drag_values->[$_] == $like_values->[$_] ? '_' : 'x' }
0 .. 80;
print @{$drag_values}[0..70],"\n";
print @{$like_values}[0..70],"\n";
print @diff[0..70],"\n";
exit 0;
}
{
# Curve xy to n by midpoint
require Math::PlanePath::DragonCurve;
require Math::PlanePath::DragonMidpoint;
foreach my $arms (3) {
### $arms
my $curve = Math::PlanePath::DragonCurve->new (arms => $arms);
my $midpoint = Math::PlanePath::DragonMidpoint->new (arms => $arms);
my %seen;
for (my $n = 0; $n < 50; $n++) {
my ($x,$y) = $curve->n_to_xy($n);
my $list = '';
my $found = '';
DX: foreach my $dx (-1,0) {
foreach my $dy (0,1) {
# my ($x,$y) = ($x-$y,$x+$y); # rotate +45 and mul sqrt(2)
my ($x,$y) = ($x+$y,$y-$x); # rotate -45 and mul sqrt(2)
my $m = $midpoint->xy_to_n($x+$dx,$y+$dy) // next;
$list .= " $m";
if ($m == $n) {
$found = "$dx,$dy";
# last DX;
}
}
}
printf "n=%d xy=%d,%d got %s %s\n",
$n,$x,$y,
$found, $list;
$seen{$found} = 1;
}
$,=' ';
print sort keys %seen,"\n";
}
exit 0;
# (x+iy)*(i+1) = (x-y)+(x+y)i # +45
# (x+iy)*(-i+1) = (x+y)+(y-x)i # -45
}
{
# Midpoint xy to n
require Math::PlanePath::DragonMidpoint;
my @yx_adj_x = ([0,1,1,0],
[1,0,0,1],
[1,0,0,1],
[0,1,1,0]);
my @yx_adj_y = ([0,0,1,1],
[0,0,1,1],
[1,1,0,0],
[1,1,0,0]);
sub xy_to_n {
my ($self, $x,$y) = @_;
my $n = ($x * 0 * $y) + 0; # inherit bignum 0
my $npow = $n + 1; # inherit bignum 1
while (($x != 0 && $x != -1) || ($y != 0 && $y != 1)) {
# my $ax = ((($x+1) ^ ($y+1)) >> 1) & 1;
# my $ay = (($x^$y) >> 1) & 1;
# ### assert: $ax == - $yx_adj_x[$y%4]->[$x%4]
# ### assert: $ay == - $yx_adj_y[$y%4]->[$x%4]
my $y4 = $y % 4;
my $x4 = $x % 4;
my $ax = $yx_adj_x[$y4]->[$x4];
my $ay = $yx_adj_y[$y4]->[$x4];
### at: "$x,$y n=$n axy=$ax,$ay bit=".($ax^$ay)
if ($ax^$ay) {
$n += $npow;
}
$npow *= 2;
$x -= $ax;
$y -= $ay;
### assert: ($x+$y)%2 == 0
($x,$y) = (($x+$y)/2, # rotate -45 and divide sqrt(2)
($y-$x)/2);
}
### final: "xy=$x,$y"
my $arm;
if ($x == 0) {
if ($y) {
$arm = 1;
### flip ...
$n = $npow-1-$n;
} else { # $y == 1
$arm = 0;
}
} else { # $x == -1
if ($y) {
$arm = 2;
} else {
$arm = 3;
### flip ...
$n = $npow-1-$n;
}
}
### $arm
my $arms_count = $self->arms_count;
if ($arm > $arms_count) {
return undef;
}
return $n * $arms_count + $arm;
}
foreach my $arms (4,3,1,2) {
### $arms
my $path = Math::PlanePath::DragonMidpoint->new (arms => $arms);
for (my $n = 0; $n < 50; $n++) {
my ($x,$y) = $path->n_to_xy($n)
or next;
my $rn = xy_to_n($path,$x,$y);
my $good = '';
if (defined $rn && $rn == $n) {
$good .= "good N";
}
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $rn2 = Math::BaseCnv::cnv($rn,10,2);
printf "n=%d xy=%d,%d got rn=%d %s\n",
$n,$x,$y,
$rn,
$good;
}
}
exit 0;
}
{
# xy modulus
require Math::PlanePath::DragonMidpoint;
my $path = Math::PlanePath::DragonMidpoint->new;
my %seen;
for (my $n = 0; $n < 1024; $n++) {
my ($x,$y) = $path->n_to_xy($n)
or next;
my $k = ($x+$y) & 15;
# $x &= 3; $y &= 3; $k = "$x,$y";
$seen{$k} = 1;
}
### %seen
exit 0;
}
{
# arm xy modulus
require Math::PlanePath::DragonMidpoint;
my $path = Math::PlanePath::DragonMidpoint->new (arms => 4);
my %seen;
for (my $n = 0; $n < 1024; $n++) {
my ($x,$y) = $path->n_to_xy($n)
or next;
$x &= 3;
$y &= 3;
$seen{$n&3}->{"$x,$y"} = 1;
}
### %seen
exit 0;
}
{
# xy to n
require Math::PlanePath::DragonMidpoint;
my @yx_adj_x = ([0,-1,-1,0],
[-1,0,0,-1],
[-1,0,0,-1],
[0,-1,-1,0]);
my @yx_adj_y = ([0,0,-1,-1],
[0,0,-1,-1],
[-1,-1,0,0],
[-1,-1,0,0]);
my $path = Math::PlanePath::DragonMidpoint->new (); # (arms => 4);
for (my $n = 0; $n < 50; $n++) {
my ($x,$y) = $path->n_to_xy($n)
or next;
($x,$y) = (-$y,$x+1); # rotate +90
# ($x,$y) = (-$x-1,-$y+1); # rotate 180
# my $rot = 1;
# if ($rot & 2) {
# $x -= 1;
# }
# if (($rot+1) & 2) {
# # rot 1 or 2
# $y += 1;
# }
### xy: "$n $x,$y adj ".$yx_adj_x[$y&3]->[$x&3]." ".$yx_adj_y[$y&3]->[$x&3]
my $rx = $x;
my $ry = $y;
# if (((($x+1)>>1)&1) ^ ((($y-1)&2))) {
# $rx--;
# }
# if (((($x-1)>>1)&1) ^ ((($y+1)&2))) {
# $ry--;
# }
my $ax = ((($x+1) ^ ($y+1)) >> 1) & 1;
my $ay = (($x^$y) >> 1) & 1;
### assert: $ax == - $yx_adj_x[$y&3]->[$x&3]
### assert: $ay == - $yx_adj_y[$y&3]->[$x&3]
# $rx += $yx_adj_x[$y&3]->[$x&3];
# $ry += $yx_adj_y[$y&3]->[$x&3];
$rx -= $ax;
$ry -= $ay;
($rx,$ry) = (($rx+$ry)/2,
($ry-$rx)/2);
### assert: $rx == int($rx)
### assert: $ry == int($ry)
# my $arm = $n & 3;
# my $nbit = ($path->arms_count == 4 ? ($n>>2)&1 : $n&1);
# my $bit = $ax ^ $ay ^ ($arm&0) ^ (($arm>>1)&1);
my $nbit = $n&1;
my $bit = $ax ^ $ay;
my $rn = $path->xy_to_n($ry-1,-$rx); # rotate -90
# my $rn = $path->xy_to_n(-$rx-1,-$ry+1); # rotate 180
my $good = '';
if (defined $rn && $rn == int($n/2)) {
$good .= "good N";
}
if ($nbit == $bit) {
$good .= " good bit";
}
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $rn2 = Math::BaseCnv::cnv($rn,10,2);
printf "%d %d (%8s %8s) bit=%d,%d %d,%d %s\n",
$n,$rn, $n2,$rn2,
$nbit,$bit,
$x,$y, $good;
}
exit 0;
}
{
require Image::Base::Text;
my $width = 79;
my $height = 50;
my $ox = $width/2;
my $oy = $height/2;
my $image = Image::Base::Text->new (-width => $width,
-height => $height);
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my $store = sub {
my ($x,$y,$c) = @_;
# $x *= 2;
# $y *= 2;
$x += $ox;
$y += $oy;
if ($x >= 0 && $y >= 0 && $x < $width && $y < $height) {
my $o = $image->xy($x,$y);
# if (defined $o && $o ne ' ' && $o ne $c) {
# $c = '*';
# }
$image->xy($x,$y,$c);
} else {
die "$x,$y";
}
};
my ($x,$y);
for my $n (0 .. 2**8) {
($x,$y) = $path->n_to_xy($n);
# # (x+iy)/(i+1) = (x+iy)*(i-1)/2 = (-x-y)/2 + (x-y)/2
# if (($x+$y) % 2) { $x--; }
# ($x,$y) = ((-$x-$y)/2,
# ($x-$y)/2);
#
# # (x+iy)/(i+1) = (x+iy)*(i-1)/2 = (-x-y)/2 + (x-y)/2
# if (($x+$y) % 2) { $x--; }
# ($x,$y) = ((-$x-$y)/2,
# ($x-$y)/2);
# ($x,$y) = (-$y,$x); # rotate +90
$y = -$y;
$store->($x,$y,'*');
}
$store->($x,$y,'+');
$store->(0,0,'o');
$image->save('/dev/stdout');
exit 0;
}
{
# vs ComplexPlus
require Math::PlanePath::DragonCurve;
require Math::PlanePath::ComplexPlus;
my $dragon = Math::PlanePath::DragonCurve->new;
my $complex = Math::PlanePath::ComplexPlus->new;
for (my $n = 0; $n < 50; $n++) {
my ($x,$y) = $dragon->n_to_xy($n)
or next;
my $cn = $complex->xy_to_n($x,$y);
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $cn2 = (defined $cn ? Math::BaseCnv::cnv($cn,10,2) : 'undef');
printf "%8s %8s %d,%d\n", $n2, $cn2, $x,$y;
}
exit 0;
}
{
# turn
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my $n = $path->n_start;
my ($n0_x, $n0_y) = $path->n_to_xy ($n);
$n++;
my ($prev_x, $prev_y) = $path->n_to_xy ($n);
my ($prev_dx, $prev_dy) = ($prev_x - $n0_x, $prev_y - $n0_y);
$n++;
my $pow = 4;
for ( ; $n < 128; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
my $dx = ($x - $prev_x);
my $dy = ($y - $prev_y);
my $turn;
if ($prev_dx) {
if ($dy == $prev_dx) {
$turn = 0; # left
} else {
$turn = 1; # right
}
} else {
if ($dx == $prev_dy) {
$turn = 1; # right
} else {
$turn = 0; # left
}
}
($prev_dx,$prev_dy) = ($dx,$dy);
($prev_x,$prev_y) = ($x,$y);
print "$turn";
if ($n-1 == $pow) {
$pow *= 2;
print "\n";
}
}
print "\n";
exit 0;
}
{
# turn
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my $n = 0;
my ($n0_x, $n0_y) = $path->n_to_xy ($n);
$n++;
my ($prev_x, $prev_y) = $path->n_to_xy ($n);
my ($prev_dx, $prev_dy) = ($prev_x - $n0_x, $prev_y - $n0_y);
$n++;
for ( ; $n < 40; $n++) {
my ($x, $y) = $path->n_to_xy ($n);
my $dx = ($x - $prev_x);
my $dy = ($y - $prev_y);
my $turn;
if ($prev_dx) {
if ($dy == $prev_dx) {
$turn = 0; # left
} else {
$turn = 1; # right
}
} else {
if ($dx == $prev_dy) {
$turn = 1; # right
} else {
$turn = 0; # left
}
}
### $n
### $prev_dx
### $prev_dy
### $dx
### $dy
# ### is: "$got[-1] at idx $#got"
($prev_dx,$prev_dy) = ($dx,$dy);
($prev_x,$prev_y) = ($x,$y);
my $zero = bit_above_lowest_zero($n-1);
my $one = bit_above_lowest_one($n-1);
print "$n $turn $one $zero\n";
# if ($turn != $bit) {
# die "n=$n got $turn bit $bit\n";
# }
}
print "n=$n ok\n";
sub bit_above_lowest_zero {
my ($n) = @_;
for (;;) {
if (($n % 2) == 0) {
last;
}
$n = int($n/2);
}
$n = int($n/2);
return ($n % 2);
}
sub bit_above_lowest_one {
my ($n) = @_;
for (;;) {
if (! $n || ($n % 2) != 0) {
last;
}
$n = int($n/2);
}
$n = int($n/2);
return ($n % 2);
}
exit 0;
}
{
require Image::Base::Text;
my $width = 132;
my $height = 50;
my $ox = $width/2;
my $oy = $height/2;
my $image = Image::Base::Text->new (-width => $width, -height => $height);
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my $store = sub {
my ($x,$y,$c) = @_;
$x *= 2;
$x += $ox;
$y += $oy;
if ($x >= 0 && $y >= 0 && $x < $width && $y < $height) {
my $o = $image->xy($x,$y);
# if (defined $o && $o ne ' ' && $o ne $c) {
# $c = '*';
# }
$image->xy($x,$y,$c);
} else {
die "$x,$y";
}
};
my ($x,$y);
for my $n (0 .. 2**9) {
($x,$y) = $path->n_to_xy($n);
$y = -$y;
$store->($x,$y,'*');
}
$store->($x,$y,'+');
$store->(0,0,'+');
$image->save('/dev/stdout');
exit 0;
}
{
# Midpoint fracs
require Math::PlanePath::DragonMidpoint;
my $path = Math::PlanePath::DragonMidpoint->new;
for my $n (0 .. 64) {
my $frac = .125;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
my ($x,$y) = $path->n_to_xy($n+$frac);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
my $xm = $x1 + $frac*$dx;
my $ym = $y1 + $frac*$dy;
my $wrong = '';
if ($x != $xm) {
$wrong .= " X";
}
if ($y != $ym) {
$wrong .= " Y";
}
print "$n $dx,$dy $x, $y want $xm, $ym $wrong\n"
}
exit 0;
}
{
# min/max for level
require Math::PlanePath::DragonRounded;
my $path = Math::PlanePath::DragonRounded->new;
my $prev_min = 1;
my $prev_max = 1;
for (my $level = 1; $level < 25; $level++) {
my $n_start = 2**($level-1);
my $n_end = 2**$level;
my $min_hypot = 128*$n_end*$n_end;
my $min_x = 0;
my $min_y = 0;
my $min_pos = '';
my $max_hypot = 0;
my $max_x = 0;
my $max_y = 0;
my $max_pos = '';
print "level $level n=$n_start .. $n_end\n";
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
my $h = $x*$x + $y*$y;
if ($h < $min_hypot) {
$min_hypot = $h;
$min_pos = "$x,$y";
}
if ($h > $max_hypot) {
$max_hypot = $h;
$max_pos = "$x,$y";
}
}
# print " min $min_hypot at $min_x,$min_y\n";
# print " max $max_hypot at $max_x,$max_y\n";
{
my $factor = $min_hypot / $prev_min;
print " min r^2 $min_hypot 0b".sprintf('%b',$min_hypot)." at $min_pos factor $factor\n";
}
{
my $factor = $max_hypot / $prev_max;
print " max r^2 $max_hypot 0b".sprintf('%b',$max_hypot)." at $max_pos factor $factor\n";
}
$prev_min = $min_hypot;
$prev_max = $max_hypot;
}
exit 0;
}
{
# points N=2^level
require Math::PlanePath::DragonRounded;
my $path = Math::PlanePath::DragonRounded->new;
for my $n (0 .. 50) {
my ($x,$y) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
my $dx = $x2 - $x;
my $dy = $y2 - $y;
my ($xm,$ym) = $path->n_to_xy($n+.5);
# my $dir = 0;
# for (my $bit = 1; ; ) {
# $dir += ((($n ^ ($n>>1)) & $bit) != 0);
# $bit <<= 1;
# last if $bit > $n;
# # $dir += 1;
# }
# $dir %= 4;
$x += $dx/2;
$y += $dy/2;
print "$n $x,$y $xm,$ym\n";
}
exit 0;
}
{
# reverse checking
require Math::PlanePath::DragonRounded;
my $path = Math::PlanePath::DragonRounded->new;
for my $n (1 .. 50000) {
my ($x,$y) = $path->n_to_xy($n);
my $rev = $path->xy_to_n($x,$y);
if (! defined $rev || $rev != $n) {
if (! defined $rev) { $rev = 'undef'; }
print "$n $x,$y $rev\n";
}
}
exit 0;
}
{
require Image::Base::Text;
my $width = 78;
my $height = 40;
my $ox = $width/2;
my $oy = $height/2;
my $image = Image::Base::Text->new (-width => $width, -height => $height);
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my $store = sub {
my ($x,$y,$c) = @_;
$x *= 2;
$x += $ox;
$y += $oy;
if ($x >= 0 && $y >= 0 && $x < $width && $y < $height) {
my $o = $image->xy($x,$y);
if (defined $o && $o ne ' ' && $o ne $c) {
$c = '.';
}
$image->xy($x,$y,$c);
}
};
for my $n (0 .. 16*256) {
my ($x,$y) = $path->n_to_xy($n);
$y = -$y;
{
$store->($x,$y,'a');
}
{
$store->(-$y,$x,'b');
}
{
$store->(-$x,-$y,'c');
}
{
$store->($y,-$x,'d');
}
}
$image->xy($ox,$oy,'+');
$image->save('/dev/stdout');
exit 0;
}
{
# points N=2^level
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
for my $level (0 .. 50) {
my $n = 2**$level;
my ($x,$y) = $path->n_to_xy($n);
print "$level $n $x,$y\n";
}
exit 0;
}
{
# sx,sy
my $sx = 1;
my $sy = 0;
for my $level (0 .. 50) {
print "$level $sx,$sy\n";
($sx,$sy) = ($sx - $sy,
$sy + $sx);
}
exit 0;
}
Math-PlanePath-122/devel/interpolate.pl 0000644 0001750 0001750 00000015025 12165377675 015707 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use Math::BigRat;
use Math::Polynomial 1;
use Math::Polynomial::Horner;
#use Devel::Comments;
my_interpolate ([ 0, 1, 2, 3, 4 ],
[ 0-0.5, 1-0.5, 4-0.5, 9-0.5, 16-0.5 ]
);
# my_interpolate ([ 1, 2, 3 ],
# [ 2, 9, 21 ]
# );
# my_interpolate ([ reverse 0,1,2,3,4,5 ],
# [ map {$_-16} 0,5,9,12,14,15 ]
# );
exit 0;
# [1,2,3,4],[1+4,12+4+8,35+4+8+8,70+4+8+8+8]
# # step==0
# my_interpolate ([ 0, 1, 2, 3, 4 ],
# [0.5, 0.5, 0.5, 0.5, 0.5 ]);
# # step==1
# # 7 8 9 10
# # 4 5 6
# # 2 3
# # 1
# my_interpolate ([ 0, 1, 2, 3 ],
# [0.5, 1.5, 3.5, 6.5 ]);
# # step==2
# my_interpolate ([ 0, 1, 2, 3 ],
# [0.5, 1.5, 4.5, 9.5 ]);
# # step==3
# my_interpolate ([ 0, 1, 2, 3 ],
# [0.5, 1.5, 5.5, 12.5 ]);
# # step==4
# my_interpolate ([ 0, 1, 2, 3 ],
# [0.5, 1.5, 6.5, 15.5 ]);
# my_interpolate ([ 2, 3, 4, 5, 6, 7, 8, 9, 10 ],
# [ 9, 25, 49, 81, 121, 169, 225, 289, 361 ]
# );
exit 0;
# N = a*s^2 + b*s + c
# = a * (s^2 + b/a s + c/a)
#
# N/a = (s + b/2a)^2 - b^2/4a^2 + c/a
# (s + b/2a)^2 = N/a + b^2/4a^2 - c/a
# s+ b/2a = sqrt(4aN/4a^2 + b^2/4a^2 - 4ac/4a^2)
# = 1/2a * sqrt(4aN + b^2 - 4ac)
#
# -b + sqrt(4aN + b2 - 4ac)
# s = ------------------------
# 2a
#
my_interpolate (
[ 1, 2, 3, 4, 5],
[ map {3*$_} 1,1+4,1+4+9,1+4+9+16,1+4+9+16+25 ],
);
sub bigrat_to_decimal {
my ($rat) = @_;
if (is_pow2($rat->denominator)) {
return $rat->as_float;
} else {
return $rat;
}
}
sub is_pow2 {
my ($n) = @_;
while ($n > 1) {
if ($n & 1) {
return 0;
}
$n >>= 1;
}
return ($n == 1);
}
use constant my_string_config => (variable => '$d',
times => '*',
power => '**',
fold_one => 1,
fold_sign => 1,
fold_sign_swap_end => 1,
power_by_times => 1,
);
# @string_config = (
# # power => '**',
# # fold_one => 1,
# # fold_sign => 1,
# # fold_sign_swap_end => 1,
# # power_by_times => 1,
# );
sub my_interpolate {
my ($xarray, $valarray) = @_;
my $zero = 0;
$zero = Math::BigRat->new(0);
$xarray = [ map {Math::BigRat->new($_)} @$xarray ];
$valarray = [ map {Math::BigRat->new($_)} @$valarray ];
my $p = Math::Polynomial->new($zero);
$p = $p->interpolate($xarray, $valarray);
$p->string_config({ fold_sign => 1,
variable => 'd' });
print "N = $p\n";
$p->string_config({ my_string_config() });
print " = $p\n";
$p->string_config({ my_string_config(),
# convert_coeff => \&bigrat_to_decimal,
});
print " = ",Math::Polynomial::Horner::as_string($p),"\n";
my $a = $p->coeff(2);
return if $a == 0;
my $b = $p->coeff(1);
my $c = $p->coeff(0);
my $x = -$b/(2*$a);
my $y = 4*$a / ((2*$a) ** 2);
my $z = ($b*$b-4*$a*$c) / ((2*$a) ** 2);
print "d = $x + sqrt($y * \$n + $z)\n";
# return;
my $s_to_n = sub {
my ($s) = @_;
return $p->evaluate($s);
};
if (ref $x) {
$x = $x->numify;
$y = $y->numify;
$z = $z->numify;
}
my $n_to_d = sub {
my ($n) = @_;
my $root = $y * $n + $z;
if ($root < 0) {
return 'neg sqrt';
}
return ($x + sqrt($root));
};
# for (my $i = 0; $i < 100; $i += 0.5) {
# printf "%4s d=%s\n", $i, $n_to_d->($i);
# }
exit 0;
}
# {
# package Math::Polynomial;
# sub interpolate {
# my ($this, $xvalues, $yvalues) = @_;
# if (
# !ref($xvalues) || !ref($yvalues) || @{$xvalues} != @{$yvalues}
# ) {
# croak 'usage: $q = $p->interpolate([$x1, $x2, ...], [$y1, $y2, ...])';
# }
# return $this->new if !@{$xvalues};
# my @alpha = @{$yvalues};
# my $result = $this->new($alpha[0]);
# my $aux = $result->monomial(0);
# my $zero = $result->coeff_zero;
# for (my $k=1; $k<=$#alpha; ++$k) {
# for (my $j=$#alpha; $j>=$k; --$j) {
# my $dx = $xvalues->[$j] - $xvalues->[$j-$k];
# croak 'x values not disjoint' if $zero == $dx;
# ### dx: "$dx",ref $dx
# $alpha[$j] = ($alpha[$j] - $alpha[$j-1]) / $dx;
# }
# $aux = $aux->mul_root($xvalues->[$k-1]);
# $result += $aux->mul_const($alpha[$k]);
# ### alpha: join(' ',map{"$_"}@alpha)
# }
# return $result;
# }
# }
{
my $f1 = 1.5;
my $f2 = 4.5;
my $f3 = 9.5;
my $f4 = 16.5;
foreach ($f1, $f2, $f3, $f4) {
$_ = Math::BigRat->new($_);
}
my $a = $f4/2 - $f3 + $f2/2;
my $b = $f4*-5/2 + $f3*6 - $f2*7/2;
my $c = $f4*3 - $f3*8 + $f2*6;
print "$a\n";
print "$b\n";
print "$c\n";
print "$a*\$s*\$s + $b*\$s + $c\n";
exit 0;
}
{
my $subr = sub {
my ($s) = @_;
return 3*$s*$s - 4*$s + 2;
# return 2*$s*$s - 2*$s + 2;
# return $s*$s + .5;
# return $s*$s - $s + 1;
# return $s*($s+1)*.5 + 0.5;
};
my $back = sub {
my ($n) = @_;
return (2 + sqrt(3*$n - 2)) / 3;
# return .5 + sqrt(.5*$n-.75);
# return sqrt ($n - .5);
# return -.5 + sqrt(2*$n - .75);
# return int((sqrt(4*$n-1) - 1) / 2);
};
my $prev = 0;
foreach (1..15) {
my $this = $subr->($_);
printf("%2d %.2f %.2f %.2f\n", $_, $this, $this-$prev,$back->($this));
$prev = $this;
}
for (my $n = 1; $n < 23; $n++) {
printf "%.2f %.2f\n", $n,$back->($n);
}
exit 0;
}
Math-PlanePath-122/devel/gosper-islands-stars.pl 0000644 0001750 0001750 00000002334 11777406713 017436 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.005;
use strict;
use POSIX ();
use Math::PlanePath::GosperIslands;
# uncomment this to run the ### lines
use Smart::Comments;
{
my $path = Math::PlanePath::GosperIslands->new;
my @rows = ((' ' x 64) x 78);
my $level = 3;
my $n_start = 3**$level - 2;
my $n_end = 3**($level+1) - 2 - 1;
foreach my $n ($n_start .. $n_end) {
my ($x, $y) = $path->n_to_xy ($n);
# $x *= 2;
$x+= 16;
$y+= 16;
substr ($rows[$y], $x,1, '*');
}
local $,="\n";
print reverse @rows;
exit 0;
}
Math-PlanePath-122/devel/koch-curve.pl 0000644 0001750 0001750 00000004263 12252723363 015413 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use List::Util 'sum';
use Math::PlanePath::KochCurve;
{
# A056832 All a(n) = 1 or 2; a(1) = 1; get next 2^k terms by repeating
# first 2^k terms and changing last element so sum of first 2^(k+1) terms
# is odd.
#
# Is lowest non-zero base4 digit(n) 1,3->a(n)=1 2->a(n)=2.
# a(2^k) flips 1<->2 each time for low non-zero flipping 1<->2.
# a(2^k) always flips because odd sum becomes even on duplicating.
#
my @a = (1);
for my $i (1 .. 6) {
push @a, @a;
unless (sum(@a) & 1) {
$a[-1] = 3-$a[-1]; # 2<->1
print "i=$i flip last\n";
}
print @a,"\n";
}
foreach my $i (1 .. 64) {
my $d = base4_lowest_nonzero_digit($i);
if ($d != 2) { $d = 1; }
print $d;
}
print "\n";
exit 0;
}
sub base4_lowest_nonzero_digit {
my ($n) = @_;
while (($n & 3) == 0) {
$n >>= 2;
if ($n == 0) { die "oops, no nonzero digits at all"; }
}
return $n & 3;
}
sub base4_lowest_non3_digit {
my ($n) = @_;
while (($n & 3) == 3) {
$n >>= 2;
}
return $n & 3;
}
{
my $path = Math::PlanePath::KochCurve->new;
foreach my $n (0 .. 16) {
my ($x,$y) = $path->n_to_xy($n);
my $rot = n_to_total_turn($n);
print "$n $x,$y $rot\n";
}
print "\n";
exit 0;
sub n_to_total_turn {
my ($n) = @_;
my $rot = 0;
while ($n) {
if (($n % 4) == 1) {
$rot++;
} elsif (($n % 4) == 2) {
$rot --;
}
$n = int($n/4);
}
return $rot;
}
}
Math-PlanePath-122/devel/factor-rationals.pl 0000644 0001750 0001750 00000017733 12236024533 016616 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::FactorRationals;
# uncomment this to run the ### lines
use Smart::Comments;
{
foreach my $n (1 .. 20) {
print Math::PlanePath::FactorRationals::_pos_to_pn__negabinary($n),",";
}
exit 0;
}
{
# different pos=49 numbers got=69 want=88, and more diff
# N=50 = 5*5*2
my $path = Math::PlanePath::FactorRationals->new;
foreach my $x (1 .. 50) {
my $n = $path->xy_to_n(1,$x);
print "$x $n\n";
}
exit 0;
}
# Return ($good, $prime,$exp, $prime,$exp,...).
# $good is true if a full factorization is found.
# $good is false if cannot factorize because $n is too big or infinite.
#
# If $n==0 or $n==1 then there are no prime factors and the return is
# $good=1 and an empty list of primes.
#
sub INPROGRESS_prime_factors_and_exps {
my ($n) = @_;
### _prime_factors(): $n
unless ($n >= 0) {
return 0;
}
if (_is_infinite($n)) {
return 0;
}
# if ($n <= 0xFFFF_FFFF) {
# return (1, prime_factors($n));
# }
my @ret;
unless ($n % 2) {
my $count = 0;
do {
$count++;
$n /= 2;
} until ($n % 2);
push @ret, 2, $count;
}
# Stop at when prime $p reaches $limit and when no prime factor has been
# found for the last 20 attempted $p. Stopping only after a run of no
# factors found allows big primorials 2*3*5*7*13*... to be divided out.
# If the divisions are making progress reducing $i then continue.
#
# Would like $p and $gap to count primes, not just odd numbers. Perhaps
# a table of small primes. The first gap of 36 odds between primes
# occurs at prime=31469. cf A000230 smallest prime p for gap 2n.
my $limit = 10_000 / (_blog2_estimate($n) || 1);
my $gap = 0;
for (my $p = 3; $gap < 36 || $p <= $limit ; $p += 2) {
if ($n % $p) {
$gap++;
} else {
do {
### prime: $p
$n /= $p;
push @ret, $p;
} until ($n % $p);
if ($n <= 1) {
### all factors found ...
return (1, @ret);
}
# if ($n < 0xFFFF_FFFF) {
# ### remaining factors by XS ...
# return (1, @ret, prime_factors($n));
# }
$gap = 0;
}
}
return 0; # factors too big
}
{
my @primes = (2,3,5,7);
sub _extend_primes {
for (my $p = $primes[-1] + 2; ; $p += 2) {
if (_is_prime($p)) {
push @primes, $p;
return;
}
}
}
sub _is_prime {
my ($n) = @_;
my $limit = int(sqrt($n));
for (my $i = 0; ; $i++) {
if ($i > $#primes) { _extend_primes(); }
my $prime = $primes[$i];
if ($n % $prime == 0) { return 0; }
if ($prime > $limit) { return 1; }
}
}
# $aref is an arrayref of prime exponents, [a,b,c,...]
# Return their product 2**a * 3**b * 5**c * ...
#
sub _factors_join {
my ($aref, $zero) = @_;
### _factors_join(): $aref
my $n = $zero + 1;
for (my $i = 0; $i <= $#$aref; $i++) {
if ($i > $#primes) { _extend_primes(); }
$n *= ($primes[$i] + $zero) ** $aref->[$i];
}
### join: $n
return $n;
}
# Return an arrayref of prime exponents of $n.
# Eg. [a,b,c,...] for $n == 2**a * 3**b * 5**c * ...
sub _factors_split {
my ($n) = @_;
### _factors_split(): $n
my @ret;
for (my $i = 0; $n > 1; $i++) {
if ($i > 6541) {
### stop, primes too big ...
return;
}
if ($i > $#primes) { _extend_primes(); }
my $count = 0;
while ($n % $primes[$i] == 0) {
$n /= $primes[$i];
$count++;
}
push @ret, $count;
}
return \@ret;
}
# ### f: 2*3*3*5*19
# ### f: _factors_split(2*3*3*5*19)
# ### f: _factors_join(_factors_split(2*3*3*5*19),0)
# factor_coding => 'spread'
# "spread"
# if ($self->{'factor_coding'} eq 'spread') {
# # N = 2^e1 * 3^e2 * 5^e3 * 7^e4 * 11^e5 * 13^e6 * 17^e7
# # X = 2^e1 * 3^e3 * 5^e5 * 7^e7, Y = 1
# #
# # X = 2^e1 * 5^e5 e3=0,e7=0
# # Y = 3^e2 * 7^e4
# #
# # X=1,0,1
# # Y=0,0,0
# # 22 = 1,0,0,0,1
# # num = 1,0,1 = 2*5 = 10
# #
# my $xexps = _factors_split($x)
# or return undef; # overflow
# my $yexps = _factors_split($y)
# or return undef; # overflow
# ### $xexps
# ### $yexps
#
# my @nexps;
# my $denpos = -1; # to store first at $nexps[1]
# while (@$xexps || @$yexps) {
# my $xexp = shift @$xexps || 0;
# my $yexp = shift @$yexps || 0;
# ### @nexps
# ### $xexp
# ### $yexp
# push @nexps, $xexp, 0;
# if ($xexp) {
# if ($yexp) {
# ### X,Y common factor ...
# return undef;
# }
# } else {
# ### den store to: "denpos=".($denpos+2)." yexp=$yexp"
# $nexps[$denpos+=2] = $yexp;
# }
# }
# ### @nexps
# return (_factors_join(\@nexps, $x*0*$y));
#
# } els
# if ($self->{'factor_coding'} eq 'spread') {
# # N = 2^e1 * 3^e2 * 5^e3 * 7^e4 * 11^e5 * 13^e6 * 17^e7
# # X = 2^e1 * 3^e3 * 5^e5 * 7^e7, Y = 1
# #
# # X = 2^e1 * 5^e5 e3=0,e7=0
# # Y = 3^e2 * 7^e4
# #
# # 22 = 1,0,0,0,1
# # num = 1,0,1 = 2*5 = 10
# # den = 0
# #
# my $nexps = _factors_split($n)
# or return; # too big
# ### $nexps
# my @dens;
# my (@xexps, @yexps);
# while (@$nexps || @dens) {
# my $exp = shift @$nexps;
# if (@$nexps) {
# push @dens, shift @$nexps;
# }
#
# if ($exp) {
# ### to num: $exp
# push @xexps, $exp;
# push @yexps, 0;
# } else {
# ### zero take den: $dens[0]
# push @xexps, 0;
# push @yexps, shift @dens;
# }
# }
# ### @xexps
# ### @yexps
# return (_factors_join(\@xexps,$zero),
# _factors_join(\@yexps,$zero));
#
# } else
}
{
# reversing binary, max factor=3
# 0 0 0 fac=0
# 1 1 1 fac=1
# 2 2 2 fac=1
# 3 -1 3 fac=3
# 4 4 4 fac=
# 5 -3 5 fac=
# 6 -2 6 fac=3
# 7 3 7 fac=
# 8 8 8 fac=
# 9 -7 9 fac=
# 10 -6 10 fac=
# 11 7 11 fac=
# 12 -4 12 fac=3
# 13 5 13 fac=
# 14 6 14 fac=
# 15 -5 15 fac=3
# 16 16 16 fac=
my $max_fac = 0;
foreach my $n (0 .. 2**20) {
my $pn = Math::PlanePath::FactorRationals::_pos_to_pn__revbinary($n);
my $ninv = Math::PlanePath::FactorRationals::_pn_to_pos__revbinary($pn);
my $fac = $n / abs($pn||1);
if ($fac >= $max_fac) {
$max_fac = $fac;
} else {
$fac = '';
}
print "$n $pn $ninv fac=$fac\n";
die unless $ninv == $n;
}
print "\n";
exit 0;
}
{
# negabinary, max factor approach 5
my %rev;
my $max_fac = 0;
foreach my $n (0 .. 2**20) {
my $power = 1;
my $nega = 0;
for (my $bit = 1; $bit <= $n; $bit <<= 1) {
if ($n & $bit) {
$nega += $power;
}
$power *= -2;
}
my $fnega = Math::PlanePath::FactorRationals::_pos_to_pn__negabinary($n);
my $ninv = Math::PlanePath::FactorRationals::_pn_to_pos__negabinary($nega);
my $fac = -$n / ($nega||1);
if ($fac > $max_fac) {
$max_fac = $fac;
print "$n $nega $fnega $ninv fac=$fac\n";
} else {
$fac = '';
}
$rev{$nega} = $n;
}
print "\n";
exit 0;
foreach my $nega (sort {$a<=>$b} keys %rev) {
my $n = $rev{$nega};
print "$nega $n\n";
}
exit 0;
}
Math-PlanePath-122/devel/complex-minus.pl 0000644 0001750 0001750 00000101010 12562515230 016125 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.006;
use strict;
use warnings;
use POSIX;
use List::Util 'min', 'max';
use Math::BaseCnv;
use Math::PlanePath::Base::Digits 'digit_split_lowtohigh';
use Math::PlanePath::ComplexMinus;
use lib 'xt';
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments;
{
# axis level sequence
my $path = Math::PlanePath::ComplexMinus->new;
my @dir_func = (sub { my ($i) = @_; ($i,0) }, # X
sub { my ($i) = @_; (0,$i) }, # Y
sub { my ($i) = @_; (-$i,0) }, # -X
sub { my ($i) = @_; (0,-$i) }, # -Y
sub { my ($i) = @_; ($i,$i) }, # NE
sub { my ($i) = @_; (-$i,$i) }, # NW
sub { my ($i) = @_; (-$i,-$i) }, # SW
sub { my ($i) = @_; ($i,-$i) }, # SE
);
my @values;
foreach my $i (0 .. 10_000) {
foreach my $dir (0 .. $#dir_func) {
my ($x,$y) = $dir_func[$dir]->($i);
my $n = $path->xy_to_n($x,$y);
my $k = $path->n_to_level($n);
if (! defined $values[$dir][-1] || $values[$dir][-1] != $k) {
push @{$values[$dir]}, $k;
}
}
}
foreach my $dir (0 .. $#dir_func) {
print "d=$dir: ";
print join(', ',@{$values[$dir]}),"\n";
}
print "\n";
exit 0;
}
{
# Y axis and diagonal
require Math::BaseCnv;
require Math::NumSeq::PlanePathN;
my $seq = Math::NumSeq::PlanePathN->new (planepath=> 'ComplexMinus',
line_type => 'Y_axis');
my $seq_d = Math::NumSeq::PlanePathN->new (planepath=> 'ComplexMinus',
line_type => 'Diagonal_SW');
my $radix = 2;
foreach my $i (0 .. 30) {
my ($i,$value) = $seq->next;
my ($d_i,$d_value) = $seq_d->next;
my $v2 = Math::BaseCnv::cnv($value,10,$radix);
my $d_v2 = Math::BaseCnv::cnv($d_value,10,$radix);
printf "%8d %20s %8d %20s\n", $value, $v2, $d_value, $d_v2;
# $d_value == $value*2 or die;
}
print "\n";
exit 0;
}
{
my $realpart = 1;
my $path = Math::PlanePath::ComplexMinus->new (realpart => $realpart);
{
my $count = 0;
for (my $n = $path->n_start; $n < 10_000_000; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($x == 0) {
print "$n, ";
last if $count++ > 15;
}
}
print "\n";
}
$,=', ';
print sort({$a<=>$b} 064,067,060,063, 04,07, 00, 03),"\n";
print sort({$a<=>$b} 020,021,034,035, 00,01,014,015),"\n";
for (my $n = $path->n_start; $n < 10_000_000; $n++) {
my ($x,$y) = $path->n_to_xy($n);
my $want = ($x == 0 ? 1 : 0);
my $got = $path->_UNDOCUMENTED__n_is_y_axis($n);
if ($want != $got) {
printf "%7d %7o want %d got %d\n", $n, $n, $want, $got;
exit;
}
}
exit 0;
}
{
# Y axis
require Math::BaseCnv;
require Math::NumSeq::PlanePathN;
my $seq = Math::NumSeq::PlanePathN->new (planepath=> 'ComplexMinus',
line_type => 'Y_axis');
my $radix = 8;
foreach my $i (0 .. 150) {
my ($i,$value) = $seq->next;
my $v2 = Math::BaseCnv::cnv($value,10,$radix);
printf "%8d %20s\n", $value, $v2;
}
print "\n";
exit 0;
}
{
# twindragon cf dragon
# diff boundary = left
#
# 28 -> 50 2*28=56
require Math::PlanePath::DragonCurve;
my $twindragon = Math::PlanePath::ComplexMinus->new;
my $dragon = Math::PlanePath::DragonCurve->new;
foreach my $k (0 .. 10) {
my $t = $twindragon->_UNDOCUMENTED_level_to_figure_boundary($k);
my $dt = $twindragon->_UNDOCUMENTED_level_to_figure_boundary($k) -
$twindragon->_UNDOCUMENTED_level_to_figure_boundary($k-1);
my $l = $dragon->_UNDOCUMENTED_level_to_left_line_boundary($k);
my $r = $dragon->_UNDOCUMENTED_level_to_right_line_boundary($k);
my $dr =
$dragon->_UNDOCUMENTED_level_to_right_line_boundary($k)
+ 2*$dragon->_UNDOCUMENTED_level_to_right_line_boundary($k-1);
$dr = 2*$r;
print "$t dt=$dt $l $r $dr\n";
}
exit 0;
}
{
# A203181 nxk count endings
# distinct 10,33,108,342,1096,3501,11199,35821
my @distinct;
foreach my $k (2 .. 9) {
print "k=$k\n";
my %counts;
{
my @mats = ([]);
@mats = map {mat_extend($_,$k)} @mats;
@mats = map {mat_extend($_,$k)} @mats;
foreach my $m (@mats) {
$counts{mat_end_to_str($m)}++;
}
}
my $prev_distinct = 0;
for (;;) {
{
my %new_counts;
while (my ($str,$count) = each %counts) {
foreach my $m (mat_extend(str_to_mat($str),$k)) {
$new_counts{mat_end_to_str($m)} += $count;
}
}
%counts = %new_counts;
}
my $distinct = scalar(keys %counts);
print "distinct $distinct\n";
if ($distinct == $prev_distinct) {
push @distinct, $distinct;
last;
}
$prev_distinct = $distinct;
}
print "----------\n";
}
print join(',',@distinct),"\n";
Math::OEIS::Grep->search(array=>\@distinct);
exit 0;
}
{
my %str_to_mat;
sub str_to_mat {
my ($str) = @_;
return ($str_to_mat{$str}
||= [ map {[split //,$_]} split /;/, $str ]);
}
}
{
# A203181 nxk count
# distinct 10,33,108
my $k = 2;
# my @mats = ([[map {$_%2} 0 .. $k-1]]);
my @mats = ([]);
# @mats = [[1,2],[0,1]];
foreach my $y (0 .. 20) {
### loop for y: $y
@mats = map {mat_extend($_,$k)} @mats;
### mats now: scalar(@mats)
# printmats(@mats);
# foreach my $m (@mats) {
# print join(';',map{join('',@$_)}@$m),"\n";
# }
my %count;
foreach my $m (@mats) {
my $e = mat_end_to_str($m);
$count{$e}++;
}
my $distinct = scalar(keys %count);
printf "yn=%2d count %d (distinct %d)\n", $y+1,scalar(@mats), $distinct;
foreach my $e (sort keys %count) {
print "$e $count{$e}\n";
}
}
exit 0;
}
sub mat_extend {
my ($input_m,$k) = @_;
my $y = scalar(@$input_m);
my @mats = ($input_m);
foreach my $x (0 .. $k-1) {
my @new_mats;
foreach my $m (@mats) {
foreach my $digit (0, 1, 2) {
### consider: $m
### $y
### $x
### $digit
if ($digit == 0) {
next if $y >= 1 && $m->[$y-1]->[$x] == 0; # cannot 0 above
next if $x >= 1 && $m->[$y]->[$x-1] == 0; # cannot 0 left
} elsif ($digit == 1) {
if ($y >= 1 && $m->[$y-1]->[$x] == 0) {
# good, 0 above
} elsif ($x >= 1 && $m->[$y]->[$x-1] == 0) {
# good, 0 left
} else {
# bad
next;
}
} else { # $digit == 2
if ($y >= 2
&& $m->[$y-1]->[$x] == 1 # 1 above, and
&& $m->[$y-2]->[$x] == 0) { # 0 above
# good
} elsif ($x >= 2
&& $m->[$y]->[$x-1] == 1 # 1 above, and
&& $m->[$y]->[$x-2] == 0) { # 0 above
# good
} else {
# bad
next;
}
}
### yes ...
my $new_m = copymat($m);
$new_m->[$y]->[$x] = $digit;
push @new_mats, $new_m;
}
}
@mats = @new_mats;
}
return @mats;
}
sub mat_end_to_str {
my ($m) = @_;
if (@$m >= 2) {
return join('',@{$m->[-2]}) . ';' . join('',@{$m->[-1]});
} else {
return join('',@{$m->[-1]});
}
}
sub printmats {
foreach my $m (@_) {
printaref($m); print "\n";
}
}
sub printaref {
my ($m) = @_;
foreach my $row (@$m) {
print join('',@$row),"\n";
}
}
sub copymat {
my ($m) = @_;
return [ map {[@$_]} @$m ];
}
{
# 0,1 0,1 0,1 0,1 0,1 0,1
# 1,0 1,0 1,0 1,0 1,0 1,0
# 0,1 0,1 0,1 2,1 2,1 0,1
# 1,0 1,2 1,0 0,1 0,2 1,2
# 2,1 2,0 0,1 1,0 1,0 0,1
# A B C D E F G H I J
# 0,1 1,0 1,0 0,1 2,1 2,1 1,2 0,2 2,0 1,2
# 1,0 0,1 2,1 1,2 0,1 0,2 2,0 1,0 0,1 0,1
# --- --- --- --- --- --- --- --- --- ---
# 0,1=B 1,0=A 0,1=E 0,1=J 1,0=A 1,0=H 0,1=I 0,1=B 1,0=A 1,0=A
# 2,1=C 1,2=D 0,2=F 2,0=G H=A I=B 2,1=C 1,2=D
# 2*E E,G F=E H=A I=B J=E
#
# A -> B+C
# B -> A+D B=I
# C -> 2E
# D -> E+G
# E -> A E=F=H=J
# G -> B
#
# 4,6,10,18,30,50,86,146,246,418,710,1202,2038,3458
require Math::Matrix;
# A B C D E F G H I J
my $m = Math::Matrix->new ([0,1,1,0,0,0,0,0,0,0], # A
[1,0,0,1,0,0,0,0,0,0], # B
[0,0,0,0,1,1,0,0,0,0], # C
[0,0,0,0,0,0,1,0,0,1], # D
[1,0,0,0,0,0,0,0,0,0], # E=J
[0,0,0,0,0,0,0,1,0,0], # F
[0,0,0,0,0,0,0,0,1,0], # G
[0,1,1,0,0,0,0,0,0,0], # H=A
[1,0,0,1,0,0,0,0,0,0], # I=B
[1,0,0,0,0,0,0,0,0,0], # J
);
# print "det ",$m->determinant,"\n"; # too slow
=pod
Pari
m = [0,1,1,0,0,0,0,0,0,0; \
1,0,0,1,0,0,0,0,0,0; \
0,0,0,0,1,1,0,0,0,0; \
0,0,0,0,0,0,1,0,0,1; \
1,0,0,0,0,0,0,0,0,0; \
0,0,0,0,0,0,0,1,0,0; \
0,0,0,0,0,0,0,0,1,0; \
0,1,1,0,0,0,0,0,0,0; \
1,0,0,1,0,0,0,0,0,0; \
1,0,0,0,0,0,0,0,0,0 ]
=cut
my $dot = Math::Matrix->new([1,1,1,1,1,1,1,1,1,1,1]);
my $v = Math::Matrix->new([1,0,0,0,0,0,0,0,0,0,0]);
foreach my $i (0 .. 6) {
print "$i\n";
my $p = matrix_pow($m,$i);
my $pv = $v*$p;
print $pv->dot_product($dot),"\n";
matrix_print($pv);
}
# print $v,"\n";
#print $v*($m*$m),"\n";
# print "\nlast\n";
# # 3 2 1 1
# $v = Math::Matrix->new([1,2,2,1,2,1,0,0,0,1]);
# my $pv = $v*$m;
# print $pv->dot_product($dot),"\n";
# print vector_str($pv);
# V*dot = total[i]
# V*M*dot = total[i+1]
# V*M^2*dot = total[i+2]
# V*M^3*dot = total[i+3]
# seek total[i+3] = total[i+2]
# + 0*total[i+1]
# + 2*total[i]
# M^3 = M^2 + 2*I
$v = Math::Matrix->new([1,0,0,0,0,0,0,0,0,0,0]);
my $i = 2;
$dot = $dot->transpose;
my $t0 = ($v * matrix_pow($m,$i)) * $dot;
my $t1 = ($v * matrix_pow($m,$i+1)) * $dot;
my $t2 = ($v * matrix_pow($m,$i+2)) * $dot;
my $t3 = ($v * matrix_pow($m,$i+3)) * $dot;
print "$t0 $t1 $t2 $t3\n";
# my $d = matrix_pow($m,4) - (matrix_pow($m,3) + $m->multiply_scalar(2));
my $d = matrix_pow($m,4) - (matrix_pow($m,3) + $m->multiply_scalar(2));
matrix_print($d); print "\n";
# m^2*dot + 2*dot == m^3*dot
# + $dot->multiply_scalar(2)
{
my $diff = $m*$m*$dot + $dot+$dot - $m*$m*$m*$dot;
print "diff\n"; matrix_print($diff); print "\n";
}
foreach my $exp (-1 .. 5) {
my $diff = matrix_pow($m,$exp+2)
+ matrix_pow($m,$exp)
+ matrix_pow($m,$exp)
- matrix_pow($m,$exp+3) ;
print "diff\n"; matrix_print(($diff*$dot)->transpose); print "\n";
}
# print "m\n"; matrix_print($m); print "\n";
# my $two = $m->multiply_scalar(2);
# print "two\n"; matrix_print($two); print "\n";
# my $three = matrix_pow($m,3);
# print "powthree\n"; matrix_print($three); print "\n";
# my $sum = $three + $two;
# print "sum\n"; matrix_print($sum*$dot); print "\n";
# my $four = matrix_pow($m,4);
# print "four\n"; matrix_print($four*$dot); print "\n";
# my $diff = $four*$dot - $sum*$dot;
# print "four\n"; matrix_print($diff); print "\n";
exit 0;
sub matrix_print {
my ($m) = @_;
my $len = 0;
foreach my $row (@$m) {
foreach my $value (@$row) {
$len = max($len,length($value));
}
}
foreach my $row (@$m) {
foreach my $value (@$row) {
printf " %*s", $len, $value;
}
print "\n";
}
}
# sub vector_str {
# my ($v) = @_;
# my $str = "$v";
# $str =~ s{\.00000 *( |$)}{$1}g;
# return $str;
# }
}
{
require Math::Matrix;
my $m = Math::Matrix->new ([1,0,0],
[0,0,0],
[0,0,0]);
print "det ",$m->determinant,"\n";
my $inv = $m->invert;
print "inverse\n"; matrix_print($inv); print "\n";
my $prod = $m * $inv;
print "prod\n"; matrix_print($prod); print "\n";
my $identity = $m->new_identity(3);
my $wide = $m->concat($identity);
print "wide\n"; matrix_print($wide); print "\n";
my $solve = $wide->solve;
print "solve\n"; matrix_print($solve); print "\n";
exit 0;
}
{
# print A203181 table
require Math::NumSeq::OEIS;
my $seq = Math::NumSeq::OEIS->new(anum=>'A203181');
my @table;
my $len = 0;
DD: for (my $d = 0; ; $d++) {
foreach my $y (0 .. $d) {
my ($i,$value) = $seq->next or last DD;
push @{$table[$y]}, $value;
$len = max($len,length($value));
}
}
$len++;
print "len=$len\n";
$len = 15;
foreach my $y (0 .. $#table) {
my $aref = $table[$y];
foreach my $x (0 .. $#$aref) {
last if $x > 3;
my $value = $aref->[$x];
printf "%*d", $len, $value;
}
print "\n";
}
exit 0;
}
{
require Math::Matrix;
my $m = Math::Matrix->new ([1,2,3],
[0,0,0],
[0,0,0],
);
print matrix_pow($m,0);
exit 0;
}
# m^(2k) = (m^2)^k
# m^(2k+1) = (m^2)^k*m
sub matrix_pow {
my ($m, $exp, $swap) = @_;
if ($swap) { # when called through "**" operator overload.
die "Cannot raise scalar to matrix power";
}
if ($exp != int($exp)) {
die "Cannot raise matrix to non-integer power";
}
if ($exp == 0) {
my $size = @$m;
if ($size != scalar(@{$m->[0]})) {
# non-square matrix, no inverse and so no identity
return undef;
}
return $m->new_identity($m->size);
}
if ($exp < 0) {
$m = $m->invert;
if (! defined $m) { return undef; }
$exp = -$exp;
}
unless ($exp / 2 < $exp) {
die "Cannot raise matrix to infinite power";
}
# Result is $low * ($m ** $exp).
# When $exp odd, ($m ** ($e+1)) = ($m**$e)*$m, so $low*=$m then $e even.
# When $exp even, ($m ** (2*$k)) = ($m*$m) ** $k, so $m*=$m.
# $low is undef if it's the identity matrix and so not needed yet.
# If $exp is a power-of-2 then $low is never needed, just $m squared up.
# Use $exp%2 rather than $exp&1 since that allows NV powers (NV can be a
# 53-bit integer whereas UV might be only 32-bits).
my $low;
while ($exp > 1) {
if ($exp % 2) {
if (defined $low) { $low *= $m; }
else { $low = $m; }
$exp -= 1;
}
$m *= $m;
$exp /= 2;
}
if (defined $low) { $m *= $low; }
return $m;
}
{
# neighbours across 2^k blocks
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
my @dir8_to_dx = (1, 1, 0,-1, -1, -1, 0, 1);
my @dir8_to_dy = (0, 1, 1, 1, 0, -1, -1,-1);
my $path = Math::PlanePath::ComplexMinus->new;
my @values;
my $prev_count = 0;
foreach my $k (0 .. 13) {
my $pow = 2**$k;
my $count = 0;
foreach my $n (2 .. $pow-1) {
my ($x,$y) = $path->n_to_xy($n);
# foreach my $i (0 .. $#dir4_to_dx) {
foreach my $i (0, 2) {
my $n2 = $path->xy_to_n($x+$dir4_to_dx[$i],
$y+$dir4_to_dy[$i]);
if (defined $n2 && $n2 >= $pow) { # num boundary
$count++;
last;
}
# if (defined $n2 && $n2 >= $pow && $n2 < 2*$pow) {
# $count++;
# last;
# }
}
}
my $value = ($count - $prev_count)/1;
# my $value = $count/2;
# my $value = $count;
printf "%2d %4d %10b\n", $k, $value, $value;
push @values, $value;
$prev_count = $count;
}
shift @values;
shift @values;
print join(',',@values),"\n";
Math::OEIS::Grep->search(array=>\@values);
exit 0;
}
{
# counting all 4 directions, is boundary length
# 2 * A003476 a(n) = a(n-1) + 2a(n-3).
# 1, 2, 3, 5, 9, 15, 25, 43, 73, 123, 209, 355,
# A203175 nX2 arrays 1, 1, 2, 4, 6, 10, 18, 30, 50, 86, 146, 246, 418, 710,
# 1 immediately preceded by 0 to the left or above
# 0 not immediately preceded by a 0
# 2 immediately preceded by 0 1 to the left or above
# 4,6,10,18,30,50,86,146,246,418,710,1202,2038,3458
#
# 30 = 18+2*6
#
# A052537 2*A or 2*B or 2*C
# n=4 a(4)=4
# 0,1 0,1 0,1 0,1
# 1,0 1,0 1,0 1,0
# 0,1 0,1 2,1 2,1
# 1,0 1,2 0,1 0,2
# [2] [2] [2] [1] = 7
#
# n=5 a(4)=6
# 0,1 0,1 0,1 0,1 0,1 0,1
# 1,0 1,0 1,0 1,0 1,0 1,0
# 0,1 0,1 0,1 2,1 2,1 0,1
# 1,0 1,2 1,0 0,1 0,2 1,2
# 2,1 2,0 0,1 1,0 1,0 0,1
# [2] [?] [2] [2] [2] [2] = 10
#
# 0,1 -> 1,0 later 1,2
# 0,2 -> 1,0
# 1,0 -> 0,1 2,1
# 1,2 -> 0,1 2,0
# 2,0 ->
# 2,1 -> 0,1 0,2
# +---+---+
# | 0 1 | boundary[2^1] = 6
# +---+---+
# +---+---+
# | 2 3 |
# +---+ +---+
# | 0 1 |
# +---+---+
# (2n-1 0 2n ) (a)
# (n^2-2n+2 0 (n-1)^2 ) (b)
# (0 1 0 ) (c)
#
# inverse [ (n^2 - 2*n + 1)/(-n^2 - 1) -2*n/(-n^2 - 1) 0]
# [ 0 0 1]
# [(-n^2 + 2*n - 2)/(-n^2 - 1) (2*n - 1)/(-n^2 - 1) 0]
#
# c[k] = b[k-1]
# a[k] = (2n-1)a[k-1] + 2n*c[k-1]
#
# m = [2*n-1,0,2*n; n^2-2*n+2,0,(n-1)^2; 0,1,0]
# v = [n;n^2+1-n;1] so m*v transforms to new A,B,C
# m^-1*v = [n ; 1; 1-n]
# t=[0,0,0; 0,0,0; 1,1,1]
# f=[0,1,0; 0,0,1; 1,0,0]
# f*t=[0,0,0; 1,1,1; 0,0,0]
# f^2*t=[1,1,1; 0,0,0; 0,0,0]
# s=(t + f*t*m + f^2*t*m^2)
# s*abc = l210
# s*m*abc = r*l210
# s*m*abc = r*s*abc
# s*m = r*s
# r = s*m*s^-1
# r=s*m*s^-1 = [ 2*n-1, n^2+1 - 2*n, n^2+1]
# [1 0 0]
# [0 1 0]
#
# (1 0 2) ( 0 1 0) r=1 initial (1) prev (1)
# (1 0 0) ( 0 0 1) (1) (1)
# (0 1 0) ( 1/2 -1/2 0) (1) (0)
# m=[1,0,2;1,0,0;0,1,0]
#
# (3 0 4) (-1/5 4/5 0) r=2 initial (2) prev -2+4*3 = 2
# (2 0 1) ( 0 0 1) (3) = 1
# (0 1 0) ( 2/5 -3/5 0) (1) = -1
# m=[3,0,4;2,0,1;0,1,0]
# 20 21 22 23 24
# 15 16 17 18 19
# 10 11 12 13 14
# 5 6 7 8 9
# 0 1 2 3 4
# 0 -> 4
# 5 -> 12
# 25 -> (5+8+5)*2 = 36
# l2 = 2*(norm # top
# + r*(norm-1) # steps
# + norm) # side
# = 2*(norm + r*norm - r + norm)
# = 2*(2*norm + r*norm - r)
# = 2*((r+2)*norm - r)
# = 2*((r+2)*norm - r-2 +2))
# = 2*((r+2)*norm - (r+2) +2))
# = 2*(r+2)*(norm-1) + 4
my $r = 2;
my $norm = $r*$r+1;
sub boundary_by_recurrence {
my ($k) = @_;
# my $l2 = 2*$r**3 + 4*$r**2 + 4;
my $l2 = 2*($norm-1)*($r+2) + 4;
my $l1 = 2*$norm + 2;
my $l0 = 4;
foreach (1 .. $k) {
($l2,$l1,$l0) = ((2*$r-1) * $l2
+ ($norm - 2*$r) * $l1
+ $norm * $l0,
$l2, $l1);
# ($l2,$l1,$l0) = ((2*$r-1)*$l2
# + ($r**2+1 - 2*$r)*$l1
# + ($r**2+1)*$l0,
#
# $l2, $l1);
}
return $l0;
}
sub abc_by_pow {
my ($k) = @_;
# my $a = 2*2;
# my $b = 1*2;
# my $c = -1*2;
# my $a = $r*2;
# my $b = ($norm-$r)*2;
# my $c = 1*2;
# my $a = 2 * $r / ($r*$r+1);
# my $b = 2 * ($r*$r+1 - $r) / ($r*$r+1);
# my $c = 2 * 1;
my $a = 2*$r;
my $b = 2;
my $c = 2*(1-$r);
foreach (1 .. $k) {
($a,$b,$c) = ((2*$r-1)*$a + 0 + 2*$r*$c,
($r*$r-2*$r+2)*$a + 0 + ($r-1)*($r-1)*$c,
0 + $b);
}
return ($a,$b,$c);
}
sub boundary_by_pow {
my ($k) = @_;
my ($a,$b,$c) = abc_by_pow($k);
return 2*($a+$b+$c);
}
my @values;
my $path = Math::PlanePath::ComplexMinus->new (realpart => $r);
my $prev_len = 1;
my $prev_ratio = 1;
foreach my $k (1 .. 30) {
my $pow = $norm**$k;
my $len = 0; #path_boundary_length($path,$pow);
my $len_by_pow = boundary_by_pow($k);
my $len_by_rec = boundary_by_recurrence($k);
my $ratio = $pow / $len_by_pow;
my $f = 2* log($len_by_pow / $prev_len) / log($norm);
printf "%2d %s %s %s %.6f\n", $k, $len, $len_by_pow, $len_by_rec, $f;
my ($a,$b,$c) = abc_by_pow($k);
push @values, $a;
$prev_len = $len_by_pow;
$prev_ratio = $ratio;
}
print "seek ",join(', ',@values),"\n";
Math::OEIS::Grep->search(array=>\@values);
exit 0;
}
BEGIN {
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
sub path_boundary_length {
my ($path, $n_below) = @_;
### $n_below
my $boundary = 0;
my %seen;
my @pending_x = (0);
my @pending_y = (0);
while (@pending_x) {
my $x = pop @pending_x;
my $y = pop @pending_y;
next if $seen{$x}{$y};
foreach my $i (0 .. $#dir4_to_dx) {
my $ox = $x + $dir4_to_dx[$i];
my $oy = $y + $dir4_to_dy[$i];
### consider: "$x,$y to $ox,$oy"
my $n = $path->xy_to_n($ox,$oy);
if ($n >= $n_below) {
### outside ...
$boundary++;
} else {
### inside ...
push @pending_x, $ox;
push @pending_y, $oy;
}
}
$seen{$x}{$y} = 1;
}
return $boundary;
}
}
{
# min/max rectangle
#
# repeat at dx,dy
require Math::BaseCnv;
my $xmin = 0;
my $xmax = 0;
my $ymin = 0;
my $ymax = 0;
my $dx = 1;
my $dy = 0;
my $realpart = 2;
my $norm = $realpart*$realpart + 1;
printf "level xmin xmax xdiff | ymin ymax ydiff\n";
for (0 .. 22) {
my $xminR = Math::BaseCnv::cnv($xmin,10,$norm);
my $yminR = Math::BaseCnv::cnv($ymin,10,$norm);
my $xmaxR = Math::BaseCnv::cnv($xmax,10,$norm);
my $ymaxR = Math::BaseCnv::cnv($ymax,10,$norm);
my $xdiff = $xmax - $xmin;
my $ydiff = $ymax - $ymin;
my $xdiffR = Math::BaseCnv::cnv($xdiff,10,$norm);
my $ydiffR = Math::BaseCnv::cnv($ydiff,10,$norm);
printf "%2d %11s %11s =%11s | %11s %11s =%11s\n",
$_,
$xminR,$xmaxR,$xdiffR,
$yminR,$ymaxR,$ydiffR;
$xmax = max ($xmax, $xmax + $dx*($norm-1));
$ymax = max ($ymax, $ymax + $dy*($norm-1));
$xmin = min ($xmin, $xmin + $dx*($norm-1));
$ymin = min ($ymin, $ymin + $dy*($norm-1));
### assert: $xmin <= 0
### assert: $ymin <= 0
### assert: $xmax >= 0
### assert: $ymax >= 0
# multiply i-r, ie. (dx,dy) = (dx + i*dy)*(i-$realpart)
$dy = -$dy;
($dx,$dy) = ($dy - $realpart*$dx,
$dx + $realpart*$dy);
}
# print 3*$xmin/$len+.001," / 3\n";
# print 6*$xmax/$len+.001," / 6\n";
# print 3*$ymin/$len+.001," / 3\n";
# print 3*$ymax/$len+.001," / 3\n";
exit 0;
sub to_bin {
my ($n) = @_;
return ($n < 0 ? '-' : '') . sprintf('%b', abs($n));
}
}
{
# min/max hypot for level
$|=1;
my $realpart = 2;
my $norm = $realpart**2 + 1;
my $path = Math::PlanePath::ComplexMinus->new (realpart => $realpart);
my $prev_min = 1;
my $prev_max = 1;
for (my $level = 1; $level < 25; $level++) {
my $n_start = $norm**($level-1);
my $n_end = $norm**$level;
my $min_hypot = POSIX::DBL_MAX();
my $min_x = 0;
my $min_y = 0;
my $min_pos = '';
my $max_hypot = 0;
my $max_x = 0;
my $max_y = 0;
my $max_pos = '';
print "level $level n=$n_start .. $n_end\n";
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
my $h = $x*$x + $y*$y;
if ($h < $min_hypot) {
$min_hypot = $h;
$min_pos = "$x,$y";
}
if ($h > $max_hypot) {
$max_hypot = $h;
$max_pos = "$x,$y";
}
}
# print "$min_hypot,";
# print " min $min_hypot at $min_x,$min_y\n";
# print " max $max_hypot at $max_x,$max_y\n";
{
my $factor = $min_hypot / $prev_min;
print " min r^2 $min_hypot 0b".sprintf('%b',$min_hypot)." at $min_pos factor $factor\n";
print " cf formula ", 2**($level-7), "\n";
}
# {
# my $factor = $max_hypot / $prev_max;
# print " max r^2 $max_hypot 0b".sprintf('%b',$max_hypot)." at $max_pos factor $factor\n";
# }
$prev_min = $min_hypot;
$prev_max = $max_hypot;
}
exit 0;
}
{
# covered inner rect
# depends on which coord extended first
require Math::BaseCnv;
$|=1;
my $realpart = 1;
my $norm = $realpart**2 + 1;
my $path = Math::PlanePath::ComplexMinus->new (realpart => $realpart);
my %seen;
my $xmin = 0;
my $xmax = 0;
my $ymin = 0;
my $ymax = 0;
for (my $level = 1; $level < 25; $level++) {
my $n_start = $norm**($level-1);
my $n_end = $norm**$level - 1;
foreach my $n ($n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
$seen{"$x,$y"} = 1;
$xmin = min ($xmin, $x);
$xmax = max ($xmax, $x);
$ymin = min ($ymin, $y);
$ymax = max ($ymax, $y);
}
my $x1 = 0;
my $y1 = 0;
my $x2 = 0;
my $y2 = 0;
for (;;) {
my $more = 0;
{
my $x = $x1-1;
my $good = 1;
foreach my $y ($y1 .. $y2) {
if (! $seen{"$x,$y"}) {
$good = 0;
last;
}
}
if ($good) {
$more = 1;
$x1 = $x;
}
}
{
my $x = $x2+1;
my $good = 1;
foreach my $y ($y1 .. $y2) {
if (! $seen{"$x,$y"}) {
$good = 0;
last;
}
}
if ($good) {
$more = 1;
$x2 = $x;
}
}
{
my $y = $y1-1;
my $good = 1;
foreach my $x ($x1 .. $x2) {
if (! $seen{"$x,$y"}) {
$good = 0;
last;
}
}
if ($good) {
$more = 1;
$y1 = $y;
}
}
{
my $y = $y2+1;
my $good = 1;
foreach my $x ($x1 .. $x2) {
if (! $seen{"$x,$y"}) {
$good = 0;
last;
}
}
if ($good) {
$more = 1;
$y2 = $y;
}
}
last if ! $more;
}
printf "%2d %10s %10s %10s %10s\n",
$level,
Math::BaseCnv::cnv($x1,10,2),
Math::BaseCnv::cnv($x2,10,2),
Math::BaseCnv::cnv($y1,10,2),
Math::BaseCnv::cnv($y2,10,2);
}
exit 0;
}
{
# n=2^k bits
require Math::BaseCnv;
my $path = Math::PlanePath::ComplexMinus->new;
foreach my $i (0 .. 16) {
my $n = 2**$i;
my ($x,$y) = $path->n_to_xy($n);
my $x2 = Math::BaseCnv::cnv($x,10,2);
my $y2 = Math::BaseCnv::cnv($y,10,2);
printf "%#7X %12s %12s\n", $n, $x2, $y2;
}
print "\n";
# X axis bits
require Math::BaseCnv;
foreach my $x (0 .. 400) {
my $n = $path->xy_to_n($x,0);
my $w = int(log($n||1)/log(2)) + 2;
my $n2 = Math::BaseCnv::cnv($n,10,2);
print "x=$x n=$n = $n2\n";
for (my $bit = 1; $bit <= $n; $bit <<= 1) {
if ($n & $bit) {
my ($x,$y) = $path->n_to_xy($bit);
my $x2 = Math::BaseCnv::cnv($x,10,2);
my $y2 = Math::BaseCnv::cnv($y,10,2);
printf " %#*X %*s %*s\n", $w, $bit, $w, $x2, $w, $y2;
}
}
}
print "\n";
exit 0;
}
{
# X axis generating
# hex 1 any X=0x1 or -1
# 2 never
# C bits 4,8 together X=0x2 or -2
my @ns = (0, 1, 0xC, 0xD);
my @xseen;
foreach my $pos (1 .. 5) {
push @ns, map {16*$_+0, 16*$_+1, 16*$_+0xC, 16*$_+0xD} @ns;
}
my $path = Math::PlanePath::ComplexMinus->new;
require Set::IntSpan::Fast;
my $set = Set::IntSpan::Fast->new;
foreach my $n (@ns) {
my ($x,$y) = $path->n_to_xy($n);
$y == 0 or die "n=$n x=$x y=$y";
$set->add($x);
}
print "ok $#ns\n";
print "x span ",$set->as_string,"\n";
print "x card ",$set->cardinality,"\n";
exit 0;
}
{
# n=2^k bits
require Math::BaseCnv;
my $path = Math::PlanePath::ComplexMinus->new;
foreach my $i (0 .. 20) {
my $n = 2**$i;
my ($x,$y) = $path->n_to_xy($n);
my $x2 = Math::BaseCnv::cnv($x,10,2);
my $y2 = Math::BaseCnv::cnv($y,10,2);
printf "%6X %20s %11s\n", $n, $x2, $y2;
}
print "\n";
exit 0;
}
{
require Math::NumSeq::PlanePathDelta;
my $seq = Math::NumSeq::PlanePathDelta->new (planepath=> 'ComplexMinus',
delta_type => 'dX');
foreach my $i (0 .. 50) {
my ($i,$value) = $seq->next;
print "$value,";
}
print "\n";
exit 0;
}
{
# max Dir4
require Math::BaseCnv;
print 4-atan2(2,1)/atan2(1,1)/2,"\n";
require Math::NumSeq::PlanePathDelta;
my $realpart = 3;
my $radix = $realpart*$realpart + 1;
my $seq = Math::NumSeq::PlanePathDelta->new (planepath => "ComplexPlus,realpart=$realpart",
delta_type => 'Dir4');
my $dx_seq = Math::NumSeq::PlanePathDelta->new (planepath => "ComplexPlus,realpart=$realpart",
delta_type => 'dX');
my $dy_seq = Math::NumSeq::PlanePathDelta->new (planepath => "ComplexPlus,realpart=$realpart",
delta_type => 'dY');
my $max = 0;
for (1 .. 1000000) {
my ($i, $value) = $seq->next;
# foreach my $k (1 .. 1000000) {
# my $i = $radix ** (4*$k+3) - 1;
# my $value = $seq->ith($i);
if ($value > $max) {
my $dx = $dx_seq->ith($i);
my $dy = $dy_seq->ith($i);
my $ri = Math::BaseCnv::cnv($i,10,$radix);
my $rdx = Math::BaseCnv::cnv($dx,10,$radix);
my $rdy = Math::BaseCnv::cnv($dy,10,$radix);
my $f = $dy && $dx/$dy;
printf "%d %s %.5f %s %s %.3f\n", $i, $ri, $value, $rdx,$rdy, $f;
$max = $value;
}
}
exit 0;
}
{
# innermost points coverage
require Math::BaseCnv;
foreach my $realpart (1 .. 20) {
my $norm = $realpart**2 + 1;
my $path = Math::PlanePath::ComplexMinus->new (realpart => $realpart);
my $n_max = 0;
my $show = sub {
my ($x,$y) = @_;
my $n = $path->xy_to_n($x,$y);
print "$x,$y n=$n\n";
if ($n > $n_max) {
$n_max = $n;
}
};
$show->(1,0);
$show->(1,1);
$show->(0,1);
$show->(-1,1);
$show->(-1,0);
$show->(-1,-1);
$show->(0,-1);
$show->(1,-1);
my $n_max_base = to_base($n_max,$norm);
my $n_max_log = log($n_max)/log($norm);
print "n_max $n_max $n_max_base $n_max_log\n";
print "\n";
}
exit 0;
sub to_base {
my ($n, $radix) = @_;
my $ret = '';
do {
my $digit = $n % $radix;
$ret = "[$digit]$ret";
} while ($n = int($n/$radix));
return $ret;
}
}
{
require Math::PlanePath::ComplexPlus;
require Math::BigInt;
my $realpart = 10;
my $norm = $realpart*$realpart + 1;
### $norm
my $path = Math::PlanePath::ComplexPlus->new (realpart=>$realpart);
my $prev_dist = 1;
print sqrt($norm),"\n";
foreach my $level (1 .. 10) {
my $n = Math::BigInt->new($norm) ** $level - 1;
my ($x,$y) = $path->n_to_xy($n);
my $radians = atan2($y,$x);
my $degrees = $radians / 3.141592 * 180;
my $dist = sqrt($x*$x+$y*$y);
my $f = $dist / $prev_dist;
printf "%2d %.2f %.4f %.2f\n",
$level, $dist, $f, $degrees;
$prev_dist = $dist;
}
exit 0;
}
{
require Math::PlanePath::ComplexPlus;
my $path = Math::PlanePath::ComplexPlus->new (realpart=>2);
foreach my $i (0 .. 10) {
{
my $x = $i;
my $y = 1;
my $n = $path->xy_to_n($x,$y);
if (! defined $n) { $n = 'undef'; }
print "xy_to_n($x,$y) = $n\n";
}
}
foreach my $i (0 .. 10) {
{
my $n = $i;
my ($x,$y) = $path->n_to_xy($n);
print "n_to_xy($n) = $x,$y\n";
}
}
exit 0;
}
{
my $count = 0;
my $realpart = 5;
my $norm = $realpart*$realpart+1;
foreach my $x (-200 .. 200) {
foreach my $y (-200 .. 200) {
my $new_x = $x;
my $neg_y = $x - $y*$realpart;
my $digit = $neg_y % $norm;
$new_x -= $digit;
$neg_y -= $digit;
next unless ($new_x*$realpart+$y)/$norm == $x;
next unless -$neg_y/$norm == $y;
print "$x,$y digit=$digit\n";
$count++;
}
}
print "count $count\n";
exit 0;
}
Math-PlanePath-122/devel/grep-values.pl 0000644 0001750 0001750 00000165073 12562515170 015605 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# DragonCurve,arms=2 boundary (by powers full diffs all):
# 20,28,52,92,148,252,436,732,1236,2108,3572,6044
# match 20,28,52,92,148,252,436,732,1236,2108,3572,6044
# [HALF]
# A052537 Expansion of (1-x)/(1-x-2x^3).
# A052537 ,1,0,0,2,2,2,6,10,14,26,46,74,126,218,366,618,1054,1786,3022,5130,8702,14746,25006,42410,71902,121914,206734,350538,594366,1007834,1708910,2897642,4913310,8331130,14126414,23953034,40615294,68868122,116774190,198004778,
# Rationals tree inter-row area
# 2*area = A048487 a(n) = 5*2^n-4 T(4,n), array T given by A048483.
# area = A051633 5*2^n - 2.
# same A131051 Row sums of triangle A133805.
# A126284 5*2^n-4*n-5 total*2
#
# A001541
# alt paper
# A129284 A129150(n) / 4.
# A129285 A129151(n) / 27.
# A131128 Binomial transform of [1, 1, 5, 1, 5, 1, 5,...].
#
# Math::PlanePath::AlternatePaper area:
# = alt midpoint unit squares
# A027383 Number of balanced strings of length n: let d(S)= #(1)'s in S - #(0)'s, then S is balanced if every substring T has -2<=d(T)<=2.
# partial sums of A016116
# a(2n-1) = 2^(n+1)-2 = A000918(n+1).
# a(2n) = 3*2^n-2 = A033484(n);
# a(2n+1) = 2^(n+2)-2
# = 4*2^n-2
# Math::PlanePath::GosperReplicate unit hexagons boundary
# A178674 = 3^n+3
use 5.010;
use strict;
use List::Util 'min', 'max';
use Module::Load;
use Math::Libm 'hypot';
use List::Pairwise;
use Math::BaseCnv;
use lib 'xt';
use MyOEIS;
use Math::OEIS::Grep;
# uncomment this to run the ### lines
# use Smart::Comments;
{
# X,Y repeat count
require Math::NumSeq::PlanePathCoord;
foreach my $elem (
# curves with overlaps only
['HilbertSides', 2],
['DragonCurve', 2],
['R5DragonCurve', 5],
['CCurve', 2],
['TerdragonCurve', 3, 'triangular'],
['AlternatePaper', 4],
['AlternatePaper', 2],
) {
my ($name, $radix, $lattice_type) = @$elem;
$lattice_type ||= 'square';
my $path = Math::NumSeq::PlanePathCoord::_planepath_name_to_object($name);
print "$name\n";
{
my @values;
foreach my $n (15 .. 40) {
my ($x,$y) = $path->n_to_xy($n);
my @n_list = $path->xy_to_n_list($x,$y);
my $count = scalar(@n_list);
push @values, $count;
}
print "\n$name counts:\n";
shift_off_zeros(\@values);
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
array_diffs(\@values);
Math::OEIS::Grep->search(array => \@values, name => "diffs");
}
if (0) {
my @values;
foreach my $level (3 .. 8) {
my $count = 0;
my $n_hi = $radix**($level+1) - 1;
last if $n_hi > 50_000;
foreach my $n ($radix**$level .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
my @n_list = $path->xy_to_n_list($x,$y);
$count += scalar(@n_list);
}
push @values, $count;
}
# if ($diffs) {
# foreach my $i (reverse 1 .. $#areas) {
# $areas[$i] -= $areas[$i-1];
# }
print "\n$name total in powers $radix\n";
shift_off_zeros(\@values);
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
print "\n";
array_diffs(\@values);
Math::OEIS::Grep->search(array => \@values, name => "diffs");
}
}
exit 0;
sub array_diffs {
my ($aref) = @_;
foreach my $i (0 .. $#$aref-1) {
$aref->[$i] = $aref->[$i+1] - $aref->[$i];
}
$#$aref--;
}
}
{
# single, double, triple visited counts in levels
require Math::NumSeq::PlanePathCoord;
foreach my $elem (
# curves with overlaps only
['HilbertSides', 2],
['TerdragonCurve', 3],
['R5DragonCurve', 5],
['AlternatePaper', 4],
['AlternatePaper', 2],
['CCurve', 2],
['DragonCurve', 2],
) {
my ($name, $radix) = @$elem;
print "$name\n";
my $path = Math::NumSeq::PlanePathCoord::_planepath_name_to_object($name);
my $n_start = $path->n_start;
my (@singles, @doubles, @triples);
foreach my $inc_type ('powers') {
for (my $level = 3; ; $level++) {
my $n_end = $radix**$level;
last if $n_end > 20_000;
last if @singles > 25;
my @counts = path_n_to_visit_counts($path, $n_end);
push @singles, $counts[0] || 0;
push @doubles, $counts[1] || 0;
push @triples, $counts[2] || 0;
print "$level $n_end $singles[-1] $doubles[-1] $triples[-1]\n";
}
{
shift_off_zeros(\@singles);
print join(',',@singles),"\n";
Math::OEIS::Grep->search(array => \@singles,
name => 'singles');
}
{
shift_off_zeros(\@doubles);
print join(',',@doubles),"\n";
Math::OEIS::Grep->search(array => \@doubles,
name => 'doubles');
}
if ($triples[-1]) {
shift_off_zeros(\@triples);
print join(',',@triples),"\n";
Math::OEIS::Grep->search(array => \@triples,
name => 'triples');
}
print "\n";
}
}
exit 0;
sub path_n_to_visit_counts {
my ($path, $n_end) = @_;
my @counts;
foreach my $n ($path->n_start .. $n_end) {
my ($x,$y) = $path->n_to_xy($n);
my @n_list = $path->xy_to_n_list($x,$y);
if ($n_list[0] == $n) {
@n_list = grep {$_<=$n_end} @n_list;
$counts[scalar(@n_list)]++;
}
}
shift @counts;
return @counts;
}
}
{
# X,Y at N=2^k
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
@choices = grep {$_ ne 'CellularRule'} @choices;
# @choices = grep {$_ ne 'Rows'} @choices;
# @choices = grep {$_ ne 'Columns'} @choices;
@choices = grep {$_ ne 'ArchimedeanChords'} @choices;
@choices = grep {$_ ne 'TheodorusSpiral'} @choices;
@choices = grep {$_ ne 'MultipleRings'} @choices;
@choices = grep {$_ ne 'VogelFloret'} @choices;
@choices = grep {$_ ne 'UlamWarburtonAway'} @choices;
@choices = grep {$_ !~ /Hypot|ByCells|SumFractions|WythoffTriangle/} @choices;
# @choices = grep {$_ ne 'PythagoreanTree'} @choices;
# @choices = grep {$_ ne 'PeanoHalf'} @choices;
@choices = grep {$_ !~ /EToothpick|LToothpick|Surround|Peninsula/} @choices;
#
# @choices = grep {$_ ne 'CornerReplicate'} @choices;
@choices = grep {$_ ne 'HilbertSides'} @choices;
unshift @choices, 'HilbertSides';
my $num_choices = scalar(@choices);
print "$num_choices choices\n";
my @path_objects;
my %path_fullnames;
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
### $class
Module::Load::load($class);
my $parameters = parameter_info_list_to_parameters
($class->parameter_info_list);
foreach my $p (@$parameters) {
my $path_object = $class->new (@$p);
push @path_objects, $path_object;
$path_fullnames{$path_object} = "$name ".join(',',@$p);
}
}
my $num_path_objects = scalar(@path_objects);
print "total path objects $num_path_objects\n";
my $start_t = time();
my $t = $start_t-8;
my $i = 0;
# until ($path_objects[$i]->isa('Math::PlanePath::TerdragonCurve')) {
# $i++;
# }
for ( ; $i <= $#path_objects; $i++) {
my $path = $path_objects[$i];
my $fullname = $path_fullnames{$path};
print "$fullname\n";
foreach my $coord_idx (0, 1) {
my $fullname = $fullname." ".($coord_idx?'Y':'X');
my @values;
for (my $k = Math::BigInt->new(1); $k <= 12; $k++) {
my ($n_lo, $n_hi) = $path->level_to_n_range($k);
$n_hi //= 2**$k;
my @coords = $path->n_to_xy($n_hi);
my $value = $coords[$coord_idx];
push @values, $value;
}
shift @values;
Math::OEIS::Grep->search(array => \@values, name => $fullname);
}
}
exit 0;
}
{
# NSEW segment counts
# AlternatePaper A005418, A051437, A122746=A032085, A007179
# cf Wests A122746 = area increment
#
my $radix = 2;
my $name = 'Math::PlanePath::CCurve';
$name = 'Math::PlanePath::AlternatePaper';
$name = 'Math::PlanePath::DragonCurve'; # A038503, A038504, A038505, A000749 same CCurve
$name = 'Math::PlanePath::DragonMidpoint'; # x, x, 2*A038505, 2*A000749
$name = 'Math::PlanePath::TerdragonMidpoint'; $radix=3; # none
$name = 'Math::PlanePath::PeanoCurve'; $radix=3;
$name = 'Math::PlanePath::BetaOmega'; $radix=2;
$name = 'Math::PlanePath::KochelCurve'; $radix=2;
$name = 'Math::PlanePath::CincoCurve'; $radix=25;
$name = 'Math::PlanePath::WunderlichMeander'; $radix=3; # none
$name = 'Math::PlanePath::KochCurve'; $radix=4; # a=A087433,b,c=2*A081674,d,e=A081674,x
$name = 'Math::PlanePath::KochCurve'; $radix=2; # a=A036557,e=A000773
$name = 'Math::PlanePath::DekkingCentres'; $radix=25; # NE=NW=SW=SE=A218728=sum 25^i
$name = 'Math::PlanePath::HIndexing'; $radix=4; # A007583,A079319,A020988=(2/3)*(4^n-1),2*A006095
$name = 'Math::PlanePath::QuintetCurve'; $radix=5; # QuintetCentres
$name = 'Math::PlanePath::QuadricCurve'; $radix=8; # 2*A063481, A013730=2^(3n+1), 2*A059409, A013730=2^(3n+1)
$name = 'Math::PlanePath::WunderlichSerpentine,serpentine_type=coil'; $radix=3; # none
$name = 'Math::PlanePath::SierpinskiCurve'; $radix=4; # A079319,A007581,A002450,A006095=(2^n-1)*(2^(n-1) -1)/3,A203241,A006095,A002450,A076024=(2^n+4)*(2^n-1)/6
$name = 'Math::PlanePath::SierpinskiCurveStair'; $radix=4; # A093069=Kynea,A099393,A060867,A020515
$name = 'Math::PlanePath::SierpinskiArrowheadCentres'; $radix=3; # West=A094555
$name = 'Math::PlanePath::SierpinskiArrowhead'; $radix=3; # West=A094555
$name = 'Math::PlanePath::FibonacciWordFractal'; $radix=2;
$name = 'Math::PlanePath::AlternatePaperMidpoint'; # 2*A005418 cf fxtbook, A052957=2*A051437altN, A233411, A014236
$name = 'Math::PlanePath::DekkingCurve'; $radix=25; # North=South, West=A060870=Cinco.West=sum 5^i
$name = 'Math::PlanePath::HilbertSpiral'; $radix=2;
$name = 'Math::PlanePath::HilbertCurve'; $radix=4; # A083885, diff 4^k A123641
$name = 'Math::PlanePath::TerdragonCurve'; $radix=3; # A092236, A135254, A133474
$name = 'Math::PlanePath::R5DragonCurve'; $radix=5; # none
require Math::NumSeq::PlanePathCoord;
my $path = Math::NumSeq::PlanePathCoord::_planepath_name_to_object($name);
my %count;
my %count_arrays;
my $n = 0;
my @dxdy_strs = List::Pairwise::mapp {"$a,$b"} $path->_UNDOCUMENTED__dxdy_list;
require Math::NumSeq::Fibonacci;
require Math::NumSeq::Fibbinary;
my $fib = Math::NumSeq::Fibonacci->new;
my $fibbinary = Math::NumSeq::Fibbinary->new;
foreach my $k (0 .. 10) {
my $n_end = $radix**$k;
# $n_end = $k;
# $n_end = $fib->ith(2*$k);
last if $n_end > 500_000;
for ( ; $n < $n_end; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n);
$count{"$dx,$dy"}++;
}
printf "k=%2d ", $k;
foreach my $dxdy (@dxdy_strs) {
my $a = $count{$dxdy} || 0;
my $aref = ($count_arrays{$dxdy} ||= []);
# push @$aref, $a - $radix**($k-1); # diff from radix^k
push @$aref, $a;
# $a = $fibbinary->ith($a);
my $ar = Math::BaseCnv::cnv($a,10,$radix);
printf " %18s", $ar;
}
print "\n";
}
my $trim = 1;
foreach my $dxdy (@dxdy_strs) {
my $aref = $count_arrays{$dxdy} || [];
splice @$aref, 0, $trim;
# @$aref = MyOEIS::first_differences(@$aref);
print "$dxdy\n";
print "is ", join(',',@$aref),"\n";
Math::OEIS::Grep->search(array => \@$aref, name => $dxdy);
}
# print "\n";
# foreach my $k (0 .. $#a) {
# my $h = int($k/2);
# printf "%3d,", $d[$k];
# }
# print "\n";
exit 0;
}
{
# boundary and area, variations convex hull, minrectangle, etc
# Terdragon convex hull 14 points
# Dragon convex hull 10 points, arms=4 12 points
require Math::Geometry::Planar;
require Math::NumSeq::PlanePathCoord;
foreach my $elem (
# curves with overlaps only
['TerdragonCurve', 3, 'triangular'],
['TerdragonCurve,arms=6', 3, 'triangular'],
['CCurve', 2],
['DragonCurve', 2],
['DragonCurve,arms=3', 2],
['DragonCurve,arms=2', 2],
['R5DragonCurve', 5],
['DragonCurve,arms=4', 2],
['AlternatePaper', 2],
['AlternatePaper', 4],
) {
my ($name, $radix, $lattice_type) = @$elem;
$lattice_type ||= 'square';
print "$name\n";
my $path = Math::NumSeq::PlanePathCoord::_planepath_name_to_object($name);
my $n_start = $path->n_start;
my $arms = $path->arms_count;
foreach my $inc_type ('powers',
'1',
) {
foreach my $diffs ('', 'diffs') {
foreach my $convex_type (
# 'bbox',
'minrectangle',
# 'convex',
# 'full',
# ($inc_type eq 'powers'
# ? ('left','right')
# : ()),
) {
my @areas;
my @boundaries;
for (my $level = ($inc_type eq 'powers' ? 0 : 3);
;
$level++) {
my $n_limit;
if ($inc_type eq 'powers') {
unless ((undef, $n_limit) = $path->level_to_n_range($level)) {
print "no levels for ",ref $path,"\n";
next;
}
} else {
$n_limit = $n_start + $level;
}
last if $n_limit > 20_000;
last if @areas > 25;
my $side = ($convex_type eq 'right' ? 'right'
: $convex_type eq 'left' ? 'left'
: 0);
print "n_limit=$n_limit side=$side\n";
my $points = MyOEIS::path_boundary_points ($path, $n_limit,
lattice_type => $lattice_type,
side => $side);
### $n_limit
### $points
my $area;
my $convex_area;
my $boundary;
if (@$points <= 1) {
$area = 0;
$boundary = 0;
} elsif (@$points == 2) {
$area = 0;
my $dx = $points->[0]->[0] - $points->[1]->[0];
my $dy = $points->[0]->[1] - $points->[1]->[1];
my $h = $dx*$dx + $dy*$dy*($lattice_type eq 'triangular' ? 3 : 0);
$boundary = 2*sqrt($h);
} else {
my $polygon = Math::Geometry::Planar->new;
$polygon->points($points);
if (($convex_type eq 'convex'
|| $convex_type eq 'minrectangle')
&& @$points >= 5) {
$polygon = $polygon->convexhull2;
$points = $polygon->points;
}
if ($convex_type eq 'bbox') {
$polygon = $polygon->bbox;
$points = $polygon->points;
}
if ($convex_type eq 'minrectangle') {
if (@$points <= 16) {
print " ",points_str($points),"\n";
}
$polygon = $polygon->minrectangle;
$points = $polygon->points;
}
$area = $polygon->area;
if ($lattice_type eq 'triangular') {
foreach my $p (@$points) {
$p->[1] *= sqrt(3);
# $p->[0] *= 1/2;
# $p->[1] *= sqrt(3)/2;
}
$polygon->points($points);
}
$boundary = $polygon->perimeter;
}
if ($convex_type eq 'right' || $convex_type eq 'left') {
$boundary = scalar(@$points) - 1;
# my ($end_x,$end_y) = $path->n_to_xy($n_limit);
# $boundary -= hypot($end_x,$end_y);
# $boundary = float_error($boundary);
}
push @areas, $area;
push @boundaries, $boundary;
my $notint = ($boundary == int($boundary) ? '' : ' (not int)');
my $num_points = scalar(@$points);
print "$level $n_limit points=$num_points area=$area boundary=$boundary$notint $convex_type\n";
if (@$points <= 10) {
print " ",points_str($points),"\n";
}
if (0) {
require Image::Base::GD;
my $width = 800;
my $height = 700;
my $image = Image::Base::GD->new (-width => $width, -height => $height);
$image->rectangle (0,0, $width-1,$height-1, 'black');
my $x_max = 0;
my $x_min = 0;
my $y_max = 0;
my $y_min = 0;
foreach my $p (@$points) {
my ($x,$y) = @$p;
$x_max = max($x_max, $x);
$y_max = max($y_max, $y);
$x_min = min($x_min, $x);
$y_min = min($y_min, $y);
}
my $x_size = $x_max - $x_min;
my $y_size = $y_max - $y_min;
$x_size *= 1.1;
$y_size *= 1.1;
my $x_scale = $width / $x_size;
my $y_scale = $height / ($y_size || 1);
my $scale = min($x_scale,$y_scale);
my $x_mid = ($x_min + $x_max) / 2;
my $y_mid = ($y_min + $y_max) / 2;
my $convert = sub {
my ($x,$y) = @_;
$x -= $x_mid; $y -= $y_mid;
$x *= $scale; $y *= $scale;
$x += $width/2; $y = $height/2 - $y;
return ($x,$y);
};
{
my ($x,$y) = $convert->(0,0);
$image->ellipse ($x-3,$y-3, $x+3,$y+3, 'white', 1);
}
foreach my $i (0 .. $#$points) {
my ($x1,$y1) = @{$points->[$i-1]};
my ($x2,$y2) = @{$points->[$i]};
($x1,$y1) = $convert->($x1,$y1);
($x2,$y2) = $convert->($x2,$y2);
$image->line ($x1,$y1, $x2,$y2, 'white');
}
$image->save('/tmp/x.png');
require IPC::Run;
IPC::Run::run (['xzgv','/tmp/x.png']);
}
}
if ($diffs) {
foreach my $i (reverse 1 .. $#areas) {
$areas[$i] -= $areas[$i-1];
}
foreach my $i (reverse 1 .. $#boundaries) {
$boundaries[$i] -= $boundaries[$i-1];
}
shift @areas;
shift @boundaries;
}
foreach my $alt_type (# 'even','odd',
'all') {
my @areas = @areas;
my @boundaries = @boundaries;
if ($alt_type eq 'odd') {
aref_keep_odds(\@areas);
aref_keep_odds(\@boundaries);
}
if ($alt_type eq 'even') {
aref_keep_evens(\@areas);
aref_keep_evens(\@boundaries);
}
print "\n$name area (by $inc_type $convex_type $diffs $alt_type):\n";
shift_off_zeros(\@areas);
print join(',',@areas),"\n";
Math::OEIS::Grep->search(array => \@areas);
print "\n$name boundary (by $inc_type $convex_type $diffs $alt_type):\n";
shift_off_zeros(\@boundaries);
print join(',',@boundaries),"\n";
Math::OEIS::Grep->search(array => \@boundaries);
print "\n";
}
}
}
}
}
exit 0;
sub points_str {
my ($points) = @_;
### points_str(): $points
my $count = scalar(@$points);
return "count=$count ".join(' ',map{join(',',@$_)}@$points)
}
# shift any leading zeros off @$aref
sub shift_off_zeros {
my ($aref) = @_;
while (@$aref && ! $aref->[0]) {
shift @$aref;
}
}
sub aref_keep_odds {
my ($aref) = @_;
@$aref = map { $_ & 1 ? $aref->[$_] : () } 0 .. $#$aref;
}
sub aref_keep_evens {
my ($aref) = @_;
@$aref = map { $_ & 1 ? () : $aref->[$_] } 0 .. $#$aref;
}
BEGIN {
my @dir6_to_dx = (2, 1,-1,-2, -1, 1);
my @dir6_to_dy = (0, 1, 1, 0, -1,-1);
sub path_boundary_points_triangular {
my ($path, $n_limit) = @_;
my @points;
my $x = 0;
my $y = 0;
my $dir6 = 4;
my @n_list = ($path->n_start);
for (;;) {
### at: "$x, $y dir6 = $dir6"
push @points, [$x,$y];
$dir6 -= 2; # rotate -120
foreach (1 .. 6) {
$dir6 %= 6;
my $dx = $dir6_to_dx[$dir6];
my $dy = $dir6_to_dy[$dir6];
my @next_n_list = $path->xy_to_n_list($x+$dx,$y+$dy);
### @next_n_list
if (any_consecutive(\@n_list, \@next_n_list, $n_limit)) {
@n_list = @next_n_list;
$x += $dx;
$y += $dy;
last;
}
$dir6++; # +60
}
if ($x == 0 && $y == 0) {
last;
}
}
return \@points;
}
}
}
{
# N on axes
my @dir8_to_dx = (1, 1, 0,-1, -1, -1, 0, 1);
my @dir8_to_dy = (0, 1, 1, 1, 0, -1, -1,-1);
my @dir8_to_line_type = ("X_axis",
"Diagonal",
"Y_axis",
"Diagonal_NW",
"X_neg",
"Diagonal_SW",
"Y_neg",
"Diagonal_SE");
require Math::NumSeq::PlanePathCoord;
require Math::NumSeq::PlanePathN;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
@choices = grep {$_ ne 'BinaryTerms'} @choices; # bit slow yet
@choices = grep {$_ =~ /Gray/} @choices;
@choices = ('ComplexMinus');
my %seen;
foreach my $path_name (@choices) {
print "$path_name\n";
my $path_class = "Math::PlanePath::$path_name";
Module::Load::load($path_class);
my $parameters = parameter_info_list_to_parameters($path_class->parameter_info_list);
PATH: foreach my $p (@$parameters) {
my $path = $path_class->new (@$p);
foreach my $dir (0 .. 7) {
my $line_type = $dir8_to_line_type[$dir];
my $seq = Math::NumSeq::PlanePathN->new (planepath_object => $path,
line_type => $line_type);
my $anum = $seq->oeis_anum;
print "$line_type seq anum ",($anum//'undef'),"\n";
next if defined $anum;
my $name = "$path_name dir=$dir ".join(',',@$p);
my $dx = $dir8_to_dx[$dir];
my $dy = $dir8_to_dy[$dir];
my $x = 2*$dx;
my $y = 2*$dy;
my @values;
foreach my $i (4 .. 30) {
my $value = $path->xy_to_n($x,$y) // last;
push @values, $value;
$x += $dx;
$y += $dy;
}
next unless @values;
Math::OEIS::Grep->search(name => $name,
array => \@values);
}
}
}
exit 0;
}
{
# N where two paths have same X,Y
# path1 RationalsTree tree_type,SB
# path2 RationalsTree tree_type,Drib
# path1 RationalsTree tree_type,CW
# path2 RationalsTree tree_type,Bird
# values: 3,34,38,40,44,51,55,57,61,522,538,546,562,590,606,614,630,648,664,672,688,716,732,740,756,779,795,803,819,847
# path1 RationalsTree tree_type,SB
# path2 RationalsTree tree_type,AYT
# path1 RationalsTree tree_type,AYT
# path2 RationalsTree tree_type,SB
# values: 6,11,54,91,438,731,3510,5851,28086,46811
# octal 1333333,6666666,repeating
# path1 RationalsTree tree_type,CW
# path2 RationalsTree tree_type,HCS
# path1 RationalsTree tree_type,HCS
# path2 RationalsTree tree_type,CW
# values: 5,14,45,118,365,950,2925,7606,23405,60854
# octal 166666,55555 repeating
# path1 RationalsTree tree_type,AYT
# path2 RationalsTree tree_type,Bird
# path1 RationalsTree tree_type,Bird
# path2 RationalsTree tree_type,AYT
# values: 5,12,41,100,329,804,2633,6436,21065,51492
# octal 1444444,511111 repeating
# path1 RationalsTree tree_type,HCS
# path2 RationalsTree tree_type,Drib
# path1 RationalsTree tree_type,Drib
# path2 RationalsTree tree_type,HCS
# values: 6,9,50,73,402,585,3218,4681,25746,37449
# octal 1111111,622222 repeating
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
@choices = grep {$_ ne 'CellularRule'} @choices;
@choices = grep {$_ ne 'Rows'} @choices;
@choices = grep {$_ ne 'Columns'} @choices;
@choices = grep {$_ ne 'ArchimedeanChords'} @choices;
@choices = grep {$_ ne 'MultipleRings'} @choices;
@choices = grep {$_ ne 'VogelFloret'} @choices;
@choices = grep {$_ ne 'PythagoreanTree'} @choices;
@choices = grep {$_ ne 'PeanoHalf'} @choices;
@choices = grep {$_ !~ /EToothpick|LToothpick|Surround|Peninsula/} @choices;
@choices = grep {$_ ne 'CornerReplicate'} @choices;
@choices = grep {$_ ne 'ZOrderCurve'} @choices;
unshift @choices, 'CornerReplicate', 'ZOrderCurve';
@choices = ('RationalsTree');
my $num_choices = scalar(@choices);
print "$num_choices choices\n";
my @path_objects;
my %path_fullnames;
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
Module::Load::load($class);
my $parameters = parameter_info_list_to_parameters
($class->parameter_info_list);
foreach my $p (@$parameters) {
my $path_object = $class->new (@$p);
push @path_objects, $path_object;
$path_fullnames{$path_object} = "$name ".join(',',@$p);
}
}
my $num_path_objects = scalar(@path_objects);
print "total path objects $num_path_objects\n";
my $start_t = time();
my $t = $start_t-8;
my $i = 0;
# until ($path_objects[$i]->isa('Math::PlanePath::DiamondArms')) {
# $i++;
# }
# while ($path_objects[$i]->isa('Math::PlanePath::PyramidSpiral')) {
# $i++;
# }
my $start_permutations = $i * ($num_path_objects-1);
my $num_permutations = $num_path_objects * ($num_path_objects-1);
open DEBUG, '>/tmp/permutations.out' or die;
select DEBUG or die; $| = 1; # autoflush
select STDOUT or die;
for ( ; $i <= $#path_objects; $i++) {
my $from_path = $path_objects[$i];
my $from_fullname = $path_fullnames{$from_path};
my $n_start = $from_path->n_start;
PATH: foreach my $j (0 .. $#path_objects) {
if (time()-$t < 0 || time()-$t > 10) {
my $upto_permutation = $i*$num_path_objects + $j || 1;
my $rem_permutation = $num_permutations
- ($start_permutations + $upto_permutation);
my $done_permutations = ($upto_permutation-$start_permutations);
my $percent = 100 * $done_permutations / $num_permutations || 1;
my $t_each = (time() - $start_t) / $done_permutations;
my $done_per_second = $done_permutations / (time() - $start_t);
my $eta = int($t_each * $rem_permutation);
my $s = $eta % 60; $eta = int($eta/60);
my $m = $eta % 60; $eta = int($eta/60);
my $h = $eta;
my $eta_str = sprintf '%d:%02d:%02d', $h,$m,$s;
print "$upto_permutation / $num_permutations est $eta_str (each $t_each)\n";
$t = time();
}
next if $i == $j;
my $to_path = $path_objects[$j];
next if $to_path->n_start != $n_start;
my $to_fullname = $path_fullnames{$to_path};
my $name = ("path1 $from_fullname\n"
. "path2 $to_fullname\n");
print DEBUG "$name\n";
my $str = '';
my @values;
my $gap = 0;
for (my $n = $n_start+2; @values < 30 && $gap < 100_000; $n++) {
my ($x1,$y1) = $from_path->n_to_xy($n)
or next PATH;
my ($x2,$y2) = $to_path->n_to_xy($n)
or next PATH;
if ($x1 == $x2 && $y1 == $y2) {
push @values, $n;
$gap = 0;
} else {
$gap++;
}
}
if (@values < 5) {
print DEBUG "only ",scalar(@values)," values: ",join(',',@values),"\n";
next;
}
print DEBUG "values: ",join(',',@values),"\n";
Math::OEIS::Grep->search(name => $name,
array => \@values);
print DEBUG "\n\n";
}
}
exit 0;
}
{
# permutation between two paths
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
@choices = grep {$_ ne 'CellularRule'} @choices;
@choices = grep {$_ ne 'Rows'} @choices;
@choices = grep {$_ ne 'Columns'} @choices;
@choices = grep {$_ ne 'ArchimedeanChords'} @choices;
@choices = grep {$_ ne 'MultipleRings'} @choices;
@choices = grep {$_ ne 'VogelFloret'} @choices;
@choices = grep {$_ ne 'PythagoreanTree'} @choices;
@choices = grep {$_ ne 'PeanoHalf'} @choices;
@choices = grep {$_ !~ /EToothpick|LToothpick|Surround|Peninsula/} @choices;
@choices = grep {$_ ne 'CornerReplicate'} @choices;
@choices = grep {$_ ne 'ZOrderCurve'} @choices;
unshift @choices, 'CornerReplicate', 'ZOrderCurve';
@choices = ('PythagoreanTree');
my $num_choices = scalar(@choices);
print "$num_choices choices\n";
my @path_objects;
my %path_fullnames;
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
Module::Load::load($class);
my $parameters = parameter_info_list_to_parameters
($class->parameter_info_list);
foreach my $p (@$parameters) {
my $path_object = $class->new (@$p);
push @path_objects, $path_object;
$path_fullnames{$path_object} = "$name ".join(',',@$p);
}
}
my $num_path_objects = scalar(@path_objects);
print "total path objects $num_path_objects\n";
my $start_t = time();
my $t = $start_t-8;
my $i = 0;
# until ($path_objects[$i]->isa('Math::PlanePath::DiamondArms')) {
# $i++;
# }
# while ($path_objects[$i]->isa('Math::PlanePath::PyramidSpiral')) {
# $i++;
# }
my $start_permutations = $i * ($num_path_objects-1);
my $num_permutations = $num_path_objects * ($num_path_objects-1);
open DEBUG, '>/tmp/permutations.out' or die;
select DEBUG or die; $| = 1; # autoflush
select STDOUT or die;
for ( ; $i <= $#path_objects; $i++) {
my $from_path = $path_objects[$i];
my $from_fullname = $path_fullnames{$from_path};
my $n_start = $from_path->n_start;
PATH: foreach my $j (0 .. $#path_objects) {
if (time()-$t < 0 || time()-$t > 10) {
my $upto_permutation = $i*$num_path_objects + $j || 1;
my $rem_permutation = $num_permutations
- ($start_permutations + $upto_permutation);
my $done_permutations = ($upto_permutation-$start_permutations);
my $percent = 100 * $done_permutations / $num_permutations || 1;
my $t_each = (time() - $start_t) / $done_permutations;
my $done_per_second = $done_permutations / (time() - $start_t);
my $eta = int($t_each * $rem_permutation);
my $s = $eta % 60; $eta = int($eta/60);
my $m = $eta % 60; $eta = int($eta/60);
my $h = $eta;
my $eta_str = sprintf '%d:%02d:%02d', $h,$m,$s;
print "$upto_permutation / $num_permutations est $eta_str (each $t_each)\n";
$t = time();
}
next if $i == $j;
my $to_path = $path_objects[$j];
next if $to_path->n_start != $n_start;
my $to_fullname = $path_fullnames{$to_path};
my $name = "$from_fullname -> $to_fullname";
print DEBUG "$name\n";
my $str = '';
my @values;
foreach my $n ($n_start+2 .. $n_start+50) {
my ($x,$y) = $from_path->n_to_xy($n)
or next PATH;
my $pn = $to_path->xy_to_n($x,$y) // next PATH;
$str .= "$pn,";
push @values, $pn;
}
Math::OEIS::Grep->search(name => $name,
array => \@values);
}
}
exit 0;
}
{
# cross-product of successive dx,dy, being turn discriminant
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
@choices = grep {$_ ne 'CellularRule'} @choices;
my $num_choices = scalar(@choices);
print "$num_choices choices\n";
my @path_objects;
my %path_fullnames;
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
Module::Load::load($class);
my $parameters = parameter_info_list_to_parameters
($class->parameter_info_list);
foreach my $p (@$parameters) {
my $path_object = $class->new (@$p);
push @path_objects, $path_object;
$path_fullnames{$path_object} = "$name ".join(',',@$p);
}
}
my $num_path_objects = scalar(@path_objects);
print "total path objects $num_path_objects\n";
my %seen;
foreach my $path (@path_objects) {
my $fullname = $path_fullnames{$path};
print "$fullname\n";
my $n = $path->n_start + 2;
my ($prev_dx,$prev_dy) = $path->n_to_dxdy($n)
or next;
my @values;
for ($n++; @values < 30; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n)
or last;
push @values, $dx * $prev_dy - $prev_dx * $dy;
}
print join(',', @values),"\n";
Math::OEIS::Grep->search(array => \@values,
try_abs => 0);
}
exit 0;
}
{
# boundary length by N, unit squares
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
@choices = grep {$_ ne 'CellularRule'} @choices;
@choices = grep {$_ ne 'ArchimedeanChords'} @choices;
@choices = grep {$_ ne 'TheodorusSpiral'} @choices;
@choices = grep {$_ ne 'MultipleRings'} @choices;
@choices = grep {$_ ne 'VogelFloret'} @choices;
@choices = grep {$_ ne 'UlamWarburtonAway'} @choices;
@choices = grep {$_ !~ /Hypot|ByCells|SumFractions|WythoffTriangle/} @choices;
@choices = grep {$_ ne 'PythagoreanTree'} @choices;
# @choices = grep {$_ ne 'PeanoHalf'} @choices;
@choices = grep {$_ !~ /EToothpick|LToothpick|Surround|Peninsula/} @choices;
#
# @choices = grep {$_ eq 'WythoffArray'} @choices;
# @choices = grep {$_ ne 'ZOrderCurve'} @choices;
# unshift @choices, 'CornerReplicate', 'ZOrderCurve';
my $num_choices = scalar(@choices);
print "$num_choices choices\n";
@choices = ((grep {/Corner|Tri/} @choices),
(grep {!/Corner|Tri/} @choices));
my @path_objects;
my %path_fullnames;
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
### $class
Module::Load::load($class);
my $parameters = parameter_info_list_to_parameters
($class->parameter_info_list);
foreach my $p (@$parameters) {
my $path_object = $class->new (@$p);
push @path_objects, $path_object;
$path_fullnames{$path_object} = "$name ".join(',',@$p);
}
}
my $num_path_objects = scalar(@path_objects);
print "total path objects $num_path_objects\n";
my $start_t = time();
my $t = $start_t-8;
my $i = 0;
# until ($path_objects[$i]->isa('Math::PlanePath::DragonCurve')) {
# $i++;
# }
my $start_permutations = $i * ($num_path_objects-1);
my $num_permutations = $num_path_objects * ($num_path_objects-1);
for ( ; $i <= $#path_objects; $i++) {
my $path = $path_objects[$i];
my $fullname = $path_fullnames{$path};
print "$fullname\n";
my $x_minimum = $path->x_minimum;
my $y_minimum = $path->y_minimum;
my @values;
my $boundary = 0;
foreach my $n ($path->n_start .. 30) {
$boundary += path_n_to_dboundary($path,$n);
# $boundary += path_n_to_dsticks($path,$n);
# $boundary += path_n_to_dhexboundary($path,$n);
# $boundary += path_n_to_dhexsticks($path,$n);
my $value = $boundary;
push @values, $value;
}
shift @values;
print join(',',@values),"\n";
Math::OEIS::Grep->search(array => \@values);
print "\n";
}
exit 0;
}
{
# boundary of unit squares by powers
require Math::NumSeq::PlanePathCoord;
foreach my $elem (
# ['WythoffArray', 'zeck'],
['ComplexPlus', 1*1+1],
['ComplexPlus,realpart=2', 2*2+1],
['ComplexPlus,realpart=3', 3*3+1],
['ComplexMinus', 1*1+1],
['ComplexMinus,realpart=2', 2*2+1],
['ComplexMinus,realpart=3', 3*3+1],
['CCurve', 2],
['GosperReplicate',7, 'triangular'],
['Flowsnake',7, 'triangular'],
['FlowsnakeCentres',7, 'triangular'],
['PowerArray',2],
['PowerArray,radix=3',3],
['CubicBase',2, 'triangular'],
['CubicBase,radix=3',3, 'triangular'],
['TerdragonCurve', 3, 'triangular'],
['TerdragonMidpoint', 3, 'triangular'],
['QuintetCentres',5],
['QuintetCurve',5],
['AlternatePaperMidpoint', 2],
['R5DragonCurve', 5],
['DragonMidpoint', 2],
['AlternatePaper', 2],
['DragonCurve', 2],
) {
my ($name, $radix, $lattice_type) = @$elem;
$lattice_type ||= 'square';
print "$name (lattice=$lattice_type)\n";
my $path = Math::NumSeq::PlanePathCoord::_planepath_name_to_object($name);
my $n_start = $path->n_start;
my @boundaries;
my $n = $n_start;
my $boundary = 0;
my $target = $radix;
my $dboundary_func = ($lattice_type eq 'triangular'
? \&path_n_to_dhexboundary
: \&path_n_to_dboundary);
for (;; $n++) {
### at: "boundary=$boundary now consider N=$n"
last if @boundaries > 20;
if ($n > $target) {
print "$target $boundary\n";
push @boundaries, $boundary;
$target *= $radix;
last if $target > 10_000;
}
$boundary += $dboundary_func->($path,$n);
}
print "$name unit squares boundary\n";
shift_off_zeros(\@boundaries);
print join(',',@boundaries),"\n";
Math::OEIS::Grep->search(array => \@boundaries);
print "\n";
}
exit 0;
}
{
# permutation of transpose
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
@choices = grep {$_ ne 'BinaryTerms'} @choices; # bit slow yet
my %seen;
foreach my $path_name (@choices) {
my $path_class = "Math::PlanePath::$path_name";
Module::Load::load($path_class);
my $parameters = parameter_info_list_to_parameters($path_class->parameter_info_list);
PATH: foreach my $p (@$parameters) {
my $name = "$path_name ".join(',',@$p);
my $path = $path_class->new (@$p);
my @values;
foreach my $n ($path->n_start+1 .. 35) {
# my $value = (defined $path->tree_n_to_subheight($n) ? 1 : 0);
my ($x,$y) = $path->n_to_xy($n) or next PATH;
# # my $value = $path->xy_to_n($y,$x); # transpose
# my $value = $path->xy_to_n(-$x,$y); # horiz mirror
# my $value = $path->xy_to_n($x,-$y); # vert mirror
# ($x,$y) = ($y,-$x); # rotate -90
# ($x,$y) = ($y,$x); # transpose
# ($x,$y) = (-$y,$x); # rotate +90
my $value = $path->xy_to_n(-$y,-$x); # mirror across opp diagonal
next PATH if ! defined $value;
push @values, $value;
}
Math::OEIS::Grep->search(name => $name,
array => \@values);
}
}
exit 0;
}
{
# tree row totals
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
@choices = grep {$_ ne 'CellularRule'} @choices;
@choices = grep {$_ ne 'UlamWarburtonAway'} @choices; # not working yet
@choices = grep {$_ !~ /EToothpick|LToothpick|Surround|Peninsula/} @choices;
my $num_choices = scalar(@choices);
print "$num_choices choices\n";
my @path_objects;
my %path_fullnames;
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
### $class
Module::Load::load($class);
my $parameters = parameter_info_list_to_parameters
($class->parameter_info_list);
foreach my $p (@$parameters) {
my $path_object = $class->new (@$p);
push @path_objects, $path_object;
$path_fullnames{$path_object} = "$name ".join(',',@$p);
}
}
my $num_path_objects = scalar(@path_objects);
print "total path objects $num_path_objects\n";
my $start_t = time();
my $t = $start_t-8;
my $i = 0;
# until ($path_objects[$i]->isa('Math::PlanePath::DragonCurve')) {
# $i++;
# }
for ( ; $i <= $#path_objects; $i++) {
my $path = $path_objects[$i];
next unless $path->x_negative || $path->y_negative;
$path->is_tree($path) or next;
my $fullname = $path_fullnames{$path};
print "$fullname (",ref $path,")\n";
my @x_total;
my @y_total;
my @sum_total;
my @diff_total;
my $target_depth = 0;
my $target = $path->tree_depth_to_n_end($target_depth);
for (my $n = $path->n_start; $n < 10_000; $n++) {
my ($x,$y) = $path->n_to_xy($n);
my $depth = $path->tree_n_to_depth($n);
$x = abs($x);
$y = abs($y);
$x_total[$depth] += $x;
$y_total[$depth] += $y;
$sum_total[$depth] += $x + $y;
$diff_total[$depth] += $x - $y;
if ($n == $target) {
print "$target_depth $x_total[$target_depth] $y_total[$target_depth]\n";
$target_depth++;
last if $target_depth > 12;
$target = $path->tree_depth_to_n_end($target_depth);
}
}
$#x_total = $target_depth-1;
$#y_total = $target_depth-1;
$#sum_total = $target_depth-1;
$#diff_total = $target_depth-1;
print "X rows\n";
Math::OEIS::Grep->search(array => \@x_total);
print "\n";
print "Y rows\n";
Math::OEIS::Grep->search(array => \@y_total);
print "\n";
print "X+Y rows\n";
Math::OEIS::Grep->search(array => \@sum_total);
print "\n";
print "X-Y rows\n";
Math::OEIS::Grep->search(array => \@diff_total);
print "\n";
}
exit 0;
}
BEGIN {
my @dir6_to_dx = (2, 1,-1,-2, -1, 1);
my @dir6_to_dy = (0, 1, 1, 0, -1,-1);
# Return the change in boundary length when hexagon $n is added.
# This is +6 if it's completely isolated, and 2 less for each neighbour
# < $n since 1 side of the neighbour and 1 side of $n are then not
# boundaries.
#
sub path_n_to_dhexboundary {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy($n) or return 0;
my $dboundary = 6;
foreach my $i (0 .. $#dir6_to_dx) {
my $an = $path->xy_to_n($x+$dir6_to_dx[$i], $y+$dir6_to_dy[$i]);
$dboundary -= 2*(defined $an && $an < $n);
}
### $dboundary
return $dboundary;
}
sub path_n_to_dhexsticks {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy($n) or return 0;
my $dboundary = 6;
foreach my $i (0 .. $#dir6_to_dx) {
my $an = $path->xy_to_n($x+$dir6_to_dx[$i], $y+$dir6_to_dy[$i]);
$dboundary -= (defined $an && $an < $n);
}
return $dboundary;
}
}
{
# path classes with or without n_start
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
my (@with, @without);
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
Module::Load::load($class);
my $href = $class->parameter_info_hash;
if ($href->{'n_start'}) {
push @with, $class;
} else {
push @without, $class;
}
}
foreach my $aref (\@without, \@with) {
foreach my $class (@$aref) {
my @pnames = map {$_->{'name'}} $class->parameter_info_list;
my $href = $class->parameter_info_hash;
my $w = ($href->{'n_start'} ? 'with' : 'without');
print " $class [$w] ",join(',',@pnames),"\n";
# print " ",join(', ',keys %$href),"\n";
}
print "\n\n";
}
exit 0;
}
{
require Math::PlanePath::DragonCurve;
my $path = Math::PlanePath::DragonCurve->new;
my @values;
foreach my $n (3 .. 32) {
my ($x,$y) = $path->n_to_xy(2*$n);
# push @values,-$x-1;
my $transitions = transitions($n);
push @values, (($transitions%4)/2);
# push @values, $transitions;
}
my $values = join(',',@values);
print "$values\n";
Math::OEIS::Grep->search(array=>\@values);
exit 0;
# transitions(2n)/2 = A069010 Number of runs of 1's
sub transitions {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += (($n & 3) == 1 || ($n & 3) == 2);
$n >>= 1;
}
return $count
}
}
{
# tree row increments
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
# @choices = grep {$_ ne 'CellularRule'} @choices;
# @choices = grep {$_ ne 'Rows'} @choices;
# @choices = grep {$_ ne 'Columns'} @choices;
# @choices = grep {$_ ne 'ArchimedeanChords'} @choices;
@choices = grep {$_ ne 'MultipleRings'} @choices;
@choices = grep {$_ ne 'VogelFloret'} @choices;
@choices = grep {$_ !~ /ByCells/} @choices;
# @choices = grep {$_ ne 'PythagoreanTree'} @choices;
# @choices = grep {$_ ne 'PeanoHalf'} @choices;
# @choices = grep {$_ !~ /EToothpick|LToothpick|Surround|Peninsula/} @choices;
#
# @choices = grep {$_ ne 'CornerReplicate'} @choices;
# @choices = grep {$_ ne 'ZOrderCurve'} @choices;
# unshift @choices, 'CornerReplicate', 'ZOrderCurve';
my $num_choices = scalar(@choices);
print "$num_choices choices\n";
my @path_objects;
my %path_fullnames;
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
### $class
Module::Load::load($class);
my $parameters = parameter_info_list_to_parameters
($class->parameter_info_list);
foreach my $p (@$parameters) {
my $path_object = $class->new (@$p);
push @path_objects, $path_object;
$path_fullnames{$path_object} = "$name ".join(',',@$p);
}
}
my $num_path_objects = scalar(@path_objects);
print "total path objects $num_path_objects\n";
my $start_t = time();
my $t = $start_t-8;
my $i = 0;
# until ($path_objects[$i]->isa('Math::PlanePath::DiamondArms')) {
# $i++;
# }
my $start_permutations = $i * ($num_path_objects-1);
my $num_permutations = $num_path_objects * ($num_path_objects-1);
for ( ; $i <= $#path_objects; $i++) {
my $path = $path_objects[$i];
my $fullname = $path_fullnames{$path};
my $n_start = $path->n_start;
$path->is_tree($path) or next;
print "$fullname\n";
# if (time()-$t < 0 || time()-$t > 10) {
# my $upto_permutation = $i*$num_path_objects + $j || 1;
# my $rem_permutation = $num_permutations
# - ($start_permutations + $upto_permutation);
# my $done_permutations = ($upto_permutation-$start_permutations);
# my $percent = 100 * $done_permutations / $num_permutations || 1;
# my $t_each = (time() - $start_t) / $done_permutations;
# my $done_per_second = $done_permutations / (time() - $start_t);
# my $eta = int($t_each * $rem_permutation);
# my $s = $eta % 60; $eta = int($eta/60);
# my $m = $eta % 60; $eta = int($eta/60);
# my $h = $eta;
# print "$upto_permutation / $num_permutations est $h:$m:$s (each $t_each)\n";
# $t = time();
# }
my $str = '';
my @values;
foreach my $depth (1 .. 50) {
# my $value = $path->tree_depth_to_width($depth) // next;
my $value = $path->tree_depth_to_n($depth) % 2;
$str .= "$value,";
push @values, $value;
}
if (defined (my $diff = constant_diff(@values))) {
print "$fullname\n";
print " constant diff $diff\n";
next;
}
if (my $found = stripped_grep($str)) {
print "$fullname match\n";
print " (",substr($str,0,60),"...)\n";
print $found;
print "\n";
}
}
exit 0;
}
{
# X,Y extents
require Math::NumSeq::PlanePathCoord;
my @choices = @{Math::NumSeq::PlanePathCoord->parameter_info_hash
->{'planepath'}->{'choices'}};
my $num_choices = scalar(@choices);
print "$num_choices choices\n";
my @path_objects;
my %path_fullnames;
foreach my $name (@choices) {
my $class = "Math::PlanePath::$name";
Module::Load::load($class);
my $parameters = parameter_info_list_to_parameters
($class->parameter_info_list);
foreach my $p (@$parameters) {
my $path_object = $class->new (@$p);
push @path_objects, $path_object;
$path_fullnames{$path_object} = "$name ".join(',',@$p);
}
}
my $num_path_objects = scalar(@path_objects);
print "total path objects $num_path_objects\n";
my %seen;
foreach my $path (@path_objects) {
print $path_fullnames{$path},"\n";
my $any_x_neg = 0;
my $any_y_neg = 0;
my (@x,@y,@n);
foreach my $n ($path->n_start+2 .. 50) {
my ($x,$y) = $path->n_to_xy($n)
or last;
push @x, $x;
push @y, $y;
push @n, $n;
$any_x_neg ||= ($x < 0);
$any_y_neg ||= ($y < 0);
}
next unless $any_x_neg || $any_y_neg;
foreach my $x_axis_pos ($any_y_neg ? -1 : (),
0, 1) {
foreach my $x_axis_neg (($any_y_neg ? (-1) : ()),
0,
($any_x_neg ? (1) : ())) {
foreach my $y_axis_pos ($any_x_neg ? -1 : (),
0, 1) {
foreach my $y_axis_neg ($any_x_neg ? (-1) : (),
0,
($any_y_neg ? (1) : ())) {
my $fullname = $path_fullnames{$path} . " Xpos=$x_axis_pos Xneg=$x_axis_neg Ypos=$y_axis_pos Yneg=$y_axis_neg";
my @values;
my $str = '';
foreach my $i (0 .. $#x) {
if (($x[$i]<=>0) == ($y[$i]<0 ? $y_axis_neg : $y_axis_pos)
&& ($y[$i]<=>0) == ($x[$i]<0 ? $x_axis_neg : $x_axis_pos)
) {
push @values, $n[$i];
$str .= "$n[$i],";
}
}
next unless @values >= 5;
if (my $prev_fullname = $seen{$str}) {
print "$fullname\n";
print "repeat of $prev_fullname";
print "\n";
} else {
if (my $found = stripped_grep($str)) {
print "$fullname\n";
print " (",substr($str,0,20),"...)\n";
print $found;
print "\n";
print "\n";
$seen{$str} = $fullname;
}
}
}
}
}
}
}
exit 0;
}
# sub stripped_grep {
# my ($str) = @_;
# my $find = `fgrep -e $str $ENV{HOME}/OEIS/stripped`;
# my $ret = '';
# foreach my $line (split /\n/, $find) {
# $ret .= "$line\n";
# my ($anum) = ($line =~ /^(A\d+)/) or die;
# $ret .= `zgrep -e ^$anum $ENV{HOME}/OEIS/names.gz`;
# }
# return $ret;
# }
my $stripped;
sub stripped_grep {
my ($str) = @_;
if (! $stripped) {
require File::Map;
my $filename = "$ENV{HOME}/OEIS/stripped";
File::Map::map_file ($stripped, $filename);
print "File::Map file length ",length($stripped),"\n";
}
my $ret = '';
my $pos = 0;
for (;;) {
$pos = index($stripped,$str,$pos);
last if $pos < 0;
my $start = rindex($stripped,"\n",$pos) + 1;
my $end = index($stripped,"\n",$pos);
my $line = substr($stripped,$start,$end-$start);
$ret .= "$line\n";
my ($anum) = ($line =~ /^(A\d+)/);
$anum || die "$anum not found";
$ret .= `zgrep -e ^$anum $ENV{HOME}/OEIS/names.gz`;
$pos = $end;
}
return $ret;
}
#------------------------------------------------------------------------------
# ($inforef, $inforef, ...)
sub parameter_info_list_to_parameters {
my @parameters = ([]);
foreach my $info (@_) {
next if $info->{'name'} eq 'n_start';
info_extend_parameters($info,\@parameters);
}
return \@parameters;
}
sub info_extend_parameters {
my ($info, $parameters) = @_;
my @new_parameters;
if ($info->{'name'} eq 'planepath') {
my @strings;
foreach my $choice (@{$info->{'choices'}}) {
# next unless $choice =~ /DiamondSpiral/;
# next unless $choice =~ /Gcd/;
# next unless $choice =~ /LCorn|RationalsTree/;
next unless $choice =~ /dragon/i;
# next unless $choice =~ /SierpinskiArrowheadC/;
# next unless $choice eq 'DiagonalsAlternating';
my $path_class = "Math::PlanePath::$choice";
Module::Load::load($path_class);
my @parameter_info_list = $path_class->parameter_info_list;
{
my $path = $path_class->new;
if (defined $path->{'n_start'}
&& ! $path_class->parameter_info_hash->{'n_start'}) {
push @parameter_info_list,{ name => 'n_start',
type => 'enum',
choices => [0,1],
default => $path->default_n_start,
};
}
}
if ($path_class->isa('Math::PlanePath::Rows')) {
push @parameter_info_list,{ name => 'width',
type => 'integer',
width => 3,
default => '1',
minimum => 1,
};
}
if ($path_class->isa('Math::PlanePath::Columns')) {
push @parameter_info_list, { name => 'height',
type => 'integer',
width => 3,
default => '1',
minimum => 1,
};
}
my $path_parameters
= parameter_info_list_to_parameters(@parameter_info_list);
### $path_parameters
foreach my $aref (@$path_parameters) {
my $str = $choice;
while (@$aref) {
$str .= "," . shift(@$aref) . '=' . shift(@$aref);
}
push @strings, $str;
}
}
### @strings
foreach my $p (@$parameters) {
foreach my $choice (@strings) {
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
@$parameters = @new_parameters;
return;
}
if ($info->{'choices'}) {
my @new_parameters;
foreach my $p (@$parameters) {
foreach my $choice (@{$info->{'choices'}}) {
next if ($info->{'name'} eq 'serpentine_type' && $choice eq 'Peano');
next if ($info->{'name'} eq 'rotation_type' && $choice eq 'custom');
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
if ($info->{'name'} eq 'serpentine_type') {
push @new_parameters, [ @$p, $info->{'name'}, '100_000_000' ];
push @new_parameters, [ @$p, $info->{'name'}, '101_010_101' ];
push @new_parameters, [ @$p, $info->{'name'}, '000_111_000' ];
push @new_parameters, [ @$p, $info->{'name'}, '111_000_111' ];
}
}
@$parameters = @new_parameters;
return;
}
if ($info->{'type'} eq 'boolean') {
my @new_parameters;
foreach my $p (@$parameters) {
foreach my $choice (0, 1) {
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
@$parameters = @new_parameters;
return;
}
if ($info->{'type'} eq 'integer'
|| $info->{'name'} eq 'multiples') {
my @choices;
if ($info->{'name'} eq 'radix') { @choices = (2,3,10,16); }
if ($info->{'name'} eq 'n_start') { @choices = (0,1); }
if ($info->{'name'} eq 'x_start'
|| $info->{'name'} eq 'y_start') { @choices = ($info->{'default'}); }
if (! @choices) {
my $min = $info->{'minimum'} // -5;
my $max = $min + 10;
if (# $module =~ 'PrimeIndexPrimes' &&
$info->{'name'} eq 'level') { $max = 5; }
# if ($info->{'name'} eq 'arms') { $max = 2; }
if ($info->{'name'} eq 'rule') { $max = 255; }
if ($info->{'name'} eq 'round_count') { $max = 20; }
if ($info->{'name'} eq 'straight_spacing') { $max = 1; }
if ($info->{'name'} eq 'diagonal_spacing') { $max = 1; }
if ($info->{'name'} eq 'radix') { $max = 17; }
if ($info->{'name'} eq 'realpart') { $max = 3; }
if ($info->{'name'} eq 'wider') { $max = 1; }
if ($info->{'name'} eq 'modulus') { $max = 32; }
if ($info->{'name'} eq 'polygonal') { $max = 32; }
if ($info->{'name'} eq 'factor_count') { $max = 12; }
if ($info->{'name'} eq 'diagonal_length') { $max = 5; }
if ($info->{'name'} eq 'height') { $max = 4; }
if ($info->{'name'} eq 'width') { $max = 4; }
if ($info->{'name'} eq 'k') { $max = 4; }
if (defined $info->{'maximum'} && $max > $info->{'maximum'}) {
$max = $info->{'maximum'};
}
if ($info->{'name'} eq 'power' && $max > 6) { $max = 6; }
@choices = ($min .. $max);
}
my @new_parameters;
foreach my $choice (@choices) {
foreach my $p (@$parameters) {
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
@$parameters = @new_parameters;
return;
}
if ($info->{'name'} eq 'fraction') {
### fraction ...
my @new_parameters;
foreach my $p (@$parameters) {
my $radix = p_radix($p) || die;
foreach my $den (995 .. 1021) {
next if $den % $radix == 0;
my $choice = "1/$den";
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
foreach my $num (2 .. 10) {
foreach my $den ($num+1 .. 15) {
next if $den % $radix == 0;
next unless _coprime($num,$den);
my $choice = "$num/$den";
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
}
@$parameters = @new_parameters;
return;
}
print " skip parameter $info->{'name'}\n";
}
# return true if coprime
sub _coprime {
my ($x, $y) = @_;
### _coprime(): "$x,$y"
if ($y > $x) {
($x,$y) = ($y,$x);
}
for (;;) {
if ($y <= 1) {
### result: ($y == 1)
return ($y == 1);
}
($x,$y) = ($y, $x % $y);
}
}
sub p_radix {
my ($p) = @_;
for (my $i = 0; $i < @$p; $i += 2) {
if ($p->[$i] eq 'radix') {
return $p->[$i+1];
}
}
return undef;
}
sub float_error {
my ($x) = @_;
if (abs($x - int($x)) < 0.000001) {
return int($x);
} else {
return $x;
}
}
__END__
Math-PlanePath-122/devel/cfrac-digits.pl 0000644 0001750 0001750 00000014004 12155466372 015704 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use POSIX 'floor';
use List::Util 'min', 'max';
use Math::PlanePath::CfracDigits;
use Math::PlanePath::Base::Digits
'round_down_pow';
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::KochCurve;
*_digit_join_hightolow = \&Math::PlanePath::KochCurve::_digit_join_hightolow;
# 121313322
{
require Math::PlanePath::CfracDigits;
my $path = Math::PlanePath::CfracDigits->new;
foreach my $n (0 .. 120) {
my ($x,$y) = $path->n_to_xy($n);
print "$x,";
}
print "\n";
print "\n";
foreach my $n (0 .. 120) {
my ($x,$y) = $path->n_to_xy($n);
print "$y,";
}
print "\n";
print "\n";
foreach my $n (0 .. 120) {
my ($x,$y) = $path->n_to_xy($n);
print "$x/$y, ";
}
print "\n";
print "\n";
exit 0;
}
{
require Math::PlanePath::CfracDigits;
require Number::Fraction;
my $path = Math::PlanePath::CfracDigits->new (radix => 1);
my $rat = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my $nf = Number::Fraction->new(1,7);
$nf = 1 / (4 + 1 / (2 + Number::Fraction->new(1,7)));
print "$nf\n";
my $x = $nf->{num};
my $y = $nf->{den};
my $n = $path->xy_to_n($x,$y);
printf "%5d %17b\n", $n, $n;
$n = $rat->xy_to_n($y-$x,$x);
printf "%5d %17b\n", $n, $n;
exit 0;
}
{
# +1 at low end to turn 1111 into 10000
require Math::PlanePath::CfracDigits;
my $rat = Math::PlanePath::RationalsTree->new (tree_type => 'HCS');
my $cf = Math::PlanePath::CfracDigits->new (radix => 1);
for (my $n = $rat->n_start; $n < 200; $n++) {
my ($cx,$cy) = $cf->n_to_xy($n);
# my ($rx,$ry) = $rat->n_to_xy($n);
my $rn = $rat->xy_to_n($cy,$cx);
printf "%d,%d %b %b\n",
$cx,$cy, $n, $rn-1;
}
exit 0;
}
{
# Fibonacci F[k]/F[k+1]
require Math::NumSeq::Fibonacci;
my $seq = Math::NumSeq::Fibonacci->new;
my $radix = 3;
my $path = Math::PlanePath::CfracDigits->new (radix => $radix);
for (my $i = 1; $i < 20; $i++) {
my $x = $seq->ith($i);
my $y = $seq->ith($i+1);
my $log = Math::PlanePath::CfracDigits::_log_phi_estimate($y);
my $n = $path->xy_to_n($x,$y);
# {
# my @digits = ($radix+1) x ($i-2);
# my $carry = 0;
# foreach my $digit (@digits) { # low to high
# if ($carry = (($digit += $carry) >= $radix)) { # modify array contents
# $digit -= $radix;
# }
# }
# if ($carry) {
# push @digits, 1;
# }
# print join(',',@digits),"\n";
# }
my @digits = ($radix+1) x ($i-2);
my $d = Math::PlanePath::CfracDigits::_digit_join_1toR_destructive(\@digits,$radix+1,0);
my $pow = ($radix+1)**$i;
my ($nlo,$nhi) = $path->rect_to_n_range(0,0, $x,$y);
print "$n $log $nhi $d $pow\n";
}
exit 0;
}
{
# range vs GcdRationals
my $radix = 2;
require Math::PlanePath::CfracDigits;
require Math::PlanePath::GcdRationals;
my $cf = Math::PlanePath::CfracDigits->new (radix => $radix);
my $gc = Math::PlanePath::GcdRationals->new;
foreach my $y (2 .. 1000) {
my ($cf_nlo,$cf_nhi) = $cf->rect_to_n_range(0,0, 1,$y);
my ($gc_nlo,$gc_nhi) = $gc->rect_to_n_range(0,0, $y,$y);
my $flag = '';
if ($cf_nhi > $gc_nhi) {
$flag = "*****";
}
print "$y $cf_nhi $gc_nhi$flag\n";
}
exit 0;
}
{
# maximum N
require Math::PlanePath::CfracDigits;
my $radix = 6;
my $path = Math::PlanePath::CfracDigits->new (radix => $radix);
foreach my $y (2 .. 1000) {
my $nmax = -1;
my $xmax;
foreach my $x (1 .. $y-1) {
my $n = $path->xy_to_n($x,$y) // next;
my $len = $n; # length_1toR($n);
if ($len > $nmax) {
$nmax = $len;
$xmax = $x;
# print " $xmax $nmax ",groups_string($n),"\n";
}
}
my ($nlo,$nhi) = $path->rect_to_n_range(0,0,1,$y);
my $groups = groups_string($nmax);
my $ysquared = ($radix+1) ** (_fib_log($y) - 1.5);
# my $ysquared = ($radix+1) ** (log2($y)*2);
# my $ysquared = int($y ** (5/2));
my $yfactor = sprintf '%.2f', $ysquared / ($nmax||1);
my $flag = '';
if ($ysquared < $nmax) {
$flag = "*****";
}
print "$y x=$xmax n=$nmax $ysquared$flag $yfactor $groups\n";
my $log = Math::PlanePath::CfracDigits::_log_phi_estimate($y);
$flag = '';
if ($nhi < $nmax) {
$flag = "*****";
}
print " nhi=$nhi$flag log=$log\n";
}
exit 0;
sub groups_string {
my ($n) = @_;
my @groups = Math::PlanePath::CfracDigits::_n_to_quotients($n,$radix);
return join(',',reverse @groups);
}
sub length_1toR {
my ($n) = @_;
my @digits = Math::PlanePath::CfracDigits::_digit_split_1toR_lowtohigh($n,$radix);
return scalar(@digits);
}
sub log2 {
my ($x) = @_;
return int(log($x)/log(2));
}
sub _fib_log {
my ($x) = @_;
### _fib_log(): $x
my $f0 = ($x * 0);
my $f1 = $f0 + 1;
my $count = 0;
while ($x > $f0) {
$count++;
($f0,$f1) = ($f1,$f0+$f1);
}
return $count;
}
}
{
# minimum N in each row is at X=1
require Math::PlanePath::CfracDigits;
my $path = Math::PlanePath::CfracDigits->new;
foreach my $y (2 .. 1000) {
my $nmin = 1e308;
my $xmin;
foreach my $x (1 .. $y-1) {
my $n = $path->xy_to_n($x,$y) // next;
if ($n < $nmin) {
$nmin = $n;
$xmin = $x;
}
}
print "$y $xmin $nmin\n";
}
exit 0;
}
Math-PlanePath-122/devel/pythagorean.pl 0000644 0001750 0001750 00000060147 12252501660 015663 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use List::Util 'min', 'max';
use Math::Libm 'hypot';
use Math::PlanePath::PythagoreanTree;
use Math::PlanePath::Base::Digits
'round_down_pow',
'digit_join_lowtohigh',
'digit_split_lowtohigh';
# uncomment this to run the ### lines
# use Smart::Comments;
{
# powers
foreach my $k (0 .. 41) {
print 3**$k,"\n";
}
exit 0;
}
{
# repeated "U" or "M1" on initial P=2,Q=1
require Math::BaseCnv;
my $path = Math::PlanePath::PythagoreanTree->new
(
# tree_type => 'UAD',
tree_type => 'FB',
coordinates => 'PQ',
);
foreach my $depth (0 .. 5) {
my $n = $path->tree_depth_to_n($depth);
my ($x,$y) = $path->n_to_xy($n);
print "depth=$depth N=$n P=$x / Q=$y\n";
}
exit 0;
}
{
# X,Y list
# PQ UAD
# N=1 2 / 1
#
# N=2 3 / 2 5,12
# N=3 5 / 2 21,20
# N=4 4 / 1 15,8
#
# N=5 4 / 3
# N=6 8 / 3
# N=7 7 / 2
# N=8 8 / 5
# N=9 12 / 5
# N=10 9 / 2
# N=11 7 / 4
# N=12 9 / 4
# N=13 6 / 1
# PQ FB
# N=1 2,1
#
# N=2 3,2
# N=3 4,1
# N=4 4,3
#
# N=5 5,4
# N=6 6,1
# N=7 6,5
# N=8 5,2
# N=9 8,3
# N=10 8,5
# N=11 7,6
# N=12 8,1
# N=13 8,7
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new
(
# tree_type => 'UMT',
tree_type => 'UAD',
# tree_type => 'FB',
coordinates => 'AB',
# coordinates => 'PQ', # P>Q one odd other even
);
my $n = $path->n_start;
foreach my $level (0 .. 5) {
foreach (1 .. 3**$level) {
my ($x,$y) = $path->n_to_xy($n);
# $x -= $y;
my $flag = '';
if ($x <= $y) {
$flag = ' ***';
}
print "N=$n $x,$y$flag\n";
$n++;
}
print "\n";
}
exit 0;
}
{
# TMU parent/child
foreach my $n (1 .. 40) {
if (n_is_row_start($n)) { print "\n"; }
my $n_str = n_to_pythagstr($n);
my ($p,$q) = tmu_n_to_pq($n);
my @pq_children = tmu_pq_children($p,$q);
my ($p1,$q1,$p2,$q2,$p3,$q3) = @pq_children;
print "$n = $n_str $p,$q children $p1,$q1 $p2,$q2 $p3,$q3\n";
while (@pq_children) {
my $child_p = shift @pq_children;
my $child_q = shift @pq_children;
my ($parent_p,$parent_q) = tmu_pq_parent($child_p,$child_q);
if ($parent_p != $p || $parent_q != $q) {
print "oops\n";
}
}
}
exit 0;
sub tmu_pq_children {
my ($p,$q) = @_;
return ($p+3*$q, 2*$q, # T
2*$p, $p-$q, # M2 (2p, p-q)
2*$p-$q, $p); # "U" = (2p-q, p)
}
sub tmu_pq_parent {
my ($p,$q) = @_;
if ($p > 2*$q) {
if ($p % 2) {
# T 1 3 p -> p+3q p > 2q, p odd, q even
# 0 2 q -> 2q det=2
# inverse 1 -3/2
# 0 1/2
$q /= 2;
$p -= 3*$q;
} else {
# M2 2 0 p -> 2p p > 2q, p even, q odd
# 1 -1 q -> p-q det=-2
# inverse -1 0 / -2 = 1/2 0
# -1 2 1/2 -1
$p /= 2;
$q = $p - $q;
}
} else {
# U 2 -1 p -> 2p-q 2q > p > q small p
# 1 0 q -> p det=1
# inverse 0 1 = 0 -1
# -1 2 1 -2
($p,$q) = ($q, 2*$q-$p);
}
return ($p,$q);
}
}
{
# 1^2 = 1 3^2 = 9 = 1 mod 4
# A^2 + B^2 = C^2
# 1 0 1
# 0 1 1
# A = 1 mod 4, B = 0 mod 4
# even 3mod4, any 1mod4
exit 0;
}
{
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'UMT',
coordinates => 'PQ');
$path->xy_to_n(4,5);
exit 0;
}
{
# UAD to TMU
my $uad = Math::PlanePath::PythagoreanTree->new (tree_type => 'UAD',
coordinates => 'PQ');
foreach my $n (1 .. 40) {
if (n_is_row_start($n)) { print "\n"; }
my ($p,$q) = $uad->n_to_xy($n);
my $umt_n = umt_pq_to_n($p,$q);
my $umt_n_str = n_to_pythagstr($umt_n);
my $n_str = n_to_pythagstr($n);
print "$n = $n_str $p,$q UMT=$n $umt_n_str\n";
}
exit 0;
sub umt_pq_to_n {
my ($p,$q) = @_;
my @ndigits;
while ($p > 2) {
if ($p > 2*$q) {
if ($p % 2) {
$q /= 2; # T
$p -= 3*$q;
push @ndigits, 1;
} else {
$p /= 2; # M2
$q = $p - $q;
push @ndigits, 2;
}
} else {
($p,$q) = ($q, 2*$q-$p); # U
push @ndigits, 0;
}
}
my $zero = $p*0*$q;
return ((3+$zero)**scalar(@ndigits) + 1)/2 # tree_depth_to_n()
+ digit_join_lowtohigh(\@ndigits,3,$zero); # digits within this depth
}
}
{
# U = 2,-1,1,0
# A = 2,1, 1,0
# D = 1,2, 0,1
# M1 = 1,1, 0,2
# M2 = 2,0, 1,-1
# M3 = 2,0, 1,1
# p+2q = unchanged
# p+q = odd
# 2p or 2q = even
# 2a+b>2c+d
# ap+b>cp+d
#
# ap+b(p-1) > cp+d(p-1)
# (c-1)p+b(p-1) > cp+d(p-1)
# cp-p+b(p-1) > cp+d(p-1)
# -p+b(p-1) > d(p-1)
# b(p-1) > d(p-1)+p
# b > d+p/(p-1)
# b > d+1
# D A U
# 1,2,0,1 2,-1,1,0 2,1,1,0
#
# U 2 -1 p -> 2p-q 2q > p > q small p
# 1 0 q -> p det=1
#
# A 2 1 p -> 2p+q 3q > p > 2q mid p
# 1 0 q -> p det=-1
#
# D 1 2 p -> p+2q p > 3q big p
# 0 1 q -> q det=1
# M1 M2 M3
# 1,1,0,2 2,0,1,-1 2,0,1,1
#
# M1 1 1 p -> p+q p > 2q, p odd, q even
# 0 2 q -> 2q det=2
#
# M2 2 0 p -> 2p p > 2q, p even, q odd
# 1 -1 q -> p-q det=-2
#
# M3 2 0 p -> 2p 2q > p, small p, p even, q odd
# 1 1 q -> p+q det=2
# U M2
# 1,3,0,2 2,-1,1,0 2,0,1,-1
#
#
# T 1 3 p -> p+3q p > 2q, p odd, q even
# 0 2 q -> 2q det=2
#
# M2 2 0 p -> 2p p > 2q, p even, q odd
# 1 -1 q -> p-q det=-2
#
# U 2 1 p -> 2p-q 2q > p > q small p
# 1 0 q -> p det=-1
my $uad = Math::PlanePath::PythagoreanTree->new (tree_type => 'UAD',
coordinates => 'PQ');
my $fb = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB',
coordinates => 'PQ');
my $len = 0;
foreach my $n (1 .. 40) {
if (n_is_row_start($n)) { print "\n"; }
my ($p,$q) = tmu_n_to_pq($n);
my $uad_n = n_to_pythagstr($uad->xy_to_n($p,$q));
my $fb_n = n_to_pythagstr($fb->xy_to_n($p,$q));
my $n_str = n_to_pythagstr($n);
print "$n = $n_str $p,$q UAD N=$uad_n FB N=$fb_n\n";
}
exit 0;
sub n_is_row_start {
my ($n) = @_;
my ($pow, $exp) = round_down_pow (2*$n-1, 3);
return ($n == ($pow+1)/2);
}
sub tmu_n_to_pq {
my ($n) = @_;
my $p = 2;
my $q = 1;
foreach my $digit (n_to_pythag_digits_lowtohigh($n)) {
if ($digit == 0) {
$p += 3*$q; # T
$q *= 2;
} elsif ($digit == 1) {
$q = $p-$q; # (2p, p-q) M2
$p *= 2;
} else {
($p,$q) = (2*$p-$q, $p); # "U" = (2p-q, p)
}
}
return ($p,$q);
}
sub n_to_pythagstr {
my ($n) = @_;
if (! defined $n) { return '[undef]' }
if ($n < 1) { return "($n)"; }
my @digits = n_to_pythag_digits_lowtohigh($n);
return '1.'.join('',reverse @digits);
}
# ($pow+1)/2 = row start
# pow = 3^exp
# N - rowstart + 3^exp = N - (pow+1)/2 + pow
# = N - pow/2 - 1/2 + pow
# = N + pow/2 - 1/2
# = N + (pow-1)/2
sub n_to_pythag_digits_lowtohigh {
my ($n) = @_;
my ($pow, $exp) = round_down_pow (2*$n-1, 3);
my @digits = digit_split_lowtohigh($n + ($pow-1)/2,3);
pop @digits; # high 1
return @digits;
}
}
{
# P,Q tables
my $path = Math::PlanePath::PythagoreanTree->new(coordinates => 'PQ');
foreach my $n ($path->n_start .. $path->tree_depth_to_n_end(2)) {
my ($p,$q) = $path->n_to_xy($n);
print "$p,";
}
print "\n";
foreach my $n ($path->n_start .. $path->tree_depth_to_n_end(2)) {
my ($p,$q) = $path->n_to_xy($n);
print "$q,";
}
print "\n";
exit 0;
}
{
require Devel::TimeThis;
require Math::PlanePath::FractionsTree;
my $path = Math::PlanePath::FractionsTree->new
(
# tree_type => 'FB',
# tree_type => 'UAD',
# coordinates => 'BC',
# coordinates => 'PQ', # P>Q one odd other even
);
{
my $t = Devel::TimeThis->new('xy_is_visited');
foreach my $x (0 .. 200) {
foreach my $y (0 .. 200) {
$path->xy_is_visited($x,$y);
}
}
}
{
my $t = Devel::TimeThis->new('xy_to_n');
foreach my $x (0 .. 200) {
foreach my $y (0 .. 200) {
$path->xy_to_n($x,$y);
}
}
}
exit 0;
}
{
# numbers in a grid
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new
(
# tree_type => 'FB',
# tree_type => 'UAD',
# coordinates => 'AB',
coordinates => 'MC',
);
my @rows;
foreach my $n (1 .. 100000) {
my ($orig_x,$orig_y) = $path->n_to_xy($n);
my $x = $orig_x / 2;
my $y = $orig_y / 4;
next if $y > 25;
next if $x > 80;
print "$n $orig_x,$orig_y\n";
$rows[$y] ||= ' 'x80;
substr($rows[$y],$x,length($n)) = $n;
}
for (my $y = $#rows; $y >= 0; $y--) {
$rows[$y] ||= '';
$rows[$y] =~ s/ +$//;
print $rows[$y],"\n";
}
exit 0;
}
{
# repeated "M1" as p,q matrix
# P+(2^k-1)*Q, 2^k*Q
# applied to P=2,Q=1
# 2+(2^k-1) = 2^k + 1, 2^k
require Math::Matrix;
my $u = Math::Matrix->new ([1,1],
[0,2]);
my $m = $u;
foreach (1 .. 5) {
print "$m\n";
$m *= $u;
}
exit 0;
}
{
# repeated "U" as p,q matrix
require Math::Matrix;
my $u = Math::Matrix->new ([2,-1],
[1,0]);
my $m = $u;
foreach (1 .. 5) {
print "$m\n";
$m *= $u;
}
exit 0;
}
{
# high bit 1 in ternary
require Math::BaseCnv;
for (my $n = 1; $n < 65536; $n *= 2) {
my $n3 = Math::BaseCnv::cnv($n,10,3);
my $n2 = Math::BaseCnv::cnv($n,10,2);
printf "$n $n2 $n3\n";
}
exit 0;
}
{
# Fibonacci's method for primitive triples.
# odd numbers 1,3,5,7,...,k being n terms n=(k+1)/2 with k square
# sum 1+3+5+7+...+k = n^2 the gnomons around a square
# a^2 = k = 2n-1
# b^2 = sum 1+3+5+...+k-2 = (n-1)^2
# c^2 = sum 1+3+5+...+k-2+k = n^2
# so a^2+b^2 = c^2
# (n-1)^2 + 2n-1 = n^2-2n+1 + 2n-1 = n^2
#
# i=3
# o=2i-1=5
# k=o^2 = 5^2 = 25
# n=(k+1)/2 = (25+1)/2=13
# a=o = 5
# b = n-1 = 12
#
# i=4
# o=2i-1=7
# k=o^2 = 7^2 = 49
# n=(k+1)/2 = (49+1)/2=25
# a=o = 7
# b = n-1 = 24
sub fibonacci_ab {
my ($i) = @_;
$i = 2*$i+1; # odd integer
my $k = $i**2; # a^2 = k = odd square
my $n = ($k+1)/2;
return ($i, # a=sqrt(k)
$n-1); # b=n-1
}
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new (tree_type => 'FB');
foreach my $i (1 .. 30) {
my ($a,$b) = fibonacci_ab($i);
my $c = sqrt($a*$a+$b*$b);
# my $n = $path->tree_depth_to_n($i-1);
# my ($pa,$pb) = $path->n_to_xy($n);
# print "$i $a,$b,$c $n $pa,$pb\n";
my $n = $path->xy_to_n($a,$b);
my $depth = $path->tree_n_to_depth($n);
print "$i $a,$b,$c $n depth=$depth\n";
}
exit 0;
}
{
# P,Q by rows
require Math::BaseCnv;
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ');
my $fb = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ',
tree_type => 'FB');
my $level = 8;
my $prev_depth = -1;
for (my $n = $path->n_start; ; $n++) {
my $depth = $path->tree_n_to_depth($n);
last if $depth > 4;
if ($depth != $prev_depth) {
print "\n";
$prev_depth = $depth;
}
my ($x,$y) = $path->n_to_xy($n);
printf " %2d/%-2d", $x,$y;
my ($fx,$fy) = $fb->n_to_xy($n);
printf " %2d/%-2d", $fx,$fy;
my $fn = $path->xy_to_n($fx,$fy);
print " ",n_to_treedigits_str($n);
print " ",n_to_treedigits_str($fn);
print "\n";
}
exit 0;
}
{
require Math::BigInt::Lite;
my $x = Math::BigInt::Lite->new(3);
my $y = Math::BigInt::Lite->new(4);
Math::PlanePath::PythagoreanTree::_ab_to_pq($x,$y);
exit 0;
}
{
require Math::BigInt::Lite;
my $x = Math::BigInt::Lite->new(3);
my $low = $x & 1;
### $low
exit 0;
}
{
require Math::BigInt::Lite;
my $x = Math::BigInt::Lite->new(3);
my $y = Math::BigInt::Lite->new(4);
### $x
### $y
my ($a, $b) = ($x,$y);
### _ab_to_pq(): "A=$a, B=$b"
unless ($a >= 3 && $b >= 4 && ($a % 2) && !($b % 2)) {
### don't have A odd, B even ...
return;
}
# This used to be $c=hypot($a,$b) and check $c==int($c), but libm hypot()
# on Darwin 8.11.0 is somehow a couple of bits off being an integer, for
# example hypot(57,176)==185 but a couple of bits out so $c!=int($c).
# Would have thought hypot() ought to be exact on integer inputs and a
# perfect square sum :-(. Check for a perfect square by multiplying back
# instead.
#
my $c;
{
my $csquared = $a*$a + $b*$b;
$c = int(sqrt($csquared));
### $csquared
### $c
unless ($c*$c == $csquared) {
return;
}
}
exit 0;
}
{
require Math::BigInt::Lite;
my $x = Math::BigInt::Lite->new(3);
my $y = Math::BigInt::Lite->new(4);
### $x
### $y
# my $csquared = $x*$x + $y*$y;
# my $c = int(sqrt($csquared));
# ### $c
# my $mod = $x%2;
# $mod = $y%2;
my $eq = ($x*$x == $y*$y);
### $eq
# my $x = 3;
# my $y = 4;
# $x = Math::BigInt::Lite->new($x);
# $y = Math::BigInt::Lite->new($y);
# $mod = $x%2;
# $mod = $y%2;
unless ($x >= 3 && $y >= 4 && ($x % 2) && !($y % 2)) {
### don't have A odd, B even ...
die;
}
# {
# my $eq = ($c*$c == $csquared);
# ### $eq
# }
exit 0;
}
{
# P,Q continued fraction quotients
require Math::BaseCnv;
require Math::ContinuedFraction;
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ');
my $level = 8;
foreach my $n (1 .. 3**$level) {
my ($x,$y) = $path->n_to_xy($n);
my $cfrac = Math::ContinuedFraction->from_ratio($x,$y);
my $cfrac_str = $cfrac->to_ascii;
# my $nbits = Math::BaseCnv::cnv($n,10,3);
my $nbits = n_to_treedigits_str($n);
printf "%3d %7s %2d/%-2d %s\n", $n, $nbits, $x,$y, $cfrac_str;
}
exit 0;
sub n_to_treedigits_str {
my ($n) = @_;
return "~".join('',n_to_treedigits($n));
}
sub n_to_treedigits {
my ($n) = @_;
my ($len, $level) = round_down_pow (2*$n-1, 3);
my @digits = digit_split_lowtohigh ($n - ($len+1)/2, 3);
$#digits = $level-1; # pad to $level with undefs
foreach (@digits) { $_ ||= 0 }
return @digits;
}
}
{
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new (coordinates => 'PQ');
require Math::BigInt;
# my ($n_lo,$n_hi) = $path->rect_to_n_range (1000,0, 1500,200);
my ($n_lo,$n_hi) = $path->rect_to_n_range (Math::BigInt->new(1000),0, 1500,200);
### $n_hi
### n_hi: "$n_hi"
exit 0;
}
{
require Math::PlanePath::PythagoreanTree;
# my $path = Math::PlanePath::PythagoreanTree->new
# (
# # tree_type => 'FB',
# tree_type => 'UAD',
# coordinates => 'AB',
# );
# my ($x,$y) = $path->n_to_xy(1121);
# # exit 0;
foreach my $k (1 .. 10) {
print 3 * 2**$k + 1,"\n";
print 2**($k+2)+1,"\n";
}
sub minpos {
my $min = $_[0];
my $pos = 0;
foreach my $i (1 .. $#_) {
if ($_[$i] < $min) {
$min = $_[$i];
$pos = 1;
}
}
return $pos;
}
require Math::BaseCnv;
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new
(
# tree_type => 'UAD',
tree_type => 'FB',
# coordinates => 'AB',
coordinates => 'PQ',
);
my $n = 1;
foreach my $level (1 .. 100) {
my @x;
my @y;
print "level $level base n=$n\n";
my $base = $n;
my ($min_x, $min_y) = $path->n_to_xy($n);
my $min_x_n = $n;
my $min_y_n = $n;
foreach my $rem (0 .. 3**($level-1)-1) {
my ($x,$y) = $path->n_to_xy($n);
if ($x < $min_x) {
$min_x = $x;
$min_x_n = $n;
}
if ($y < $min_y) {
$min_y = $y;
$min_y_n = $n;
}
$n++;
}
my $min_x_rem = $min_x_n - $base;
my $min_y_rem = $min_y_n - $base;
my $min_x_rem_t = sprintf '%0*s', $level-1, Math::BaseCnv::cnv($min_x_rem,10,3);
my $min_y_rem_t = sprintf '%0*s', $level-1, Math::BaseCnv::cnv($min_y_rem,10,3);
print " minx=$min_x at n=$min_x_n rem=$min_x_rem [$min_x_rem_t]\n";
print " miny=$min_y at n=$min_y_n rem=$min_y_rem [$min_y_rem_t]\n";
local $,='..';
print $path->rect_to_n_range(0,0, $min_x,$min_y),"\n";
}
exit 0;
}
{
my $path = Math::PlanePath::PythagoreanTree->new
(tree_type => 'UAD');
foreach my $level (1 .. 20) {
# my $n = 3 ** $level;
my $n = (3 ** $level - 1) / 2;
my ($x,$y) = $path->n_to_xy($n);
print "$x, $y\n";
}
exit 0;
}
{
# low zeros p=q+1 q=2^k
my $p = 2;
my $q = 1;
### initial
### $p
### $q
foreach (1 .. 3) {
($p,$q) = (2*$p-$q, $p);
### $p
### $q
}
($p,$q) = (2*$p+$q, $p);
### mid
### $p
### $q
foreach (1 .. 3) {
($p,$q) = (2*$p-$q, $p);
### $p
### $q
}
exit 0;
}
{
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new;
my (undef, $n_hi) = $path->rect_to_n_range(0,0, 1000,1000);
### $n_hi
my @count;
foreach my $n (1 .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
my $z = hypot($x,$y);
$count[$z]++;
}
my $total = 0;
foreach my $i (1 .. $#count) {
if ($count[$i]) {
$total += $count[$i];
my $ratio = $total/$i;
print "$i $total $ratio\n";
}
}
exit 0;
}
{
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new;
my $n = 1;
foreach my $x (0 .. 10000) {
foreach my $y (0 .. $x) {
my $n = $path->xy_to_n($x,$y);
next unless defined $n;
my ($nx,$ny) = $path->n_to_xy($n);
if ($nx != $x || $ny != $y) {
### $x
### $y
### $n
### $nx
### $ny
}
}
}
exit 0;
}
{
my ($q,$p) = (21,46);
print "$q / $p\n";
{
my $a = $p*$p - $q*$q;
my $b = 2*$p*$q;
my $c = $p*$p + $q*$q;
print "$a $b $c\n";
{
require Math::BaseCnv;
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new;
my $n = 1;
for ( ; $n < 3**11; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if (($x == $a && $y == $b)
|| ($x == $b && $y == $a)) {
print "n=$n\n";
last;
}
}
my $level = 1;
$n -= 2;
while ($n >= 3**$level) {
$n -= 3**$level;
$level++;
}
my $remt = sprintf "%0*s", $level, Math::BaseCnv::cnv($n,10,3);
print "level $level remainder $n [$remt]\n";
}
}
my $power = 1;
my $rem = 0;
foreach (1..8) {
my $digit;
if ($q & 1) {
$p /= 2;
if ($q > $p) {
$q = $q - $p;
$digit = 2;
} else {
$q = $p - $q;
$digit = 1;
}
} else {
$q /= 2;
$p -= $q;
$digit = 0;
}
print "$digit $q / $p\n";
$rem += $power * $digit;
$power *= 3;
last if $q == 1 && $p == 2;
}
print "digits $rem\n";
exit 0;
}
{
# my ($a, $b, $c) = (39, 80, 89);
my ($a, $b, $c) = (36,77,85);
if (($a ^ $c) & 1) {
($a,$b) = ($b,$a);
}
print "$a $b $c\n";
my $p = sqrt (($a+$c)/2);
my $q = $b/(2*$p);
print "$p $q\n";
$a = $p*$p - $q*$q;
$b = 2*$p*$q;
$c = $p*$p + $q*$q;
print "$a $b $c\n";
exit 0;
}
{
require Math::Matrix;
my $f = Math::Matrix->new ([2,0],
[1,1]);
my $g = Math::Matrix->new ([-1,1],
[0,2]);
my $h = Math::Matrix->new ([1,1],
[0,2]);
my $fi = $f->invert;
print $fi,"\n";
my $gi = $g->invert;
print $gi,"\n";
my $hi = $h->invert;
print $hi,"\n";
exit 0;
}
{
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new;
my $n = 1;
foreach my $i (1 .. 100) {
my ($x,$y) = $path->n_to_xy($n);
# print 2**($i),"\n";
# print 2*2**$i*(2**$i-1),"\n";
my $z = hypot($x,$y);
printf "%3d %4d,%4d,%4d\n", $n, $x, $y, $z;
$n += 3**$i;
}
exit 0;
}
{
sub round_down_pow_3 {
my ($n) = @_;
my $p = 3 ** (int(log($n)/log(3)));
return (3*$p <= $n ? 3*$p
: $p > $n ? $p/3
: $p);
}
require Math::BaseCnv;
# base = (range-1)/2
# range = 2*base + 1
#
# newbase = ((2b+1)/3 - 1) / 2
# = (2b+1-3)/3 / 2
# = (2b-2)/2/3
# = (b-1)/3
#
# deltarem = b-(b-1)/3
# = (3b-b+1)/3
# = (2b+1)/3
#
foreach my $n (1 .. 32) {
my $h = 2*($n-1)+1;
my $level = int(log($h)/log(3));
$level--;
my $range = 3**$level;
my $base = ($range - 1)/2 + 1;
my $rem = $n - $base;
if ($rem < 0) {
$rem += $range/3;
$level--;
$range /= 3;
}
if ($rem >= $range) {
$rem -= $range;
$level++;
$range *= 3;
}
my $remt = Math::BaseCnv::cnv($rem,10,3);
$remt = sprintf ("%0*s", $level, $remt);
print "$n $h $level $range base=$base $rem $remt\n";
}
exit 0;
}
{
my $sum = 0;
foreach my $k (0 .. 10) {
$sum += 3**$k;
my $f = (3**($k+1) - 1) / 2;
print "$k $sum $f\n";
}
exit 0;
}
{
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new;
my $x_limit = 500;
my @max_n;
foreach my $n (0 .. 500000) {
my ($x,$y) = $path->n_to_xy($n);
if ($x <= $x_limit) {
$max_n[$x] = max($max_n[$x] || $n, $n);
}
}
foreach my $x (0 .. $x_limit) {
if ($max_n[$x]) {
print "$x $max_n[$x]\n";
}
}
exit 0;
}
{
require Math::PlanePath::PythagoreanTree;
my $path = Math::PlanePath::PythagoreanTree->new;
my $x_limit = 500;
my @max_n;
foreach my $n (0 .. 500000) {
my ($x,$y) = $path->n_to_xy($n);
if ($x <= $x_limit) {
$max_n[$x] = max($max_n[$x] || $n, $n);
}
}
foreach my $x (0 .. $x_limit) {
if ($max_n[$x]) {
print "$x $max_n[$x]\n";
}
}
exit 0;
}
{
require Math::Matrix;
my $u = Math::Matrix->new ([1,2,2],
[-2,-1,-2],
[2,2,3]);
my $a = Math::Matrix->new ([1,2,2],
[2,1,2],
[2,2,3]);
my $d = Math::Matrix->new ([-1,-2,-2],
[2,1,2],
[2,2,3]);
my $ui = $u->invert;
print $ui;
exit 0;
}
{
my (@x) = 3;
my (@y) = 4;
my (@z) = 5;
for (1..3) {
for my $i (0 .. $#x) {
print "$x[$i], $y[$i], $z[$i] ",sqrt($x[$i]**2+$y[$i]**2),"\n";
}
print "\n";
my @new_x;
my @new_y;
my @new_z;
for my $i (0 .. $#x) {
my $x = $x[$i];
my $y = $y[$i];
my $z = $z[$i];
push @new_x, $x - 2*$y + 2*$z;
push @new_y, 2*$x - $y + 2*$z;
push @new_z, 2*$x - 2*$y + 3*$z;
push @new_x, $x + 2*$y + 2*$z;
push @new_y, 2*$x + $y + 2*$z;
push @new_z, 2*$x + 2*$y + 3*$z;
push @new_x, - $x + 2*$y + 2*$z;
push @new_y, -2*$x + $y + 2*$z;
push @new_z, -2*$x + 2*$y + 3*$z;
}
@x = @new_x;
@y = @new_y;
@z = @new_z;
}
exit 0;
}
Math-PlanePath-122/devel/flowsnake-ascii.gp 0000644 0001750 0001750 00000025572 12544112136 016417 0 ustar gg gg \\ Copyright 2015 Kevin Ryde
\\ This file is part of Math-PlanePath.
\\
\\ Math-PlanePath is free software; you can redistribute it and/or modify it
\\ under the terms of the GNU General Public License as published by the Free
\\ Software Foundation; either version 3, or (at your option) any later
\\ version.
\\
\\ Math-PlanePath is distributed in the hope that it will be useful, but
\\ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
\\ or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
\\ for more details.
\\
\\ You should have received a copy of the GNU General Public License along
\\ with Math-PlanePath. If not, see .
default(strictargs,1)
sqrt3i = quadgen(4*-3);
w = 1/2 + 1/2*sqrt3i;
b = 2 + w;
{
\\ rot 1,8,15 through state table
rot = [0,0,1, 0,0,1,2];
perm = Vecsmall([1,3,5,7,2,4,6]);
v = [6, 6];
r = 0;
forstep(i=#v,1, -1,
d = (perm^r)[v[i]];
r = (r + rot[d]) % 3;
print("new r="r);
);
print(r);
\\
table = 7*[0, 0, 1, 0, 0, 1, 2, 1, 2, 1, 0, 1, 1, 2, 2, 2, 2, 0, 0, 1, 2];
r = 0;
forstep(i=#v,1, -1, r = table[r+v[i]];
print("new r="r);
);
print(r/7);
d=7;r=2;
d = (perm^r)[d];
r = (r + rot[d]) % 3;
print("d perm "d" to r="r);
d=7;r=2*7;
print("table entry ",r+d);
r = table[r+d];
print("to r="r);
quit;
}
{
\\ rot high to low by state table
rot = [0, 0, 1, 0, 0, 1, 2];
perm = Vecsmall([1,3,5,7,2,4,6]);
table = vector(3*7,i,-1);
for(r=0,2,
for(d=1,7,
dperm = (perm^r)[d];
new_r = (r + rot[dperm]) % 3;
table[7*r + d] = new_r;
print("table entry ",7*r+d," is ",7*new_r," for r="r" d="d" perm d="dperm);
));
print(table);
quit;
}
{
\\ when b^k is an X maximum
pos = [0, w^2, 1, w, w^4, w^3, w^5];
for(k=0,50,
X = sum(i=0,k-1, vecmax(real(b^i*pos)));
Xbk = real(b^(k-1) + 1);
diff = abs(Xbk) - X;
if(diff >= 0,
angle = arg(b^k) *180/Pi;
print("k="k" diff="diff" X="X" Xbk="Xbk" angle "angle),
print("k="k" not"));
);
print();
quit;
}
{
\\ extents
pos = [0, w^2, 1, w, w^4, w^3, w^5];
for(k=0,500,
X = 2*sum(i=0,k-1, vecmax(real(b^i*pos)));
Y = 2*sum(i=0,k-1, vecmax(imag(b^i*pos)));
print1(X,",");
);
print();
quit;
}
k=2;
digit_to_rot = [0, 0, 1, 0, 0, 1, 2];
digit_permute_inv = [0, 4, 1, 5, 2, 6, 3];
digit_permute = [0, 2, 4, 6, 1, 3, 5];
digit_to_new_rot = matrix(3,7);
print(digit_to_new_rot);
{
for(d=0,6,
for(rot=0,2,
my(p=d);
for(j=1,rot, p=digit_permute[p+1]);
new_rot = (rot+digit_to_rot[p+1]) % 3;
digit_to_new_rot[rot+1,d+1] = new_rot;
);
);
print("digit_to_new_rot");
for(d=0,6,
for(rot=0,2,
print1(digit_to_new_rot[rot+1,d+1],", "));
print());
print(digit_to_new_rot);
print();
}
z_to_low_digit(z) = 2*real(z) + 4*imag(z);
digit_to_pos = [0, 1, w, w^2, w^3, w^4, w^5];
vector(#digit_to_pos,i, my(z=digit_to_pos[i]); z_to_low_digit(z))
vector(#digit_to_pos,i, my(z=digit_to_pos[i]); z_to_low_digit(z) % 7)
digit_to_pos = [0, w^2, 1, w, w^4, w^3, w^5];
vector(#digit_to_pos,i, my(z=digit_to_pos[i]); z_to_low_digit(z) % 7)
\\ 0 1 2 3 4 5 6
digit_to_reverse = [1, 0, 0, 0, 0, 0, 1];
z_to_digits(z) =
{
my(v = vector(k,i,
my(d = z_to_low_digit(z) % 7);
\\ print("z=",z," low ", d);
z = (z - digit_to_pos[d+1]);
\\ print("sub to "z);
z /= b;
d));
if(z,return(-1));
\\ my(rev=0);
\\ forstep(i=#v,1, -1,
\\ if(rev%2, v[i]=6-v[i]);
\\ rev += digit_to_reverse[v[i]+1]);
v;
}
vector(#digit_to_pos,i, my(z=digit_to_pos[i]); (3*imag(z) + real(z)) % 7)
z_to_digits(0)
print("z_to_digits(1) = ",z_to_digits(1));
z_to_digits(-1)
z_to_digits(-w)
z_to_digits(2)
z_to_digits(b)
{
x_max=0;
x_min=0;
y_max=0;
y_min=0;
for(n=0,7^k-1,
z = subst(Pol(apply((d)->digit_to_pos[d+1],digits(n,7))), 'x, b);
\\ print("subst "z);
x_min = min(x_min,real(z));
x_max = max(x_max,real(z));
y_min = min(y_min,imag(z));
y_max = max(y_max,imag(z)));
print("extents X "x_min" "x_max" Y "y_min" "y_max);
}
{
x_max=0;
y_max=0;
for(i=1,k-1,
my(v = vector(6,d, b^i*w^d));
y_max += vecmax(apply(imag,v));
x_max += vecmax(apply(real,v)));
x_min=-x_max;
y_min=-y_min;
print("extents X "x_min" "x_max" Y "y_min" "y_max);
}
{
x_max = sum(i=0,k-1,vecmax(apply(real,vector(6,d, b^i*w^d))));
y_max = sum(i=0,k-1,vecmax(apply(imag,vector(6,d, b^i*w^d))));
x_min=-x_max;
y_min=-y_min;
print("extents X "x_min" "x_max" Y "y_min" "y_max);
}
{
x_max = sum(i=0,k-1,vecmax(real(vector(6,d, b^i*w^d))));
y_max = sum(i=0,k-1,vecmax(imag(vector(6,d, b^i*w^d))));
x_min=-x_max;
y_min=-y_min;
print("extents X "x_min" "x_max" Y "y_min" "y_max);
}
\\ 0 1 2 3 4 5 6
digit_to_rot = [0, 0, 1, 0, 0, 1, 2];
digit_permute_inv = [0, 4, 1, 5, 2, 6, 3];
digit_permute = [0, 2, 4, 6, 1, 3, 5];
small = Vecsmall([1, 3, 5, 7, 2, 4, 6]);
small*small
\\ 1 2 3 4 5 6 7
small_to_rot = [0, "/ ", "__", 0, " \\", 1, 2];
print("permute twice ", vector(7,d, digit_permute[digit_permute[d]+1]));
perform_rotation(v) =
{
\\ high to low
my(rot = 0);
forstep(i=#v,1, -1,
rot = digit_to_new_rot[rot+1,v[i]+1];
);
return(rot);
\\ low to high
my(rot = 0);
for(i=1,#v,
rot = digit_to_new_rot[rot+1,v[i]+1];
);
return(rot);
}
{
for(n=0,7^2-1,
my(v=digits(n,7));
my(h = perform_rotation(v));
my(l = perform_rotation(Vecrev(v)));
if(l!=h, print(v," h=",h," l=",l));
);
}
{
for(n=0,7^2-1,
my(v=digits(n,7));
\\ print1(perform_rotation(v));
print(v," ",perform_rotation(v));
);
print();
}
print(perform_rotation([0,6,2]))
quit
rot_to_chars = ["__", " \\", "/ "];
{
forstep(y=2*y_max,-2*y_max, -1,
if(y%2,print1("|"));
for(x=-ceil(x_max),ceil(x_max),
my(v = z_to_digits(x+(y%2)/2 + y/2*sqrt3i));
if(v==-1, print1(".."); next());
\\ my(d = prod(i=1,#v,small^digit_to_rot[v[i]+1],small)[2]);
\\ print1(small_to_rot[d]);
my(rot = perform_rotation(v));
print1(rot_to_chars[(rot%3)+1]);
\\ my(rot = 0);
\\ forstep(i=#v,1, -1,
\\ my(d = v[i]);
\\ for(j=1,rot, d=digit_permute[d+1]);
\\ rot += digit_to_rot[d+1]);
\\ print1(rot_to_chars[(rot%3)+1]);
\\ print1(v[1]," ");
\\print1(rot);
);
print());
}
quit
default(strictargs,1)
w = quadgen(-3); \\ sixth root of unity e^(I*Pi/3)
digit_to_pos = [0, 1, w, w^2, w^3, w^4, w^5];
vector(#digit_to_pos,i, my(z=digit_to_pos[i]); (3*imag(z) + real(z)) % 7)
digit_to_pos = [0, 1, w^2, w, w^4, w^5, w^3];
vector(#digit_to_pos,i, my(z=digit_to_pos[i]); (3*imag(z) + real(z)) % 7)
k=2;
z_to_digits(z) =
{
my(v = vector(k,i,
my(d = (3*imag(z) + real(z)) % 7);
z -= digit_to_pos[d+1];
d));
if(z,-1,v);
}
vector(#digit_to_pos,i, my(z=digit_to_pos[i]); (3*imag(z) + real(z)) % 7)
z_to_digits(0)
z_to_digits(1)
z_to_digits(-1)
z_to_digits(-w)
\\ 0 1 2 3 4 5 6
digit_to_rot = [0, 1, 0, 0, 0, 2, 1];
rot_to_chars = ["__"," \\","/ "];
{
forstep(y=2,-2, -1,
if(y%2,print1("|"));
for(x=-2,5,
my(v = z_to_digits(x+floor(x/2) + y*w));
if(v==-1,print1(".."),
my(rot = sum(i=1,#v, digit_to_rot[v[i]+1]));
\\ print1(rot_to_chars[(rot%3)+1]);
print1(v[1]," ");
\\print1(rot);
));
print());
}
quit
for(k=0,3,\\
);
char = Vecsmall("__.\\/...");
printf("%c",char[2*r+o+1])
\\-----------------------------------------------------------------------------
\\ working
for(k=0,3,\
{
sqrt3i = quadgen(-12); \\ sqrt(-3)
w = 1/2 + 1/2*sqrt3i; \\ sixth root of unity
b = 2 + w;
pos = [0, w^2, 1, w, w^4, w^3, w^5];
rot = [0, 0, 1, 0, 0, 1, 2];
perm = Vecsmall([1,3,5,7,2,4,6]);
char = ["_","_", " ","\\", "/"," ", " "," "];
\\ extents
X = 2*sum(i=0,k-1, vecmax(real(b^i*pos)));
Y = 2*sum(i=0,k-1, vecmax(imag(b^i*pos)));
for(y = -Y, Y,
for(x = -X+(k>0), X+(k<3),
\\ for(y = -Y, -Y+10,
\\ for(x = -30, 170,
o = (x+y)%2;
z = (x-o - y*sqrt3i)/2;
v = vector(k,i,
d = (2*real(z) + 4*imag(z)) % 7 + 1;
z = (z - pos[d]) / b;
d);
if(z, r = 3,
r = 0;
forstep(i=#v,1, -1,
d = (perm^r)[v[i]];
r = (r + rot[d]) % 3));
print1(char[2*r+o+1]));
print())
}\
);
quit
\\-----------------------------------------------------------------------------
\\ working
{
sqrt3i = quadgen(-12); \\ sqrt(-3)
w = 1/2 + 1/2*sqrt3i; \\ sixth root of unity
b = 2 + w;
pos = [0, w^2, 1, w, w^4, w^3, w^5];
rot = [0, 0, 1, 0, 0, 1, 2];
perm = [1,2,3,4,5,6,7;
1,3,5,7,2,4,6;
1,5,2,6,3,7,4];
chars = ["__", ".\\", "/ ",".."];
\\ extents
X = ceil(sum(i=0,k-1, vecmax(real(b^i*pos))));
Y = 2* sum(i=0,k-1, vecmax(imag(b^i*pos)));
for(y = -Y, Y,
if(y%2,print1(" "));
for(x = -X, X-(y%2),
z = x+(y%2)/2 - y/2*sqrt3i;
v = vector(k,i,
d = (2*real(z) + 4*imag(z)) % 7 + 1;
z = (z - pos[d]) / b;
d);
if(z, r = 3,
r = 0;
forstep(i=#v,1, -1,
d = perm[r+1,v[i]];
r = (r + rot[d]) % 3));
print1(chars[r+1]));
print())
}
quit
\\-----------------------------------------------------------------------------
{
sqrt3i = quadgen(-12);
w = 1/2 + 1/2*sqrt3i;
b = 2 + w;
x_max = sum(i=0,k-1,vecmax(apply(real,vector(6,d, b^i*w^d))));
y_max = sum(i=0,k-1,vecmax(apply(imag,vector(6,d, b^i*w^d))));
digit_to_pos = [0, w^2, 1, w, w^4, w^3, w^5];
digit_to_rot = [0, 0, 1, 0, 0, 1, 2];
digit_permute = [1,2,3,4,5,6,7; 1,3,5,7,2,4,6; 1,5,2,6,3,7,4];
rot_to_chars = ["__", " \\", "/ "];
forstep(y=2*y_max,-2*y_max, -1,
if(y%2,print1("|"));
for(x=-ceil(x_max),ceil(x_max),
z = x+(y%2)/2 + y/2*sqrt3i;
v = vector(k,i,
d = (2*real(z) + 4*imag(z)) % 7 + 1;
z = (z - digit_to_pos[d]) / b;
d);
if(z, print1(".."); next());
rot = 0;
forstep(i=#v,1, -1,
d = digit_permute[rot+1,v[i]];
rot = (rot + digit_to_rot[d]) % 3);
print1(rot_to_chars[rot%3+1]));
print());
}
\\ M = sum(i=0,k-1,
\\ v = vector(6,d, b^i*w^d);
\\ vecmax(real(v)) + vecmax(imag(v))*S);
\\ X = ceil(real(M));
\\ Y = 2*imag(M);
Math-PlanePath-122/devel/dekking-curve.pl 0000644 0001750 0001750 00000012122 12535705354 016100 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use List::MoreUtils;
use POSIX 'floor';
use Math::BaseCnv;
use Math::Libm 'M_PI', 'hypot', 'cbrt';
use List::Util 'min', 'max', 'sum';
use Math::PlanePath::DekkingCurve;
use Math::PlanePath::Base::Digits
'round_down_pow','digit_split_lowtohigh';
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
# use Smart::Comments;
{
# X leading diagonal segments
my $path = Math::PlanePath::DekkingCentres->new;
my @values;
my $prev = -1;
foreach my $i (0 .. 500) {
my $n = $path->xyxy_to_n($i,$i, $i+1,$i+1); # forward
# my $n = $path->xyxy_to_n($i+1,$i+1, $i,$i); # reverse
if (defined $n) {
my $i5 = Math::BaseCnv::cnv($i,10,5);
print "$i [$i5] \n";
push @values, $i;
}
$prev = $n;
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose=>1);
exit 0;
}
{
# X negative axis N not increasing
my $path = Math::PlanePath::DekkingCurve->new (arms => 3);
my @values;
my $prev = -1;
foreach my $i (0 .. 500) {
my $n = $path->xy_to_n(-$i,0);
if ($n < $prev) {
my $i5 = Math::BaseCnv::cnv($i,10,5);
print "$i [$i5] \n";
push @values, $i;
}
$prev = $n;
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose=>1);
exit 0;
}
{
# X,Y axis points in common (none)
my $path = Math::PlanePath::DekkingCurve->new;
my @values;
foreach my $i (0 .. 500) {
my $nx = $path->xy_to_n($i,0);
my $ny = $path->xy_to_n(0,$i);
if (defined $nx && defined $ny) {
my $i5 = Math::BaseCnv::cnv($i,10,5);
print "$i5 \n";
push @values, $i;
}
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose=>1);
exit 0;
}
{
# Y axis points
my %table = (S => ['W','N','E','S','S'],
E => ['N','N','E','S','S'],
N => ['N','N','E','S','W'],
W => ['W','N','E','S','W']);
sub yseg_to_side {
my ($y) = @_;
my $state = 'W';
my @digits = digit_split_lowtohigh($y,5);
foreach my $digit (reverse @digits) { # high to low
$state = $table{$state}->[$digit];
}
return $state;
}
my $path = Math::PlanePath::DekkingCurve->new;
my @values;
foreach my $y (0 .. 500) {
my $path_point_visit = defined($path->xy_to_n(0,$y)) ? 1 : 0;
my $path_seg_visit = defined($path->xyxy_to_n_either(0,$y, 0,$y+1)) ? 1 : 0;
my $side = yseg_to_side($y);
my $prev_side = $y>0 && yseg_to_side($y-1);
my $htol_visit = ($side eq 'S' || $side eq 'W'
|| $prev_side eq 'S' || $prev_side eq 'E'
? 1 : 0);
my $htol_seg_visit = ($side eq 'S' ? 1 : 0);
my $diff = ($path_seg_visit == $htol_seg_visit ? '' : ' ***');
my $y5 = Math::BaseCnv::cnv($y,10,5);
print "$y5 $path_seg_visit ${htol_seg_visit}[$side] $diff\n";
if (defined $path_seg_visit) {
push @values, $y;
}
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose=>1);
exit 0;
}
{
# X axis points
# X
# S -> S,S,E,N,W
# E -> S,S,E,N,N
# N -> W,S,E,N,N
# W -> W,N,E,S,W
my %table = (S => ['S','S','E','N','W'],
E => ['S','S','E','N','N'],
N => ['W','S','E','N','N'],
W => ['W','S','E','N','W']);
sub x_to_side {
my ($x) = @_;
my $state = 'S';
my @digits = digit_split_lowtohigh($x,5);
foreach my $digit (reverse @digits) { # high to low
$state = $table{$state}->[$digit];
}
return $state;
}
my $path = Math::PlanePath::DekkingCurve->new;
my @values;
foreach my $x (0 .. 500) {
my $path_point_visit = defined($path->xy_to_n($x,0)) ? 1 : 0;
my $path_seg_visit = defined($path->xyxy_to_n_either($x,0, $x+1,0)) ? 1 : 0;
my $side = x_to_side($x);
my $prev_side = $x>0 && x_to_side($x-1);
my $htol_visit = ($side eq 'S' || $side eq 'E'
|| $prev_side eq 'S' || $prev_side eq 'W'
? 1 : 0);
my $htol_seg_visit = $path->_UNDOCUMENTED__xseg_is_traversed($x);
my $diff = ($path_seg_visit == $htol_seg_visit ? '' : ' ***');
my $x5 = Math::BaseCnv::cnv($x,10,5);
print "$x5 $path_seg_visit ${htol_visit}[$side] $diff\n";
if (defined $path_seg_visit) {
push @values, $x;
}
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values, verbose=>1);
exit 0;
}
Math-PlanePath-122/devel/staircase-alternating.pl 0000644 0001750 0001750 00000001750 11717623507 017633 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::StaircaseAlternating;
# uncomment this to run the ### lines
use Smart::Comments;
{
my $path = Math::PlanePath::StaircaseAlternating->new (end_type => 'square');
my @nlohi = $path->rect_to_n_range (0,2, 2,4);
### @nlohi
exit 0;
}
Math-PlanePath-122/devel/alternate-paper.pl 0000644 0001750 0001750 00000047170 12451351455 016435 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Math::Trig 'pi';
use Math::PlanePath::Base::Digits 'digit_split_lowtohigh';
use lib 'xt';
use MyOEIS;
# uncomment this to run the ### lines
# use Smart::Comments;
=head2 Right Boundary Segment N
The segment numbers which are the right boundary, being the X axis and
notches there, are
N such that N+2 in base-4 has
least significant digit any 0,1,2,3
above that only digits 0,2
= 0,1, 2,3,4,5, 14,15,16,17, 18,19,20,21, 62,63,64,65, ...
=head2 Left Boundary Segment N
The segment numbers which are the left boundary, being the stair-step
diagonal, are
N such that N+1 in base-4 has
least significant digit any 0,1,2,3
above that only digits 0,2
= 0,1,2, 7,8,9,10, 31,32,33,34, 39,40,41,42, 127,128,129,130, ...
=cut
{
# resistance
#
# 2---3
# | |
# 0---1 4
#
# vertices 5
# 4
# 4.000000000000000000000000000
# level=2
# vertices 14
# 28/5
# 5.600000000000000000000000000
# level=3
# vertices 44
# 32024446704/4479140261
# 7.149686064273931429806591627
# level=4
# vertices 152
# 6628233241945519690439003608662864691664896192990656/773186632952527929515144502921021371068970539201685
# 8.572617476112626473076554400
#
# shortcut on X axis
# 2---3
# | | 1 + 1/(1+1/3) = 1+3/4
# 0---1---4
# 1
# 1.000000000000000000000000000
# level=1
# vertices 5
# 7/4
# 1.750000000000000000000000000
# level=2
# vertices 14
# 73/26
# 2.807692307692307692307692308
# level=3
# vertices 44
# 2384213425/588046352
# 4.054465123184711126309308352
# level=4
# vertices 152
# 2071307229966623393952039649887056624274965452048209/386986144302228882053693423947791758105522022410048
# 5.352406695855682889687320523
#
sub to_bigrat {
my ($n) = @_;
return $n;
require Math::BigRat;
return Math::BigRat->new($n);
}
my @dir4_to_dx = (1,0,-1,0);
my @dir4_to_dy = (0,1,0,-1);
require Math::PlanePath::AlternatePaper;
my $path = Math::PlanePath::AlternatePaper->new;
foreach my $level (0 .. 9) {
print "level=$level\n";
my %xy_to_index;
my %xy_to_value;
my $index = 0;
my @rows;
my $n_lo = 0;
my $n_hi = 2*4**$level;
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy($n);
my $xy = "$x,$y";
if (! exists $xy_to_index{$xy}) {
### vertex: "$x,$y index=$index"
$xy_to_index{$xy} = $index++;
$xy_to_value{$xy} = ($n == $n_lo ? to_bigrat(-1)
: $n == $n_hi ? to_bigrat(1)
: to_bigrat(0));
}
}
foreach my $xy (keys %xy_to_index) {
my @row = (to_bigrat(0)) x $index;
$row[$index] = $xy_to_value{$xy};
my $i = $xy_to_index{$xy};
if ($i == 0) {
$row[$i] = 1;
$row[$index] = 0;
} else {
my ($x,$y) = split /,/, $xy;
### point: "$x,$y"
foreach my $dir4 (0 .. $#dir4_to_dx) {
my $dx = $dir4_to_dx[$dir4];
my $dy = $dir4_to_dy[$dir4];
my $x2 = $x+$dx;
my $y2 = $y+$dy;
my $n = $path->xyxy_to_n ($x,$y, $x2,$y2);
if (defined $n && $n < $n_hi) {
my $i2 = $xy_to_index{"$x2,$y2"};
### edge: "$x,$y to $x2,$y2 $i to $i2"
$row[$i]++;
$row[$i2]--;
}
}
}
push @rows, \@row;
}
print "vertices $index\n";
### @rows
require Math::Matrix;
my $m = Math::Matrix->new(@rows);
# print $m;
if (0) {
my $s = $m->solve;
# print $s;
foreach my $i (0 .. $index-1) {
print " ",$s->[$i][0],",";
}
print "\n";
my $V = $s->[0][0];
print int($V),"+",$V-int($V),"\n";
}
{
open my $fh, '>', '/tmp/x.gp' or die;
mm_print_pari($m,$fh);
print $fh "; s=matsolve(m,v); print(s[$index,1]);s[$index,1]+0.0\n";
close $fh;
require IPC::Run;
IPC::Run::run(['gp','--quiet'],'<','/tmp/x.gp');
}
}
exit 0;
sub mm_print_pari {
my ($m, $fh) = @_;
my ($rows, $cols) = $m->size;
print $fh "m=[\\\n";
my $semi = '';
foreach my $r (0 .. $rows-1) {
print $fh $semi;
$semi = ";\\\n";
my $comma = '';
foreach my $c (0 .. $cols-2) {
print $fh $comma, $m->[$r][$c];
$comma = ',';
}
}
print $fh "];\\\nv=[";
$semi = '';
foreach my $r (0 .. $rows-1) {
print $fh $semi, $m->[$r][$cols-1];
$semi = ';';
}
print $fh "]";
}
}
{
# left boundary
require Math::PlanePath::AlternatePaper;
my $path = Math::PlanePath::AlternatePaper->new;
my @values;
for (my $n = $path->n_start; @values < 30; $n++) {
if ($path->_UNDOCUMENTED__n_segment_is_right_boundary($n)) {
push @values, $n;
}
}
print join(',',@values),"\n";
Math::OEIS::Grep->search(array=>\@values);
exit;
}
{
# base 4 reversal
# 1000 0
# 111 1
# 110 10
# 101 11
# 100 100
# 11 101
# 10 110
# 1 111
# 0 1000
require Math::BaseCnv;
require Math::PlanePath::AlternatePaper;
my $path = Math::PlanePath::AlternatePaper->new;
foreach my $i (0 .. 32) {
my $nx = $path->xy_to_n($i,0);
my $nxr = $path->xy_to_n(32-$i,0);
printf "%6s ", Math::BaseCnv::cnv($nx, 10,4);
printf "%6s ", Math::BaseCnv::cnv($nxr, 10,4);
my $c = 3*$nx + 3*$nxr;
printf "%6s ", Math::BaseCnv::cnv($c, 10,4);
print "\n";
}
print "\n";
exit 0;
}
{
# N pairs in X=2^k columns
# 8 | 128
# | |
# 7 | 42---43/127
# | | |
# 6 | 40---41/45--44/124
# | | | |
# 5 | 34---35/39--38/46--47/123
# | | | | |
# 4 | 32---33/53--36/52--37/49--48/112
# | | | | | |
# 3 | 10---11/31--30/54--51/55--50/58--59/111
# | | | | | | |
# 2 | 8----9/13--12/28--29/25--24/56--57/61--60/108
# | | | | | | | |
# 1 | 2----3/7---6/14--15/27--26/18--19/23---22/62--63/107
# | | | | | | | | |
# Y=0 | 0-----1 4-----5 16-----17 20-----21 64---..
#
# *
# / | \
# *---*---*
# 2000-0
# 2000-1
# 2000-10
# 2000-11
# 2000-100
# 1000-1001
#
# 0 1 10 11 100 101 110 111 1000 1001 1010 1011 1100 1101 1110 1111 10000
# X=8
# N=64
# left vert = 1000 - horiz
# right vert = 2000 - horiz reverse
#
require Math::PlanePath::AlternatePaper;
require Math::BaseCnv;
my $path = Math::PlanePath::AlternatePaper->new;
print "X ";
foreach my $x (0 .. 16) {
my $nx = $path->xy_to_n($x,0);
print " ",Math::BaseCnv::cnv($nx, 10,4);
}
print "\n";
foreach my $k (0 .. 3) {
my $x = 2**$k;
my $x4 = Math::BaseCnv::cnv($x,10,4);
print "k=$k x=$x [$x4]\n";
foreach my $y (reverse 0 .. $x) {
printf " y=%2d", $y;
my $nx = $path->xy_to_n($y,0);
my $nxr = $path->xy_to_n($x-$y,0);
my $nd = $path->xy_to_n($y,$y);
my @n_list = $path->xy_to_n_list($x,$y);
foreach my $n (@n_list) {
printf " %3d[%6s]", $n, Math::BaseCnv::cnv($n,10,4);
}
my ($na,$nb) = @n_list;
print " ";
print " ",Math::BaseCnv::cnv(4**$k - $nx, 10,4);
print " ",Math::BaseCnv::cnv(2*4**$k - $nxr, 10,4);
print "\n";
}
}
exit 0;
}
{
# revisit
require Math::NumSeq::PlanePathCoord;
my $seq = Math::NumSeq::PlanePathCoord->new (planepath => 'AlternatePaper',
coordinate_type => 'Revisit');
foreach my $n (0 .. 4*4*4*64) {
my $want = $seq->ith($n);
my $got = n_to_revisit($n);
my $diff = ($want == $got ? '' : ' ***');
print "$n $want $got$diff\n";
last if $diff;
}
sub n_to_revisit {
my ($n) = @_;
### n_to_revisit(): $n
my @digits = digit_split_lowtohigh($n,4);
### digits: join(',', reverse @digits)
my $rev = 0;
foreach my $digit (reverse @digits) { # high to low
if ($rev) {
$rev ^= ($digit == 0 || $digit == 2);
} else {
$rev ^= ($digit == 1 || $digit == 3);
}
}
### $rev
my $h = 1;
my $v = 1;
my $d = 1;
my $nonzero = 0;
while (defined (my $digit = shift @digits)) { # low to high
if ($rev) {
$rev ^= ($digit == 0 || $digit == 2);
} else {
$rev ^= ($digit == 1 || $digit == 3);
}
### at: "h=$h v=$v d=$d rev=$rev digit=$digit nonzero=$nonzero"
if ($rev) {
if ($digit == 0) {
$h = 0;
$d = 0;
} elsif ($digit == 1) {
if ($v) {
### return nonzero ...
return $nonzero ? 1 : 0;
}
} elsif ($digit == 2) {
if ($d) {
### return nonzero ...
return $nonzero ? 1 : 0;
}
$h = 0;
} else { # $digit == 3
$h = 0;
}
} else {
# forward
if ($digit == 0) {
$v = 0;
} elsif ($digit == 1) {
if ($h) { return $nonzero ? 1 : 0; }
$h = $v;
$d = 0;
} elsif ($digit == 2) {
$h = 0;
} else { # $digit == 3
if ($v || $d) { return $nonzero ? 1 : 0; }
$v = $h;
$h = 0;
}
}
$nonzero ||= $digit;
}
### at: "final h=$h v=$v d=$d rev=$rev"
return 0;
}
sub Xn_to_revisit {
my ($n) = @_;
### n_to_revisit(): $n
my $h = 0;
my $v = 0;
my $d = 0;
my @digits = reverse digit_split_lowtohigh($n,4);
### digits: join(',',@digits)
while (@digits && $digits[-1] == 0) {
pop @digits; # strip low zero digits
}
my $low = pop @digits || 0;
my $rev = 0;
while (defined (my $digit = shift @digits)) {
### at: "rev=$rev h=$h v=$v d=$d digit=$digit more=".scalar(@digits)
if ($rev) {
if ($digit == 0) {
$v = 0;
$d = 0;
$rev ^= 1; # forward again
} elsif ($digit == 1) {
$v = ($low ? 1 : 0);
} elsif ($digit == 2) {
$h = 0;
$d = ($low ? 1 : 0);
$rev ^= 1;
} else { # $digit == 3
$h = ($low ? 1 : 0);
}
} else {
# forward
if ($digit == 0) {
$v = 0;
} elsif ($digit == 1) {
$v = ($low ? 1 : 0);
$d = 0;
$rev ^= 1;
} elsif ($digit == 2) {
$h = 0;
} else { # $digit == 3
$h = ($low ? 1 : 0);
$d = 1;
$rev ^= 1;
}
}
}
### at: "final rev=$rev h=$h v=$v d=$d"
# return ($h || $v);
# return ($h || $v || $d);
if ($rev) {
if ($low == 0) {
return $h || $v;
} elsif ($low == 1) {
return $h;
} elsif ($low == 2) {
return $d;
} else { # $digit == 3
return $v;
}
} else {
if ($low == 0) {
return $h || $d;
} elsif ($low == 1) {
return $h;
} elsif ($low == 2) {
return $d;
} else { # $digit == 3
return $v;
}
}
}
exit 0;
}
{
# total turn
require Math::PlanePath::AlternatePaper;
require Math::BaseCnv;
my $path = Math::PlanePath::AlternatePaper->new;
my $total = 0;
my $bits_total = 0;
my @values;
for (my $n = 1; $n <= 32; $n++) {
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $n4 = Math::BaseCnv::cnv($n,10,4);
printf "%10s %10s %2d %2d\n", $n2, $n4, $total, $bits_total;
# print "$total,";
push @values, $total;
$bits_total = total_turn_by_bits($n);
my $turn = path_n_turn ($path, $n);
if ($turn == 1) { # left
$total++;
} elsif ($turn == 0) { # right
$total--;
} else {
die;
}
}
print join(',',@values),"\n";
Math::OEIS::Grep->search(array=>\@values);
use Math::PlanePath;
use Math::PlanePath::GrayCode;
sub total_turn_by_bits {
my ($n) = @_;
my $bits = [ digit_split_lowtohigh($n,2) ];
my $rev = 0;
my $total = 0;
for (my $pos = $#$bits; $pos >= 0; $pos--) { # high bit to low bit
my $bit = $bits->[$pos];
if ($rev) {
if ($bit) {
} else {
if ($pos & 1) {
$total--;
} else {
$total++;
}
$rev = 0;
}
} else {
if ($bit) {
if ($pos & 1) {
$total--;
} else {
$total++;
}
$rev = 1;
} else {
}
}
}
return $total;
}
exit 0;
}
{
require Math::PlanePath::AlternatePaper;
require Math::PlanePath::AlternatePaperMidpoint;
my $paper = Math::PlanePath::AlternatePaper->new (arms => 8);
my $midpoint = Math::PlanePath::AlternatePaperMidpoint->new (arms => 8);
foreach my $n (0 .. 7) {
my ($x1,$y1) = $paper->n_to_xy($n);
my ($x2,$y2) = $paper->n_to_xy($n+8);
my ($mx,$my) = $midpoint->n_to_xy($n);
my $x = $x1+$x2; # midpoint*2
my $y = $y1+$y2;
($x,$y) = (($x+$y-1)/2,
($x-$y-1)/2); # rotate -45 and shift
print "$n $x,$y $mx,$my\n";
}
exit 0;
}
{
# grid X,Y offset
require Math::PlanePath::AlternatePaperMidpoint;
my $path = Math::PlanePath::AlternatePaperMidpoint->new (arms => 8);
my %dxdy_to_digit;
my %seen;
for (my $n = 0; $n < 4**4; $n++) {
my $digit = $n % 4;
foreach my $arm (0 .. 7) {
my ($x,$y) = $path->n_to_xy(8*$n+$arm);
my $nb = int($n/4);
my ($xb,$yb) = $path->n_to_xy(8*$nb+$arm);
$xb *= 2;
$yb *= 2;
my $dx = $xb - $x;
my $dy = $yb - $y;
my $dxdy = "$dx,$dy";
my $show = "${dxdy}[$digit]";
$seen{$x}{$y} = $show;
if ($dxdy eq '0,0') {
}
$dxdy_to_digit{$dxdy} = $digit;
}
}
foreach my $y (reverse -45 .. 45) {
foreach my $x (-5 .. 5) {
printf " %9s", $seen{$x}{$y}//'e'
}
print "\n";
}
### %dxdy_to_digit
exit 0;
}
{
# sum/sqrt(n) goes below pi/4
print "pi/4 ",pi/4,"\n";
require Math::PlanePath::AlternatePaper;
my $path = Math::PlanePath::AlternatePaper->new;
my $min = 999;
for my $n (1 .. 102400) {
my ($x,$y) = $path->n_to_xy($n);
my $sum = $x+$y;
my $frac = $sum/sqrt($n);
# printf "%10s %.4f\n", "$n,$x,$y", $frac;
$min = min($min,$frac);
}
print "min $min\n";
exit 0;
}
{
# repeat points
require Math::PlanePath::AlternatePaper;
require Math::BaseCnv;
my $path = Math::PlanePath::AlternatePaper->new;
for my $nn (0 .. 1024) {
my ($x,$y) = $path->n_to_xy($nn);
next unless $y == 18;
my ($n,$m) = $path->xy_to_n_list($x,$y);
next unless ($n == $nn) && $m;
my $diff = $m - $n;
my $xor = $m ^ $n;
my $n4 = Math::BaseCnv::cnv($n,10,4);
my $m4 = Math::BaseCnv::cnv($m,10,4);
my $diff4 = Math::BaseCnv::cnv($diff,10,4);
my $xor4 = Math::BaseCnv::cnv($xor,10,4);
printf "%10s %6s %6s %6s,%-6s\n",
"$n,$x,$y", $n4, $m4, $diff4, $diff4;
}
exit 0;
}
{
# dY
require Math::PlanePath::AlternatePaper;
require Math::BaseCnv;
my $path = Math::PlanePath::AlternatePaper->new;
for (my $n = 1; $n <= 64; $n += 2) {
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $n4 = Math::BaseCnv::cnv($n,10,4);
my $dy = path_n_dy ($path, $n);
my $nhalf = $n>>1;
my $grs_half = GRS($nhalf);
my $calc_dy = $grs_half * (($nhalf&1) ? -1 : 1);
my $diff = ($calc_dy == $dy ? '' : ' ****');
my $grs = GRS($n);
printf "%10s %10s %2d %2d %2d%s\n", $n2, $n4,
$dy,
$grs,
$calc_dy,$diff;
}
exit 0;
sub GRS {
my ($n) = @_;
return (count_1_bits($n&($n>>1)) & 1 ? -1 : 1);
}
sub count_1_bits {
my ($n) = @_;
my $count = 0;
while ($n) {
$count += ($n & 1);
$n >>= 1;
}
return $count;
}
}
{
# base4 X,Y axes and diagonal
# diagonal base4 all twos
require Math::PlanePath::AlternatePaper;
require Math::BaseCnv;
my $path = Math::PlanePath::AlternatePaper->new;
for my $x (0 .. 40) {
my $y;
$y = 0;
$y = $x;
my $n = $path->xy_to_n($x,$y);
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $n4 = Math::BaseCnv::cnv($n,10,4);
printf "%14s %10s %4d %d,%d\n",
$n2, $n4, $n,$x,$y;
}
exit 0;
}
{
# dX
require Math::PlanePath::AlternatePaper;
require Math::BaseCnv;
my $path = Math::PlanePath::AlternatePaper->new;
for (my $n = 0; $n <= 64; $n += 2) {
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $n4 = Math::BaseCnv::cnv($n,10,4);
my ($dx,$dy) = $path->n_to_dxdy($n);
my $grs = GRS($n);
my $calc_dx = 0;
my $diff = ($calc_dx == $dx ? '' : ' ****');
printf "%10s %10s %2d %2d %2d%s\n", $n2, $n4,
$dx,
$grs,
$calc_dx,$diff;
}
exit 0;
}
{
# plain rev
# 0 0 0 -90
# 1 +90 1 0
# 2 0 2 +90
# 3 -90 3 0
#
# dX ends even so plain, count 11 bits mod 2
# dY ends odd so rev,
# dX,dY
require Math::PlanePath::AlternatePaper;
require Math::BaseCnv;
my $path = Math::PlanePath::AlternatePaper->new;
for (my $n = 0; $n <= 128; $n += 2) {
my ($x,$y) = $path->n_to_xy($n);
my ($next_x,$next_y) = $path->n_to_xy($n+1);
my $dx = $next_x - $x;
my $dy = - path_n_dy ($path,$n ^ 0xFFFF);
my $n2 = Math::BaseCnv::cnv($n,10,2);
my $n4 = Math::BaseCnv::cnv($n,10,4);
printf "%10s %10s %2d,%2d\n", $n2, $n4, $dx,$dy;
}
exit 0;
sub path_n_dx {
my ($path,$n) = @_;
my ($x,$y) = $path->n_to_xy($n);
my ($next_x,$next_y) = $path->n_to_xy($n+1);
return $next_x - $x;
}
sub path_n_dy {
my ($path,$n) = @_;
my ($x,$y) = $path->n_to_xy($n);
my ($next_x,$next_y) = $path->n_to_xy($n+1);
return $next_y - $y;
}
}
# return 1 for left, 0 for right
sub path_n_turn {
my ($path, $n) = @_;
my $prev_dir = path_n_dir ($path, $n-1);
my $dir = path_n_dir ($path, $n);
my $turn = ($dir - $prev_dir) % 4;
if ($turn == 1) { return 1; }
if ($turn == 3) { return 0; }
die "Oops, unrecognised turn";
}
# return 0,1,2,3
sub path_n_dir {
my ($path, $n) = @_;
my ($x,$y) = $path->n_to_xy($n);
my ($next_x,$next_y) = $path->n_to_xy($n+1);
return dxdy_to_dir4 ($next_x - $x,
$next_y - $y);
}
# return 0,1,2,3, with Y reckoned increasing upwards
sub dxdy_to_dir4 {
my ($dx, $dy) = @_;
if ($dx > 0) { return 0; } # east
if ($dx < 0) { return 2; } # west
if ($dy > 0) { return 1; } # north
if ($dy < 0) { return 3; } # south
}
Math-PlanePath-122/devel/square-spiral.pl 0000644 0001750 0001750 00000002263 11722575776 016151 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use Math::PlanePath::SquareSpiral;
# uncomment this to run the ### lines
#use Smart::Comments;
{
require Math::Prime::XS;
my @primes = (0,
Math::Prime::XS::sieve_primes (1000));
my $path = Math::PlanePath::SquareSpiral->new;
foreach my $y (reverse -4 .. 4) {
foreach my $x (-4 .. 4) {
my $n = $path->xy_to_n($x,$y);
my $p = $primes[$n] // '';
printf " %4d", $p;
}
print "\n";
}
exit 0;
}
Math-PlanePath-122/devel/gosper-side.pl 0000644 0001750 0001750 00000005263 12402275640 015564 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.006;
use strict;
use warnings;
use Math::Libm 'M_PI', 'hypot';
{
# horizontals have count_1_digits == 0 mod 3
# Easts have count_1_digits == 0 mod 6
#
require Math::PlanePath::GosperSide;
require Math::BaseCnv;
my $path = Math::PlanePath::GosperSide->new;
foreach my $n (0 .. 500) {
my ($dx,$dy) = $path->n_to_dxdy($n);
my $n3 = Math::BaseCnv::cnv($n, 10, 3);
# next if $n3 =~ /1/;
next if $dy != 0;
# next if $dx < 0;
print "$n $n3 $dx $dy\n";
}
exit 0;
}
{
# minimum hypot beyond N=3^level
#
require Math::PlanePath::GosperSide;
require Math::BaseCnv;
my $path = Math::PlanePath::GosperSide->new;
my $prev_min_hypot = 1;
foreach my $level (0 .. 40) {
my $n_level = 3**$level;
my $min_n = $n_level;
my ($x,$y) = $path->n_to_xy($min_n);
my $min_hypot = hypot($x,sqrt(3)*$y);
foreach my $n ($n_level .. 1.0001*$n_level) {
my ($x,$y) = $path->n_to_xy($n);
my $h = hypot($x,sqrt(3)*$y);
if ($h < $min_hypot) {
$min_n = $n;
$min_hypot = $h;
}
}
my $min_n3 = Math::BaseCnv::cnv($min_n, 10, 3);
my $factor = $min_hypot / $prev_min_hypot;
printf "%2d %8d %15s %9.2f %7.4f %7.4g\n",
$level, $min_n, "[$min_n3]", $min_hypot, $factor, $factor-sqrt(7);
$prev_min_hypot = $min_hypot;
}
exit 0;
}
{
# growth of 3^level hypot
#
require Math::PlanePath::GosperSide;
my $path = Math::PlanePath::GosperSide->new;
my $prev_angle = 0;
my $prev_dist = 0;
foreach my $level (0 .. 20) {
my ($x,$y) = $path->n_to_xy(3**$level);
$y *= sqrt(3);
my $angle = atan2($y,$x);
$angle *= 180/M_PI();
if ($angle < 0) { $angle += 360; }
my $delta_angle = $angle - $prev_angle;
my $dist = log(hypot($x,$y));
my $delta_dist = $dist - $prev_dist;
printf "%d %d,%d %.1f %+.3f %.3f %+.5f\n",
$level, $x, $y, $angle, $delta_angle,
$dist, $delta_dist;
$prev_angle = $angle;
$prev_dist = $dist;
}
exit 0;
}
Math-PlanePath-122/devel/number-fraction.pl 0000644 0001750 0001750 00000002470 11663776631 016451 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use lib '/so/perl/number-fraction/number-fraction/lib/';
use Number::Fraction;
print Number::Fraction->VERSION,"\n";
# uncomment this to run the ### lines
use Smart::Comments;
{
my $x = Number::Fraction->new('4/3');
my $y = Number::Fraction->new('2/1');
my $pow = $x ** $y;
print "pow: $pow\n";
exit 0;
}
{
my $x = Number::Fraction->new('0/2');
my $y = Number::Fraction->new('0/1');
my $eq = ($x == $y);
print "equal: $eq\n";
exit 0;
}
{
my $nf = Number::Fraction->new('4/-3');
print "$nf\n";
$nf = int($nf);
print "$nf ",ref($nf),"\n";
exit 0;
}
Math-PlanePath-122/devel/bigint-lite.pl 0000644 0001750 0001750 00000004036 12523324765 015556 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Devel::TimeThis;
# use Math::BigInt try => 'GMP';
use Math::BigInt::Lite;
# uncomment this to run the ### lines
use Smart::Comments;
{
# ->blog()
my $base = 3;
my $n = Math::BigInt::Lite->new(1);
my $exp = $n->copy->blog($base);
### n: $n
### exp: $exp
### exp: ref $exp
my $pow = (ref $n)->new(1)->blsft($exp,$base);
### pow: "$pow"
### pow: ref $pow
exit 0;
}
{
# log()
my $n = Math::BigInt::Lite->new(1);
my $exp = log($n);
### n: "$n"
### exp: "$exp"
my $div = log(3);
$exp /= $div;
### exp: "$exp"
exit 0;
}
{
# sprintf about 2x faster
my $start = 0xFFFFFFF;
my $end = $start + 0x10000;
{
my $t = Devel::TimeThis->new('sprintf');
foreach ($start .. $end) {
my $n = $_;
my @array = reverse split //, sprintf('%b',$n);
}
}
{
my $t = Devel::TimeThis->new('division');
foreach ($start .. $end) {
my $n = $_;
my @ret;
do {
my $digit = $n % 2;
push @ret, $digit;
$n = int(($n - $digit) / 2);
} while ($n);
}
}
exit 0;
}
{
{
my $t = Devel::TimeThis->new('main');
foreach (1 .. 10000) {
Math::BigInt::Lite->newXX(123);
}
}
{
my $t = Devel::TimeThis->new('lite');
foreach (1 .. 10000) {
Math::BigInt::Lite->new(123);
}
}
exit 0;
}
Math-PlanePath-122/devel/wythoff-array.pl 0000644 0001750 0001750 00000022302 12240271436 016135 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::WythoffArray;
use lib 't','xt';
# uncomment this to run the ### lines
# use Smart::Comments;
{
# tree A230871
require Math::PlanePath::WythoffArray;
my $wythoff = Math::PlanePath::WythoffArray->new (x_start => 1, y_start => 1);
my @parent = (undef, 0);
my @value = (0, 1);
my @child_left = (1);
my @child_right = (undef);
my $value_seen = '';
{
my @pending = (1);
foreach (0 .. 13) {
my @new_pending;
while (@pending) {
my $i = shift @pending;
my $value = $value[$i] // die "oops no value at $i";
if ($value < 20000) { vec($value_seen,$value,1) = 1; }
my $parent_i = $parent[$i];
my $parent_value = $value[$parent_i];
{
my $left_value = $value + $parent_value;
my $left_i = scalar(@value);
$value[$left_i] = $left_value;
$parent[$left_i] = $i;
$child_left[$i] = $left_i;
push @new_pending, $left_i;
}
{
my $right_value = 3*$value - $parent_value;
my $right_i = scalar(@value);
$value[$right_i] = $right_value;
$parent[$right_i] = $i;
$child_right[$i] = $right_i;
push @new_pending, $right_i;
}
}
@pending = @new_pending;
}
}
print "total nodes ",scalar(@value),"\n";
my @rows;
{
# by rows
my @pending = (0);
while (@pending) {
my @new_pending;
my @row;
while (@pending) {
my $i = shift @pending;
if (defined $child_left[$i]) {
push @new_pending, $child_left[$i];
}
if (defined $child_right[$i]) {
push @new_pending, $child_right[$i];
}
my $value = $value[$i];
push @row, $value;
if (@row < 20) {
printf '%4d,', $value;
}
}
print "\n";
@pending = @new_pending;
push @rows, \@row;
}
}
# print columns
{
foreach my $c (0 .. 20) {
print "col c=$c: ";
foreach my $r (0 .. 20) {
if (defined (my $value = $rows[$r]->[$c])) {
print "$value,";
}
}
print "\n";
}
}
my @wythoff_row;
my @wythoff_step;
my @triangle;
{
# wythoff row
my $r = 0;
my $c = 0;
my %seen;
my $print_c_limit = 300;
for (;;) {
my $v1 = $rows[$r]->[$c];
if (! defined $v1) {
$r++;
if ($c < $print_c_limit) {
print "next row\n";
}
next;
}
my $v2 = $rows[$r+1]->[$c];
if (! defined $v2) {
last;
}
if ($v1 <= $v2) {
print "smaller v1: $v1 $v2\n";
}
$triangle[$v1][$v2] = 1;
my ($x,$y,$step) = pair_to_wythoff_xy($v1,$v2);
$x //= '[undef]';
$y //= '[undef]';
my $wv1 = $wythoff->xy_to_n($x,$y);
my $wv2 = $wythoff->xy_to_n($x+1,$y);
if ($c < $print_c_limit) {
print "$c $v1,$v2 $x, $y $step is $wv1, $wv2\n";
}
if ($c < 40) {
push @wythoff_row, $y;
push @wythoff_step, $step;
}
if (defined $seen{$y}) {
print "seen $y at $seen{$y}\n";
}
$seen{$y} = $c;
$c++;
}
print "stop at column $c\n";
print "\n";
}
{
# print triangle
foreach my $v1 (reverse 0 .. 80) {
foreach my $v2 (0 .. 80) {
print $triangle[$v1][$v2] ? '*' : ' ';
}
print "\n";
}
}
@wythoff_row = sort {$a<=>$b} @wythoff_row;
foreach (1, 2) {
print join(',',@wythoff_row),"\n";
{
require Math::NumSeq::Fibbinary;
my $fib = Math::NumSeq::Fibbinary->new;
print join(',',map{sprintf '%b',$fib->ith($_)} @wythoff_row),"\n";
}
foreach (@wythoff_row) { $_-- }
print "\n";
}
print "step: ",join(',',@wythoff_step),"\n";
require MyOEIS;
MyOEIS::compare_values
(anum => 'A230872',
name => 'tree all values occurring',
max_count => 700,
func => sub {
my ($count) = @_;
my @got = (0);
for (my $i = 0; @got < $count; $i++) {
if (vec($value_seen,$i,1)) {
push @got, $i;
}
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A230871',
name => 'tree table',
func => sub {
my ($count) = @_;
my @got;
my $r = 0;
my $c = 0;
while (@got < $count) {
my $row = $rows[$r] // last;
if ($c > $#$row) {
$r++;
$c = 0;
next;
}
push @got, $row->[$c];
$c++;
}
return \@got;
});
exit 0;
sub pair_to_wythoff_xy {
my ($v1,$v2) = @_;
foreach my $step (0 .. 500) {
# use Smart::Comments;
### at: "seek $v1, $v2 step $_"
if (my ($x,$y) = $wythoff->n_to_xy($v1)) {
my $wv2 = $wythoff->xy_to_n($x+1,$y);
if (defined $wv2 && $wv2 == $v2) {
### found: "pair $v1 $v2 at x=$x y=$x"
return ($x,$y,$step);
}
}
($v1,$v2) = ($v2,$v1+$v2);
}
}
}
{
# left-justified shift amount
require Math::NumSeq::Fibbinary;
my $fib = Math::NumSeq::Fibbinary->new;
my $path = Math::PlanePath::WythoffArray->new;
foreach my $y (0 .. 50) {
my $a = $path->xy_to_n(0,$y);
my $b = $path->xy_to_n(1,$y);
my $count = 0;
while ($a < $b) {
($a,$b) = ($b-$a,$a);
$count++;
}
my $y_fib = sprintf '%b',$fib->ith($y);
print "$y $y_fib $count\n";
# $count = ($count+1)/2;
# print "$count,";
}
exit 0;
}
{
# Y*phi
use constant PHI => (1 + sqrt(5)) / 2;
my $path = Math::PlanePath::WythoffArray->new (y_start => 0);
foreach my $y ($path->y_minimum .. 20) {
my $n = $path->xy_to_n(0,$y);
my $prod = int(PHI*PHI*$y + PHI);
print "$y $n $prod\n";
}
exit 0;
}
{
# dual
require Math::NumSeq::Fibbinary;
my $seq = Math::NumSeq::Fibbinary->new;
foreach my $value
(
1 .. 300,
1,
# # 1,10
# 4, 6, 10, 16, 26, 42, 68, 110, 178, 288, 466 # 101,1001
# 7, 11, 18, 29, 47, 76, 123, 199, 322, 521, 843 # 1010,10100
# 9, 14, 23, 37, 60, 97, 157, 254, 411, 665, 1076, # 10001,100001
# 12, 19, 31, 50, 81, 131, 212, 343, 555, 898, 1453 # 10101,101001
) {
my $z = $seq->ith($value);
printf "%3d %6b\n", $value, $z;
}
exit 0;
}
{
# Fibbinary with even trailing 0s
require Math::NumSeq::Fibbinary;
require Math::NumSeq::DigitCountLow;
my $seq = Math::NumSeq::Fibbinary->new;
my $cnt = Math::NumSeq::DigitCountLow->new (radix => 2, digit => 0);
my $e = 0;
foreach (1 .. 40) {
my ($i, $value) = $seq->next;
my $c = $cnt->ith($value);
my $str = ($c % 2 ? 'odd' : 'even');
my $ez = $seq->ith($e);
if ($c % 2 == 0) {
printf "%2d %6b %s [%d] %5b\n", $i, $value, $str, $c, $ez;
} else {
printf "%2d %6b %s [%d]\n", $i, $value, $str, $c;
}
if ($c % 2 == 0) {
$e++;
}
}
exit 0;
}
{
require Math::BaseCnv;
require Math::PlanePath::PowerArray;
my $path;
my $radix = 3;
my $width = 9;
$path = Math::PlanePath::PowerArray->new (radix => $radix);
foreach my $y (reverse 0 .. 6) {
foreach my $x (0 .. 5) {
my $n = $path->xy_to_n($x,$y);
my $nb = sprintf '%*s', $width, Math::BaseCnv::cnv($n,10,$radix);
print $nb;
}
print "\n";
}
exit 0;
}
{
# max Dir4
require Math::BaseCnv;
print 4-atan2(2,1)/atan2(1,1)/2,"\n";
require Math::NumSeq::PlanePathDelta;
my $realpart = 3;
my $radix = $realpart*$realpart + 1;
my $planepath = "WythoffArray";
$planepath = "GcdRationals,pairs_order=rows_reverse";
my $seq = Math::NumSeq::PlanePathDelta->new (planepath => $planepath,
delta_type => 'Dir4');
my $dx_seq = Math::NumSeq::PlanePathDelta->new (planepath => $planepath,
delta_type => 'dX');
my $dy_seq = Math::NumSeq::PlanePathDelta->new (planepath => $planepath,
delta_type => 'dY');
my $max = -99;
for (1 .. 1000000) {
my ($i, $value) = $seq->next;
$value = -$value;
if ($value > $max) {
my $dx = $dx_seq->ith($i);
my $dy = $dy_seq->ith($i);
my $ri = Math::BaseCnv::cnv($i,10,$radix);
my $rdx = Math::BaseCnv::cnv($dx,10,$radix);
my $rdy = Math::BaseCnv::cnv($dy,10,$radix);
my $f = $dy && $dx/$dy;
printf "%d %s %.5f %s %s %.3f\n", $i, $ri, $value, $rdx,$rdy, $f;
$max = $value;
}
}
exit 0;
}
Math-PlanePath-122/devel/filled-rings.pl 0000644 0001750 0001750 00000002636 11720341360 015716 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use Math::PlanePath::FilledRings;
# uncomment this to run the ### lines
use Smart::Comments;
{
# average diff step
my $path = Math::PlanePath::FilledRings->new;
my $prev_n = $path->xy_to_n(0,0);
my $prev_loop = $path->xy_to_n(0,0);
my $diff_total = 0;
my $diff_count = 0;
foreach my $x (1 .. 500) {
my $n = $path->xy_to_n($x,0);
my $loop = $n - $prev_n;
my $diff = $loop - $prev_loop;
#printf "%2d %3d %3d %3d\n", $x, $n, $loop, $diff;
$prev_n = $n;
$prev_loop = $loop;
$diff_total += $diff;
$diff_count++;
}
my $avg = $diff_total/$diff_count;
my $sqavg = $avg*$avg;
print "diff average $avg squared $sqavg\n";
exit 0;
}
Math-PlanePath-122/devel/vertical.pl 0000644 0001750 0001750 00000005141 11520123441 015136 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use warnings;
use POSIX 'fmod';
use Math::BigRat;
use Math::Prime::XS;
#use Smart::Comments;
use constant PHI => (1 + sqrt(5)) / 2;
# (3n-1)*n/2 pentagonal
# (3n+1)*n/2 second pentagonal
# http://www.research.att.com/~njas/sequences/A005449
# sum of n consecutive numbers >= n (n+1)+(n+2)+...+(n+n)
# triangular+square (n+1)*n/2 + n*n
# (3n+1)*n/2-2 = offset (3n+7)*n/2
# http://www.research.att.com/~njas/sequences/A140090
# sum n+1 to n+n-3 or some such
# (3n+1)*n/2
# (3n+1)*n/2 - 1
# (3n+1)*n/2 - 2
sub three {
my ($i) = @_;
return (3*$i+1)*$i/2 - 2;
}
sub is_perfect_square {
my ($n) = @_;
$n = sqrt($n);
return ($n == int($n));
}
{
my $prev_k = 0;
foreach my $k (0 .. 1000) {
my $sq = 24*$k+1;
if (is_perfect_square($sq)) {
printf "%4d %+4d %4d %4d\n", $k, $k-$prev_k, $k%24, $sq;
$prev_k = $k;
}
}
exit 0;
}
{
# i==0mod4 or 1mod4 always even
#
foreach my $k (0 .. 100) {
my $i = 4*$k + 2;
my $n = three($i);
my $factors = factorize($n);
printf "%4d %4d %s\n", $i,$n,$factors;
# unless ($factors =~ /\Q*/) {
# die;
# }
}
exit 0;
}
{
local $, = ',';
print map {three($_)} 0..20;
exit 0;
}
{
my $a = Math::BigRat->new('3/2');
my $b = Math::BigRat->new('1/2');
my $c = Math::BigRat->new('-2');
my $x = -$b;
my $sq = ($b*$b-4*$a*$c);
my $y = $sq;
$y->bsqrt;
print "$x $sq $y\n";
my $r1 = ($x + $y)/(2*$a);
my $r2 = ($x - $y)/(2*$a);
print "$r1 $r2\n";
exit 0;
}
{
foreach my $i (5 .. 500) {
my $n = three($i);
if (Math::Prime::XS::is_prime($n)) {
say "$i $n";
last;
}
}
exit 0;
}
sub factorize {
my ($n) = @_;
my @factors;
foreach my $f (2 .. int(sqrt($n)+1)) {
while (($n % $f) == 0) {
push @factors, $f;
### $n
$n /= $f;
}
}
if ($n != 1) {
push @factors, $n;
}
return join ('*',@factors);
}
exit 0;
Math-PlanePath-122/devel/cellular-rule-xpm.pl 0000644 0001750 0001750 00000003412 11646222723 016712 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use strict;
use Image::Base::PNGwriter;
use List::Util 'min', 'max';
# uncomment this to run the ### lines
#use Devel::Comments;
my $white = '#FFFFFF';
$white = 'white';
my $class = 'Image::Base::PNGwriter';
$class = 'Image::Xpm';
eval "require $class; 1" or die;
my $rule = 30;
my @table = map {($rule & (1<<$_)) ? 1 : 0} 0 .. 7;
print join(',',@table),"\n";
my $height = 500;
my $width = 2*$height;
my $image = $class->new (-width => $width, -height => $height);
$image->rectangle(0,0,$width-1,$height-1, 'black', 1);
# $image->xy($size-2,0,$white); # right
$image->xy(int(($width-1)/2),0,$white); # centre
foreach my $y (1..$height-1) {
foreach my $x (0 .. $width-1) {
my $p = 0;
foreach my $o (-1,0,1) {
$p *= 2;
### x: $x+$o
### y: $y-1
### cell: $image->xy($x+$o,$y-1)
### cell: $image->xy($x+$o,$y-1) eq $white
$p += ($image->xy(min(max($x+$o,0),$width-1),$y-1) eq $white);
}
### $p
if ($table[$p]) {
$image->xy($x,$y,'white');
}
}
}
$image->save('/tmp/x');
system ('xzgv /tmp/x');
exit 0;
# vec()
Math-PlanePath-122/devel/lib/ 0002755 0001750 0001750 00000000000 12641645162 013555 5 ustar gg gg Math-PlanePath-122/devel/lib/Math/ 0002755 0001750 0001750 00000000000 12641645162 014446 5 ustar gg gg Math-PlanePath-122/devel/lib/Math/SquareRadical.pm 0000644 0001750 0001750 00000011440 12606435146 017522 0 ustar gg gg # Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::SquareRadical;
use 5.004;
use strict;
use Carp 'croak';
use Scalar::Util 'blessed';
use vars '$VERSION', '@ISA';
$VERSION = 122;
# uncomment this to run the ### lines
use Smart::Comments;
use overload
'""' => \&stringize;
'0+' => \&numize;
'bool' => \&bool;
# '<=>' => \&spaceship;
'neg' => \&neg;
'+' => \&add,
'-' => \&sub,
'*' => \&mul,
fallback => 1;
sub new {
my ($class, $int, $factor, $root) = @_;
$factor ||= 0;
$root ||= 0;
unless ($root >= 0) {
croak "Negative root for SquareRadical";
}
return bless [ $int, $factor, $root ], $class;
}
sub bool {
my ($self) = @_;
### bool(): @$self
return $self->[0] || $self->[1];
}
sub numize {
my ($self) = @_;
### numize(): @$self
return ($self->[0] + $self->[1]*sqrt($self->[2])) + 0;
}
sub stringize {
my ($self) = @_;
### stringize(): @$self
my $factor = $self->[1];
if ($factor == 0) {
return "$self->[0]";
} else {
return "$self->[0]".($factor >= 0 ? '+' : '').$factor."*sqrt($self->[2])";
}
}
# a+b*sqrt(c) <=> d
# b*sqrt(c) <=> d-a
# b^2*c <=> (d-a)^2 # if both same sign
#
# a+b*sqrt(c) <=> d+e*sqrt(f)
# (a-d)+b*sqrt(c) <=> e*sqrt(f)
# (a-d)^2 + 2*(a-d)*b*sqrt(c) + b^2*c <=> e^2*f
# 2*(a-d)*b*sqrt(c) <=> e^2*f - b^2*c - (a-d)^2
# 4*(a-d)^2*b^2*c <=> (e^2*f - b^2*c - (a-d)^2)^2
#
sub spaceship {
my ($self, $other) = @_;
### spaceship() ...
if (blessed($other) && $other->isa('Math::SquareRadical')) {
if ($self->[1] != $other->[1]) {
croak "Different roots";
}
return bless [ $self->[0] + $other->[0],
$self->[1] + $other->[1] ];
} else {
my $factor = $self->[1];
my $rhs = ($other - $self->[0]);
return (($rhs < 0) <=> ($factor < 0)
|| (($factor*$factor*$self->[2] <=> $rhs*$rhs)
* ($rhs < 0 ? -1 : 1)));
}
}
sub neg {
my ($self) = @_;
### neg(): @$self
return $self->new(- $self->[0],
- $self->[1],
$self->[2]);
}
# c = g^2*f
# a+b*sqrt(c) + d+e*sqrt(f)
# = a+d + b*g*sqrt(f) + e*sqrt(f)
# = (a+d) + (b*g + e)*sqrt(f)
#
sub add {
my ($self, $other) = @_;
### add(): @$self
if (blessed($other) && $other->isa('Math::SquareRadical')) {
my $root1 = $self->[2];
my $root2 = $other->[2];
if ($root1 % $root2 == 0) {
$self->new($self->[0] + $other->[0],
($root1/$root2)*$self->[1] + $other->[1],
$root2);
} elsif ($root1 % $root2 == 0) {
$self->new($self->[0] + $other->[0],
($root1/$root2)*$self->[1] + $other->[1],
$root2);
} else {
croak "Different roots";
}
} else {
return $self->new($self->[0] + $other, $self->[1], $self->[2]);
}
}
# sub sub {
# my ($self, $other, $swap) = @_;
# my $ret;
# if (blessed($other) && $other->isa('Math::SquareRadical')) {
# if ($self->[1] != $other->[1]) {
# croak "Different roots";
# }
# $ret = bless [ $self->[0] - $other->[0],
# $self->[1] - $other->[1] ];
# } else {
# $ret = bless [ $self->[0] - $other, $self->[1] ];
# }
# if ($swap) {
# $ret->[0] = - $ret->[0];
# $ret->[1] = - $ret->[1];
# }
# return $ret;
# }
# (a + b*sqrt(c))*(d + e*sqrt(f))
# = a*d + b*d*sqrt(c) + a*e*sqrt(f) + b*e*sqrt(c*f)
# if c=g^2*f
# = a*d + b*d*g*sqrt(f) + a*e*sqrt(f) + b*e*g*f
sub mul {
my ($self, $other) = @_;
### mul(): @$self
if (blessed($other) && $other->isa('Math::SquareRadical')) {
my $root1 = $self->[2];
my $root2 = $other->[2];
if ($root1 % $root2 == 0) {
my $g2 = $root1/$root2;
my $g = sqrt($g2);
if ($g*$g == $g2) {
$self->new($self->[0] + $other->[0],
$g*$self->[1] + $other->[1],
$root2);
}
} elsif ($root2 % $root1 == 0) {
my $g2 = $root2/$root1;
my $g = sqrt($g2);
if ($g*$g == $g2) {
$self->new($self->[0] + $other->[0],
$self->[1] + $g*$other->[1],
$root1);
}
} else {
croak "Different roots";
}
} else {
return $self->new($self->[0] * $other, $self->[1] * $other, $self->[2]);
}
}
Math-PlanePath-122/devel/lib/Math/PlanePath/ 0002755 0001750 0001750 00000000000 12641645163 016323 5 ustar gg gg Math-PlanePath-122/devel/lib/Math/PlanePath/R7DragonCurve.pm 0000644 0001750 0001750 00000016345 12606435145 021316 0 ustar gg gg # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# math-image --path=R7DragonCurve --all --scale=10
# cf A176405 R7 turns
# A176416 R7B turns
package Math::PlanePath::R7DragonCurve;
use 5.004;
use strict;
use List::Util 'min'; # 'max'
*max = \&Math::PlanePath::_max;
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest',
'xy_is_even';
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh';
use vars '$VERSION', '@ISA';
$VERSION = 122;
@ISA = ('Math::PlanePath');
# uncomment this to run the ### lines
#use Smart::Comments;
use constant n_start => 0;
use constant parameter_info_array =>
[ { name => 'type',
share_key => 'type_r7dragon',
display => 'Type',
type => 'enum',
default => 'A',
choices => ['A','B'],
},
{ name => 'arms',
share_key => 'arms_6',
display => 'Arms',
type => 'integer',
minimum => 1,
maximum => 6,
default => 1,
width => 1,
description => 'Arms',
} ];
use constant dx_minimum => -2;
use constant dx_maximum => 2;
use constant dy_minimum => -1;
use constant dy_maximum => 1;
#------------------------------------------------------------------------------
sub new {
my $self = shift->SUPER::new(@_);
$self->{'arms'} = max(1, min(6, $self->{'arms'} || 1));
$self->{'type'} ||= 'A';
return $self;
}
my @dir6_to_si = (1,0,0, -1,0,0);
my @dir6_to_sj = (0,1,0, 0,-1,0);
my @dir6_to_sk = (0,0,1, 0,0,-1);
# F0F1F1F0F0F1F, 0->0, 1->1
#
# 14 12
# \ / \
# \/ \
# 13,10--11,8
# \ / \
# 9/ \
# 2----3,6----7 i=+2,j=+1
# \ / \
# \ / \
# 0----1,4----5
#
# 0 1 2 3 4 5
# B 5----6,3----7 i=+2,j=+1
# \ / \
# \ / \
# 0----1,4----2
#
# 0 1 2 3 4 5
my @digit_to_i = (0,1,0,1,1,2,1);
my @digit_to_j = (0,0,1,1,0,0,1);
my @digit_to_rot = (0,1,0,-1,0,1,0);
# 0 1 2 3 4 5 6
my @digit_b_to_a = (0,4,5,3,1,2,6);
sub n_to_xy {
my ($self, $n) = @_;
### R7DragonCurve n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n, $n); }
my $zero = ($n * 0); # inherit bignum 0
my $i = 0;
my $j = 0;
my $k = 0;
my $si = $zero;
my $sj = $zero;
my $sk = $zero;
# initial rotation from arm number
{
my $int = int($n);
my $frac = $n - $int; # inherit possible BigFloat
$n = $int; # BigFloat int() gives BigInt, use that
my $rot = _divrem_mutate ($n, $self->{'arms'});
my $s = $zero + 1; # inherit bignum 1
if ($rot >= 3) {
$s = -$s; # rotate 180
$frac = -$frac;
$rot -= 3;
}
if ($rot == 0) { $i = $frac; $si = $s; } # rotate 0
elsif ($rot == 1) { $j = $frac; $sj = $s; } # rotate +60
else { $k = $frac; $sk = $s; } # rotate +120
}
foreach my $digit (digit_split_lowtohigh($n,7)) {
### at: "$i,$j,$k side $si,$sj,$sk"
### $digit
if ($self->{'type'} eq 'B') {
$digit = $digit_b_to_a[$digit];
}
if ($digit == 1) {
($i,$j,$k) = (-$j,-$k,$i); # rotate +120
$i += $si;
$j += $sj;
$k += $sk;
} elsif ($digit == 2) {
$i -= $sk;
$j += $si;
$k += $sj;
} elsif ($digit == 3) {
($i,$j,$k) = ($k,-$i,-$j);
$i += $si;
$j += $sj;
$k += $sk;
$i -= $sk;
$j += $si;
$k += $sj;
} elsif ($digit == 4) {
$i += $si;
$j += $sj;
$k += $sk;
} elsif ($digit == 5) {
($i,$j,$k) = (-$j,-$k,$i); # rotate +120
$i += 2*$si;
$j += 2*$sj;
$k += 2*$sk;
} elsif ($digit == 6) {
$i += $si;
$j += $sj;
$k += $sk;
$i -= $sk;
$j += $si;
$k += $sj;
}
# $i += $digit_to_i[$digit];
# $j += $digit_to_j[$digit];
# multiple 2i+j
($si,$sj,$sk) = (2*$si - $sk,
2*$sj + $si,
2*$sk + $sj);
}
### final: "$i,$j,$k side $si,$sj,$sk"
### is: (2*$i + $j - $k).",".($j+$k)
return (2*$i + $j - $k, $j+$k);
}
# all even points when arms==6
sub xy_is_visited {
my ($self, $x, $y) = @_;
# FIXME
return 0;
if ($self->{'arms'} == 6) {
return xy_is_even($self,$x,$y);
} else {
return defined($self->xy_to_n($x,$y));
}
}
# maximum extent -- no, not quite right
#
# .----*
# \
# *----.
#
# Two triangle heights, so
# rnext = 2 * r * sqrt(3)/2
# = r * sqrt(3)
# rsquared_next = 3 * rsquared
# Initial X=2,Y=0 is rsquared=4
# then X=3,Y=1 is 3*3+3*1*1 = 9+3 = 12 = 4*3
# then X=3,Y=3 is 3*3+3*3*3 = 9+3 = 36 = 4*3^2
#
my @try_dx = (2, 1, -1, -2, -1, 1);
my @try_dy = (0, 1, 1, 0, -1, -1);
sub xy_to_n {
return scalar((shift->xy_to_n_list(@_))[0]);
}
sub xy_to_n_list {
my ($self, $x, $y) = @_;
### R7DragonCurve xy_to_n_list(): "$x, $y"
# FIXME
return;
$x = round_nearest($x);
$y = round_nearest($y);
if (is_infinite($x)) {
return $x; # infinity
}
if (is_infinite($y)) {
return $y; # infinity
}
my @n_list;
my $xm = 2*$x; # doubled out
my $ym = 2*$y;
foreach my $i (0 .. $#try_dx) {
my $t = $self->Math::PlanePath::R7DragonMidpoint::xy_to_n
($xm+$try_dx[$i], $ym+$try_dy[$i]);
### try: ($xm+$try_dx[$i]).",".($ym+$try_dy[$i])
### $t
next unless defined $t;
my ($tx,$ty) = n_to_xy($self,$t) # not a method for R7DragonRounded
or next;
if ($tx == $x && $ty == $y) {
### found: $t
if (@n_list && $t < $n_list[0]) {
unshift @n_list, $t;
} elsif (@n_list && $t < $n_list[-1]) {
splice @n_list, -1,0, $t;
} else {
push @n_list, $t;
}
if (@n_list == 3) {
return @n_list;
}
}
}
return @n_list;
}
# minimum -- no, not quite right
#
# *----------*
# \
# \ *
# * \
# \
# *----------*
#
# width = side/2
# minimum = side*sqrt(3)/2 - width
# = side*(sqrt(3)/2 - 1)
#
# minimum 4/9 * 2.9^level roughly
# h = 4/9 * 2.9^level
# 2.9^level = h*9/4
# level = log(h*9/4)/log(2.9)
# 3^level = 3^(log(h*9/4)/log(2.9))
# = h*9/4, but big bigger for log
#
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### R7DragonCurve rect_to_n_range(): "$x1,$y1 $x2,$y2"
my $xmax = int(max(abs($x1),abs($x2)));
my $ymax = int(max(abs($y1),abs($y2)));
return (0,
($xmax*$xmax + 3*$ymax*$ymax + 1)
* 1/5
* $self->{'arms'});
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/FourReplicate.pm 0000644 0001750 0001750 00000006455 12606435145 021433 0 ustar gg gg # Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Working. But what is this properly called?
# strips N mod 3 (X-Y)/2 == N mod 3
package Math::PlanePath::FourReplicate;
use 5.004;
use strict;
#use List::Util 'max';
*max = \&Math::PlanePath::_max;
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest',
'xy_is_even';
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh',
'digit_join_lowtohigh';
use vars '$VERSION', '@ISA';
$VERSION = 122;
@ISA = ('Math::PlanePath');
# uncomment this to run the ### lines
# use Smart::Comments;
use constant n_start => 0;
#------------------------------------------------------------------------------
my @digit_to_x = (0,2,-1,-1);
my @digit_to_y = (0,0, 1,-1);
sub n_to_xy {
my ($self, $n) = @_;
### FourReplicate n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n, $n); }
my $zero = ($n * 0); # inherit bignum 0
my $x = my $y = $zero;
my $len = $zero + 1;
foreach my $digit (digit_split_lowtohigh($n,4)) {
$x += $len * $digit_to_x[$digit];
$y += $len * $digit_to_y[$digit];
$len = -2*$len;
}
return ($x, $y);
}
# all even points when arms==6
*xy_is_visited = \&xy_is_even;
# -1,1
# * . * .
# \
# . *-.-* 2,0
# /
# * . * .
# -1,-1
#
# $x % 4
# $y % 4
#
# 3 | 2 3
# 2 | 1 0
# 1 | 3 2
# 0 | 0 1
# +---------------
# 0 1 2 3
my @yx_to_digit = ([ 0, undef, 1, undef ],
[ undef, 3, undef, 2 ],
[ 1, undef, 0, undef ],
[ undef, 2, undef, 3 ]);
sub xy_to_n {
my ($self, $x, $y) = @_;
$x = round_nearest($x);
$y = round_nearest($y);
if (is_infinite($x)) {
return $x; # infinity
}
if (is_infinite($y)) {
return $y; # infinity
}
my $zero = $x*0*$y;
my @ndigits;
while ($x || $y) {
### at: "x=$x y=$y"
my $ndigit = $yx_to_digit[$y%4]->[$x%4];
if (! defined $ndigit) { return undef; }
push @ndigits, $ndigit;
$x -= $digit_to_x[$ndigit];
$y -= $digit_to_y[$ndigit];
### $ndigit
### dxdy: "dx=$digit_to_x[$ndigit] dy=$digit_to_y[$ndigit]"
$x /= -2;
$y /= -2;
}
return digit_join_lowtohigh(\@ndigits,4,$zero);;
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### FourReplicate rect_to_n_range(): "$x1,$y1 $x2,$y2"
my $xmax = int(max(abs($x1),abs($x2)));
my $ymax = int(max(abs($y1),abs($y2)));
return (0, ($xmax*$xmax + 3*$ymax*$ymax + 1) * 32);
return (0, 4**6); # ($xmax*$xmax + 3*$ymax*$ymax + 1));
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/ZeckendorfTerms-oeis.t 0000644 0001750 0001750 00000003142 12132222017 022530 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
use Test;
plan tests => 46;
use lib 't','xt';
use MyTestHelpers;
MyTestHelpers::nowarnings();
use MyOEIS;
use Math::PlanePath::ZeckendorfTerms;
#------------------------------------------------------------------------------
# A134561 by anti-diagonals
MyOEIS::compare_values
(anum => 'A134561',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::ZeckendorfTerms->new;
my $diag = Math::PlanePath::Diagonals->new (direction => 'up',
x_start=>1,y_start=>1);
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
push @got, $path->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/devel/lib/Math/PlanePath/PeanoVertices.pm 0000644 0001750 0001750 00000007333 12606435145 021432 0 ustar gg gg # works, worth having separately ?
# alternating diagonals when even radix ?
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# math-image --path=PeanoVertices --all --output=numbers
# math-image --path=PeanoVertices,radix=5 --lines
#
package Math::PlanePath::PeanoVertices;
use 5.004;
use strict;
#use List::Util 'max';
*max = \&Math::PlanePath::_max;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'round_down_pow',
'digit_split_lowtohigh';
use Math::PlanePath::PeanoCurve;
# uncomment this to run the ### lines
# use Smart::Comments;
use constant n_start => 0;
use constant class_x_negative => 0;
use constant class_y_negative => 1;
use constant parameter_info_array =>
[ { name => 'radix',
share_key => 'radix_3',
display => 'Radix',
type => 'integer',
minimum => 2,
default => 3,
width => 3,
} ];
sub new {
my $self = shift->SUPER::new(@_);
$self->{'radix'} ||= 3;
$self->{'peano'} = Math::PlanePath::PeanoCurve->new (radix => $self->{'radix'});
return $self;
}
sub n_to_xy {
my ($self, $n) = @_;
### PeanoVertices n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n,$n); }
{
# ENHANCE-ME: for odd radix the ends join and the direction can be had
# without a full N+1 calculation
my $int = int($n);
### $int
### $n
if ($n != $int) {
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $frac = $n - $int; # inherit possible BigFloat
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int; # BigFloat int() gives BigInt, use that
}
my ($x,$y) = $self->{'peano'}->n_to_xy($n)
or return;
if ($x % 2) {
if ($y % 2) {
$x += 1;
$y += 1;
} else {
$x -= 0;
$y += 1;
}
} else {
if ($y % 2) {
$x += 1;
$y -= 0;
} else {
$x -= 0;
$y -= 0;
}
}
($x,$y) = (($y+$x)/2, ($y-$x)/2);
return ($x, $y);
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### PeanoVertices xy_to_n(): "$x, $y"
return undef;
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 0 || $y < 0) {
return undef;
}
if (is_infinite($x)) {
return $x;
}
if (is_infinite($y)) {
return $y;
}
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
return (0, 1000);
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
### rect_to_n_range(): "$x1,$y1 to $x2,$y2"
if ($x2 < 0 || $y2 < 0) {
return (1, 0);
}
my $radix = $self->{'radix'};
my ($power, $level) = round_down_pow (max($x2,$y2)*$radix/2, $radix);
if (is_infinite($level)) {
return (0, $level);
}
return (0, 2*$power*$power - 1);
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/four-replicate.pl 0000644 0001750 0001750 00000003604 12165124417 021575 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::FourReplicate;
# uncomment this to run the ### lines
#use Smart::Comments;
{
require Math::BaseCnv;
my $path = Math::PlanePath::FourReplicate->new;
foreach my $n (0 .. 2**30) {
my ($x,$y) = $path->n_to_xy($n);
my ($n_lo,$n_hi) = $path->rect_to_n_range(0,0,$x,$y);
if ($n_hi < $n) {
my $n4 = Math::BaseCnv::cnv($n,10,4);
my $n_hi4 = Math::BaseCnv::cnv($n_hi,10,4);
print "n=$n4 outside n_hi=$n_hi4\n";
}
}
exit 0;
}
{
require Math::PlanePath::FourReplicate;
my $path = Math::PlanePath::FourReplicate->new;
my @table;
my $xmod = 4;
my $ymod = 4;
foreach my $n (0 .. 2**8) {
my ($x,$y) = $path->n_to_xy($n);
my $mx = $x % $xmod;
my $my = $y % $ymod;
my $href = ($table[$mx][$my] ||= {});
$href->{$n%4} = 1;
}
my $width = 3;
foreach my $my (reverse 0 .. $ymod-1) {
printf "%2d", $my;
foreach my $mx (0 .. $xmod-1) {
my $href = ($table[$mx][$my] ||= {});
my $str = join(',', keys %$href);
printf " %*s", $width, $str;
}
print "\n";
}
print "\n ";
foreach my $mx (0 .. $xmod-1) {
printf " %*s", $width, $mx;
}
print "\n";
exit 0;
}
Math-PlanePath-122/devel/lib/Math/PlanePath/NxNinv.pm 0000644 0001750 0001750 00000006167 12606435145 020107 0 ustar gg gg # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# A072732
# A072733 inverse
# A072736 X coord
# A072737 Y coord
#
# A072734
# A072740 X coord
# A072741 Y coord
package Math::PlanePath::NxNinv;
use 5.004;
use strict;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
#use Smart::Comments;
use constant n_start => 0;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
sub n_to_xy {
my ($self, $n) = @_;
### NxN n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
# d = [ 0, 1, 2, 3, 4 ]
# n = [ 0, 1, 3, 6, 10 ]
# N = (d+1)*d/2
# d = (-1 + sqrt(8*$n+1))/2
#
my $d = int((sqrt(8*$n+1) - 1) / 2);
$n -= $d*($d+1)/2;
### $d
### $n
my $x = $d-$n; # downwards
my $y = $n; # upwards
my $diff = $x-$y;
### diagonals xy: "$x, $y diff=$diff"
if ($x <= $y) {
my $h = int($x/2);
return ($h,
$h + ($x%2) + 2*($y - 2*$h - ($x%2)));
} else {
my $h = int($y/2);
return (1 + $h + ($y%2) + 2*($x-1 - 2*$h - ($y%2)),
$h);
}
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### NxN xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 0 || $y < 0) {
return undef;
}
my $diff = $x-$y;
if ($diff <= 0) {
($x,$y) = (2*$x + ($diff % 2),
2*$x + int((1-$diff)/2));
} else {
### pos diff, use y ...
($x,$y) = (2*($y+1) - 1 + int($diff/2),
2*$y + (($diff+1) % 2));
}
return (($x+$y)**2 + $x+3*$y)/2;
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### NxN rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 0 || $y2 < 0) {
### all outside first quadrant ...
return (1, 0);
}
return (0, $self->xy_to_n($x2,0));
return (0, $self->xy_to_n($x2,$y2));
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/WythoffDifference.pm 0000644 0001750 0001750 00000011163 12606435145 022260 0 ustar gg gg # Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::PlanePath::WythoffDifference;
use 5.004;
use strict;
use List::Util 'max';
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
# use Smart::Comments;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant xy_is_visited => 1;
use Math::PlanePath::WythoffArray;
my $wythoff = Math::PlanePath::WythoffArray->new;
sub n_to_xy {
my ($self, $n) = @_;
### WythoffDifference n_to_xy(): $n
if ($n < 1) { return; }
if (is_infinite($n) || $n == 0) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
# f1+f0 > i
# f0 > i-f1
# check i-f1 as the stopping point, so that if i=UV_MAX then won't
# overflow a UV trying to get to f1>=i
#
my @fibs;
{
my $f0 = ($n * 0); # inherit bignum 0
my $f1 = $f0 + 1; # inherit bignum 1
while ($f0 <= $n-$f1) {
($f1,$f0) = ($f1+$f0,$f1);
push @fibs, $f1; # starting $fibs[0]=1
}
}
### @fibs
my $orig_n = $n;
# indices into fib[] which are the Fibonaccis adding up to $n
my @indices;
for (my $i = $#fibs; $i >= 0; $i--) {
### at: "n=$n f=".$fibs[$i]
if ($n >= $fibs[$i]) {
push @indices, $i;
$n -= $fibs[$i];
### sub: "$fibs[$i] to n=$n"
--$i;
}
}
### @indices
my $y = 0;
my $shift;
my $x;
my $low = $indices[-1];
if ($low % 2) {
# odd trailing zeros
$x = ($low+1)/2;
$shift = $low + 2;
pop @indices;
} else {
# even trailing zeros
$x = 0;
$shift = 1;
if ($low == 0) {
pop @indices;
} else {
$y = -1;
}
}
foreach my $i (@indices) {
### y add: "ishift=".($i-$shift)." fib=".$fibs[$i-$shift]
$y += $fibs[$i-$shift];
}
### $y
return ($x, $y);
}
# 6 | 11 28 73 191 500
# 5 | 9 23 60 157 411
# 4 | 8 20 52 136 356
# 3 | 6 15 39 102 267
# 2 | 4 10 26 68 178
# 1 | 3 7 18 47 123
# 0 | 1 2 5 13 34
# +-------------------
# 0 1 2 3 4
# 9 | 100100 10001010 1000101000 100010100000 10001010000000
# 8 | 100001 10000010 1000001000 100000100000 10000010000000
# 7 | 10101 1010010 101001000 10100100000 1010010000000
# 6 | 10100 1001010 100101000 10010100000 1001010000000
# 5 | 10001 1000010 100001000 10000100000 1000010000000
# 4 | 10000 101010 10101000 1010100000 101010000000
# 3 | 1001 100010 10001000 1000100000 100010000000
# 2 | 101 10010 1001000 100100000 10010000000
# 1 | 100 1010 101000 10100000 1010000000
# 0 | 1 10 1000 100000 10000000
# +--------------------------------------------------------
# 0 1 2 3 4
sub xy_to_n {
my ($self, $x, $y) = @_;
$x = round_nearest ($x);
if ($x == 0) {
my $n1 = $wythoff->xy_to_n(1,$y);
if ($n1) {
$n1 -= $wythoff->xy_to_n(0,$y);
}
return $n1;
}
return $wythoff->xy_to_n(2*$x-1,$y);
}
# exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### WythoffDifference rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 0 || $y2 < 0) {
### all outside first quadrant ...
return (1, 0);
}
# bottom left into first quadrant
if ($x1 < 0) { $x1 *= 0; }
if ($y1 < 0) { $y1 *= 0; }
return ($self->xy_to_n($x1,$y1), # bottom left
$self->xy_to_n($x2,$y2)); # top right
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/squares-dispersion.pl 0000644 0001750 0001750 00000005656 11770201234 022517 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::NumSeq::Squares;
# uncomment this to run the ### lines
#use Smart::Comments;
# diagonals slope=2
# Classic Sequences
# http://oeis.org/classic.html
#
# A082156
# 1 4 9 16 25 d^2
# +3 +5 +7 +9
#
# 2 6 12 20 30 (d^2 + 3 d + 2)
# +4 +6 +8 +10
#
# 3 8 15 24 35 (d^2 + 4 d + 3)
# +5 +7 +9 +11
#
# 5 11 19 29 41 (d^2 + 5 d + 5)
# +6 +8 +10 +12
#
# 7 14 23 34 47 (d^2 + 6 d + 7)
# +7 +9 +11 +13
{
# rows
my @non_squares = (0);
foreach my $n (0 .. 100) {
push @non_squares, $n if ! is_square($n);
}
print join(',',@non_squares),"\n";
# 1 4 9 16 25 36 49 64 81 100 121 144
# 2 6 12 20 30 42 56 72 90 110 132
# 3 8 15 24 35 48 63 80 99 120
# 5 11 19 29 41 55 71 89 109
# 7 14 23 34 47 62 79
# 10 18 28 40 54 70
# 13 22 33 46 61
# 17 27 39 53
# 21 32 45
# 26 38
# 31
#
# 0 1 2 3 4 5 6 7 8 9 10
my @o = (0, 0, 0, 1, 2, 4, 6, 9, 12, 16, 20);
# +0 +0 +1 +1 +2 +2 +3 +3 +4 +4
# (2x+y+2)(2x+y-2) = 4xx+4xy+yy
# N = (x+1)**2 + (x+1)*y + (y*y - 2*y + odd)/4
# = x^2 + 2x + 1+ xy + y + y^2/4 - y/2 + odd/4
# = x^2 + 2x + 1+ xy + y^2/4 + y/2 + odd/4
# = (4x^2 + 8x + 4+ 4xy + y^2 + 2y + odd)/4
# = (4x^2 + 4xy + 8x + y^2 + 2y + 4 + odd)/4
# = ((2x+y+2)^2 + 2y+odd) / 4
my @seen;
foreach my $y (0 .. 10) {
foreach my $x (0 .. 14) {
my $odd = ($y & 1);
my $o = ($odd
? ($y*$y - 2*$y + 1)/4
: ($y*$y - 2*$y)/4); # even
if ($o != $o[$y]) { die }
#my $o = ($o[$y]||0);
my $n = ($x+1)**2 + ($x+1)*$y + $o;
# my $n = ((2*$x+$y+2)**2 + 2*$y + $odd) / 4;
my $dup = ($seen[$n]++ ? '*' : ' ');
printf ' %3d%s', $n, $dup;
}
print "\n";
}
exit 0;
}
{
# non-squares
my $next_root = 1;
my $next_square = 1;
my $prev = 0;
foreach my $n (1 .. 50) {
my $non = non_square($n);
if ($non != $prev+1) {
print "--\n";
}
my $sq = is_square($non) ? ' ***' : '';
print "$non$sq\n";
$prev = $non;
}
sub non_square {
my ($n) = @_;
return $n + int(sqrt($n))-1;
}
sub is_square {
my ($n) = @_;
return Math::NumSeq::Squares->pred($n);
}
exit 0;
}
Math-PlanePath-122/devel/lib/Math/PlanePath/FibonacciWordKnott.pm 0000644 0001750 0001750 00000023023 12606435145 022406 0 ustar gg gg # Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# http://alexis.monnerot-dumaine.neuf.fr/articles/fibonacci%20fractal.pdf
# [gone]
#
# math-image --path=FibonacciWordKnott --output=numbers_dash
package Math::PlanePath::FibonacciWordKnott;
use 5.004;
use strict;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
#use Smart::Comments;
use Math::PlanePath::FibonacciWordFractal;
use constant n_start => 0;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
my @dir4_to_dx = (0,-1,0,1);
my @dir4_to_dy = (1,0,-1,0);
sub n_to_xy {
my ($self, $n) = @_;
### FibonacciWordKnott n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n, $n); }
# my $frac;
# {
# my $int = int($n);
# $frac = $n - $int; # inherit possible BigFloat
# $n = $int; # BigFloat int() gives BigInt, use that
# }
{
my $int = int($n);
### $int
### $n
if ($n != $int) {
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $frac = $n - $int; # inherit possible BigFloat
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int; # BigFloat int() gives BigInt, use that
}
my $zero = ($n * 0); # inherit bignum 0
my $one = $zero + 1; # inherit bignum 0
my @f = ($one, 2+$zero);
my @xend = ($zero, $zero, $one); # F3 N=2 X=1,Y=1
my @yend = ($zero, $one, $one);
my $level = 2;
while ($f[-1] < $n) {
push @f, $f[-1] + $f[-2];
my ($x,$y);
my $m = ($level % 6);
if ($m == 1) {
$x = $yend[-2]; # -90
$y = - $xend[-2];
} elsif ($m == 2) {
$x = $xend[-2]; # T -90
$y = - $yend[-2];
} elsif ($m == 3) {
$x = $yend[-2]; # T
$y = $xend[-2];
} elsif ($m == 4) {
$x = - $yend[-2]; # +90
$y = $xend[-2];
} elsif ($m == 5) {
$x = - $xend[-2]; # T +90
$y = $yend[-2];
} elsif ($m == 0) {
$x = $yend[-2]; # T
$y = $xend[-2];
}
push @xend, $xend[-1] + $x;
push @yend, $yend[-1] + $y;
### push xy: "levelmod=".($level%6)." add $x,$y for $xend[-1],$yend[-1] for f=$f[-1]"
$level++;
}
my $x = $zero;
my $y = $zero;
my $rot = 0;
my $transpose = 0;
while (@xend > 1) {
### at: "$x,$y rot=$rot transpose=$transpose level=$level n=$n consider f=$f[-1]"
my $xo = pop @xend;
my $yo = pop @yend;
if ($n >= $f[-1]) {
$n -= $f[-1];
### offset: "$xo, $yo for ".($level % 6)
if ($transpose) {
($xo,$yo) = ($yo,$xo);
}
if ($rot & 2) {
$xo = -$xo;
$yo = -$yo;
}
if ($rot & 1) {
($xo,$yo) = (-$yo,$xo);
}
### apply rot to offset: "$xo, $yo"
$x += $xo;
$y += $yo;
my $m = $level % 6;
if ($m == 1) { # F8 N=21 etc
# -90
if ($transpose) {
$rot++;
} else {
$rot--; # -90
}
} elsif ($m == 2) { # F3 N=2 etc
# T -90
if ($transpose) {
$rot++;
} else {
$rot--; # -90
}
$transpose ^= 3;
} elsif ($m == 3) { # F4 N=3 etc
$transpose ^= 3; # T
} elsif ($m == 4) { # F5 N=5 etc
# +90
if ($transpose) {
$rot--;
} else {
$rot++; # +90
}
} elsif ($m == 5) { # F6 N=8 etc
# T +90
if ($transpose) {
$rot--;
} else {
$rot++; # +90
}
$transpose ^= 3;
} else { # ($m == 0) # F7 N=13 etc
$transpose ^= 3; # T
}
}
pop @f;
$level--;
}
# mod 6 twist ?
# ### final rot: "$rot transpose=$transpose gives ".(($rot^$transpose)&3)
# $rot = ($rot ^ $transpose) & 3;
# $x = $frac * $dir4_to_dx[$rot] + $x;
# $y = $frac * $dir4_to_dy[$rot] + $y;
### final with frac: "$x,$y"
return ($x,$y);
}
my $moffset = 1;
#use Smart::Comments;
sub xy_to_n {
my ($self, $x, $y) = @_;
### FibonacciWordKnott xy_to_n(): "$x, $y"
$x = round_nearest($x);
if (is_infinite($x)) {
return $x;
}
$y = round_nearest($y);
if (is_infinite($y)) {
return $y;
}
foreach my $xoffset (1,0,-1) {
foreach my $yoffset (1,0,-1) {
### try: "x=".(2*$y+$yoffset)." y=".(2*$x+$xoffset)
if (defined (my $n = $self->Math::PlanePath::FibonacciWordFractal::xy_to_n(2*$x+$xoffset, 2*$y+$yoffset))) {
### $n
if (my ($nx,$ny) = $self->n_to_xy($n)) {
### rev: "nx=$nx,ny=$ny"
if ($nx == $x && $ny == $y) {
return $n;
}
}
}
}
}
return undef;
no Smart::Comments;
my $zero = ($x * 0 * $y); # inherit bignum 0
my $one = $zero + 1; # inherit bignum 0
my @f = ($one, $zero+2);
my @xend = ($zero, $one); # F3 N=2 X=1,Y=1
my @yend = ($one, $one);
my $level = 3;
for (;;) {
my ($xo,$yo);
my $m = ($level-$moffset) % 6;
### $m
if ($m == 2) {
$xo = $yend[-2]; # T
$yo = $xend[-2];
} elsif ($m == 3) {
$xo = $yend[-2]; # -90
$yo = - $xend[-2];
} elsif ($m == 4) {
$xo = $xend[-2]; # T -90
$yo = - $yend[-2];
} elsif ($m == 5) {
### T
$xo = $yend[-2]; # T
$yo = $xend[-2];
} elsif ($m == 0) {
$xo = - $yend[-2]; # +90
$yo = $xend[-2];
} elsif ($m == 1) {
$xo = - $xend[-2]; # T +90
$yo = $yend[-2];
}
$xo += $xend[-1];
$yo += $yend[-1];
last if ($xo > $x && $yo > $y);
push @f, $f[-1] + $f[-2];
push @xend, $xo;
push @yend, $yo;
$level++;
### new: "level=$level $xend[-1],$yend[-1] for N=$f[-1]"
}
### @xend
### @yend
my $n = 0;
while ($level >= 2) {
### at: "$x,$y n=$n level=$level consider $xend[-1],$yend[-1] for $f[-1]"
if (($level+3-$moffset) % 6 < 3) {
### 3,4,5 X ...
if ($x >= $xend[-1]) {
$n += $f[-1];
$x -= $xend[-1];
$y -= $yend[-1];
### shift to: "$x,$y levelmod ".($level % 6)
if (($level % 6) == 3) { # F3 N=2 etc
($x,$y) = (-$y,$x); # +90
} elsif (($level % 6) == 4) { # F4 N=3 etc
$y = -$y; # +90 T
} elsif (($level % 6) == 5) { # F5 N=5 etc
($x,$y) = ($y,$x); # T
}
### rot to: "$x,$y"
if ($x < 0 || $y < 0) {
return undef;
}
}
} else {
### 0,1,2 Y ...
if ($y >= $yend[-1]) {
$n += $f[-1];
$x -= $xend[-1];
$y -= $yend[-1];
### shift to: "$x,$y levelmod ".($level % 6)
if (($level % 6) == 0) { # F6 N=8 etc
($x,$y) = ($y,-$x); # -90
} elsif (($level % 6) == 1) { # F7 N=13 etc
$x = -$x; # -90 T
} elsif (($level % 6) == 2) { # F8 N=21 etc, incl F2 N=1
($x,$y) = ($y,$x); # T
}
### rot to: "$x,$y"
if ($x < 0 || $y < 0) {
return undef;
}
}
}
pop @f;
pop @xend;
pop @yend;
$level--;
}
if ($x != 0 || $y != 0) {
return undef;
}
return $n;
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### FibonacciWordKnott rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
### rect_to_n_range(): "$x1,$y1 to $x2,$y2"
if ($x2 < 0 || $y2 < 0) {
return (1, 0);
}
foreach ($x1,$x2,$y1,$y2) {
if (is_infinite($_)) { return (0, $_); }
}
my $zero = ($x1 * 0 * $y1 * $x2 * $y2); # inherit bignum 0
my $one = $zero + 1; # inherit bignum 0
my $f0 = 1;
my $f1 = 2;
my $xend0 = $zero;
my $xend1 = $one;
my $yend0 = $one;
my $yend1 = $one;
my $level = 3;
for (;;) {
my ($xo,$yo);
if (($level % 6) == 3) { # at F3 N=2 etc
$xo = $yend0; # -90
$yo = - $xend0;
} elsif (($level % 6) == 4) { # at F4 N=3 etc
$xo = $xend0; # T -90
$yo = - $yend0;
} elsif (($level % 6) == 5) { # at F5 N=5 etc
$xo = $yend0; # T
$yo = $xend0;
} elsif (($level % 6) == 0) { # at F6 N=8 etc
$xo = - $yend0; # +90
$yo = $xend0;
} elsif (($level % 6) == 1) { # at F7 N=13 etc
$xo = - $xend0; # T +90
$yo = $yend0;
} else { # if (($level % 6) == 2) { # at F8 N=21 etc
$xo = $yend0; # T
$yo = $xend0;
}
($f1,$f0) = ($f1+$f0,$f1);
($xend1,$xend0) = ($xend1+$xo,$xend1);
($yend1,$yend0) = ($yend1+$yo,$yend1);
$level++;
### consider: "f1=$f1 xy end $xend1,$yend1"
if ($xend1 > $x2 && $yend1 > $y2) {
return (0, $f1 - 1);
}
}
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/SumFractions.pm 0000644 0001750 0001750 00000007203 12606435145 021274 0 ustar gg gg # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::PlanePath::SumFractions;
use 5.004;
use strict;
use List::Util 'max';
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::NumSeq::BalancedBinary;
# uncomment this to run the ### lines
# use Smart::Comments;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant xy_is_visited => 1;
sub new {
my $self = shift->SUPER::new (@_);
$self->{'seq'} = Math::NumSeq::BalancedBinary->new;
return $self;
}
sub n_to_xy {
my ($self, $n) = @_;
### SumFractions n_to_xy(): $n
if ($n < 1) { return; }
if (is_infinite($n) || $n == 0) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
my $d = int((sqrt(8*$n-7) - 1) / 2);
$n -= $d*($d+1)/2 + 1;
### $d
### $n
return _dn_to_xy($d,$n);
}
sub _dn_to_xy {
my ($d,$n) = @_;
if ($n == 0) { return (1,1); }
if ($n == $d) { return (1,$d+1) };
return _rat_sum(_dn_to_xy($d-1,$n),
_dn_to_xy($d-1,$n-1));
}
sub _rat_sum {
my ($x1,$y1, $x2,$y2) = @_;
my $num = $x1*$y2 + $x2*$y1;
my $den = $y1*$y2;
my $gcd = Math::PlanePath::GcdRationals::_gcd($num,$den);
return ($num/$gcd, $den/$gcd);
}
use Math::PlanePath::GcdRationals;
*_gcd = \&Math::PlanePath::GcdRationals::_gcd;
sub xy_to_n {
my ($self, $x, $y) = @_;
### SumFractions xy_to_n(): "$x, $y"
return undef;
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 0 || $y < 0) {
return undef;
}
my $zero = $x * 0 * $y;
if (is_infinite($x)) { return $x; }
if (is_infinite($y)) { return $y; }
my $value = $self->{'seq'}->ith($y) || 0;
### value at y: $value
my $pow = (4+$zero)**$x;
$value *= $pow;
$value += 2*($pow-1)/3;
### mul: sprintf '%#b', $pow
### add: sprintf '%#b', 2*($pow-1)/3
### value: sprintf '%#b', $value
### $value
### value: ref $value && $value->as_bin
return $self->{'seq'}->value_to_i($value);
}
# exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### SumFractions rect_to_n_range(): "$x1,$y1 $x2,$y2"
return (1,10000);
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 0 || $y2 < 0) {
### all outside first quadrant ...
return (1, 0);
}
# bottom left into first quadrant
if ($x1 < 0) { $x1 *= 0; }
if ($y1 < 0) { $y1 *= 0; }
return (0,
4**($x2+$y2));
return ($self->xy_to_n($x1,$y1), # bottom left
$self->xy_to_n($x2,$y2)); # top right
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/MooreSpiral.pm 0000644 0001750 0001750 00000042563 12606435145 021123 0 ustar gg gg # Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# math-image --path=MooreSpiral --all --output=numbers_dash
# math-image --path=MooreSpiral,arms=2 --all --output=numbers_dash
# www.nahee.com/spanky/www/fractint/lsys/variations.html
# William McWorter mcworter@midohio.net
# http://www.nahee.com/spanky/www/fractint/lsys/moore.gif
package Math::PlanePath::MooreSpiral;
use 5.004;
use strict;
use List::Util 'min'; # 'max'
*max = \&Math::PlanePath::_max;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::NSEW;
@ISA = ('Math::PlanePath::Base::NSEW',
'Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'round_down_pow',
'digit_split_lowtohigh';
# uncomment this to run the ### lines
#use Smart::Comments;
use constant n_start => 0;
use constant parameter_info_array => [ { name => 'arms',
share_key => 'arms_2',
display => 'Arms',
type => 'integer',
minimum => 1,
maximum => 2,
default => 1,
width => 1,
description => 'Arms',
} ];
sub new {
my $self = shift->SUPER::new(@_);
$self->{'arms'} = max(1, min(2, $self->{'arms'} || 1));
return $self;
}
my @next_state = (20,30, 0, 60, 0,10, 70,60,50, undef, # 0
30, 0, 10,70,10, 20,40,70, 60,undef, # 10
0, 10,20,40, 20,30,50, 40,70,undef, # 20
10,20,30, 50,30, 0, 60,50,40, undef, # 30
10,20, 30,50,40, 20,40,70, 60,undef, # 40
20, 30, 0,60, 50,30,50, 40,70,undef, # 50
30, 0,10, 70,60, 0, 60,50,40, undef, # 60
0,10, 20,40,70, 10,70,60, 50,undef); # 70
my @digit_to_x = ( 0, 1, 1, 0,-1,-2, -2,-2,-3, -3, # 0
0, 0, -1,-1,-1, -1, 0, 1, 1, 0, # 10
0, -1,-1, 0, 1, 2, 2, 2, 3, 3, # 20
0, 0, 1, 1, 1, 1, 0,-1,-1, 0, # 30
0, 0, 1, 1, 1, 2, 3, 4, 4, 3, # 40
0, 1, 1, 0, -1,-1,-1, -1, 0, 0, # 50
0, 0,-1, -1,-1,-2, -3,-4,-4, -3, # 60
0,-1, -1, 0, 1, 1, 1, 1, 0, 0); # 70
my @digit_to_y = ( 0, 0, 1, 1, 1, 1, 0,-1,-1, 0, # 0
0, 1, 1, 0,-1, -2,-2,-2, -3,-3, # 10
0, 0,-1,-1, -1,-1, 0, 1, 1, 0, # 20
0,-1,-1, 0, 1, 2, 2, 2, 3, 3, # 30
0,-1, -1, 0, 1, 1, 1, 1, 0, 0, # 40
0, 0, 1, 1, 1, 2, 3, 4, 4, 3, # 50
0, 1, 1, 0,-1,-1, -1,-1, 0, 0, # 60
0, 0, -1,-1,-1, -2,-3,-4, -4,-3); # 70
# state length 80 in each of 4 tables
# rot2 state 20
sub n_to_xy {
my ($self, $n) = @_;
### MooreSpiral n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n,$n); }
my $int = int($n);
$n -= $int; # frac
# initial state from arm number $int mod $arms
my $state = 20;
my $arms = $self->{'arms'};
if ($arms > 1) {
my $arm = _divrem_mutate($int,2);
if ($arm) {
$state = 0;
$int += 1;
}
}
my @digits = digit_split_lowtohigh($int,9);
my $zero = $int*0; # inherit bignum 0
my $len = ($zero+3) ** scalar(@digits);
unless ($#digits & 1) {
$state ^= 20; # rot 18re0
}
### digits: join(', ',@digits)." count ".scalar(@digits)
### $len
### initial state: $state
my $x = 0;
my $y = 0;
my $dir = 0;
while (@digits) {
$len /= 3;
### at: "$x,$y"
### $len
### digit: $digits[-1]
### state: $state
# . " ".state_string($state)
$state += (my $digit = pop @digits);
if ($digit != 8) {
}
$dir = $state; # lowest non-zero digit
### digit_to_x: $digit_to_x[$state]
### digit_to_y: $digit_to_y[$state]
### next_state: $next_state[$state]
$x += $len * $digit_to_x[$state];
$y += $len * $digit_to_y[$state];
$state = $next_state[$state];
}
### final: "$x,$y"
# with $n fractional part
return ($n * ($digit_to_x[$dir+1] - $digit_to_x[$dir]) + $x,
$n * ($digit_to_y[$dir+1] - $digit_to_y[$dir]) + $y);
}
# 61-62 67-68-69-70 4
# | | | |
# 60 63 66 73-72-71 3
# | | | |
# 59 64-65 74-75-76 2
# | |
# 11-10 5--4--3--2 58-57-56 83-82 77 1
# | | | | | | | |
# 12 9 6 0--1 53-54-55 84 81 78 <- Y=0
# | | | | | | |
# 13 8--7 52-51-50 85 80-79 -1
# | | |
# 14-15-16 25-26 31-32-33-34 43-44 49 86-87-88 97-98 -2
# | | | | | | | | | | |
# 19-18-17 24 27 30 37-36-35 42 45 48 91-90-89 96 99 -3
# | | | | | | | | | | |
# 20-21-22-23 28-29 38-39-40-41 46-47 92-93-94-95 ... -4
# 40 -3*9 = 40-27=13
# 13 -8 = 5
#
# bottom right corner "40" N=(9^level-1)/2
# bottom left corner "20"
# N=(9^level-1)/2 - 3*3^level
# len=3 Nr=(9*len*len-1)/2=40
# Nl=Nr - 2*len*len - (len-1)
# = (9*len*len-1)/2 - 2*len*len - (len-1)
# = (9*len*len-1 - 4*len*len - 2*(len-1))/2
# = (9*len*len - 1 - 4*len*len - 2*len + 2)/2
# = (5*len*len - 2*len + 1)/2
# = ((5*len - 2)*len + 1)/2
#
# round 2,5,etc 1+(3^level-1)/2 = x
# 2*(x-1) = 3^level-1
# 3^level = 2x-2+1 = 2x-1
# offset 1,4,etc 1+...+3^(level-1) = (3^level-1)/2
#
my @yx_to_rot = (0,3,0, # y=0
1,2,1, # y=1
0,3,0); # y=2
my @yx_to_digit = (-2,-3,-4, # y=0
-1,0,1, # y=1
4,3,2); # y=2
sub xy_to_n {
my ($self, $x, $y) = @_;
### MooreSpiral xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
my ($len, $level) = round_down_pow (max(abs($x),abs($y))*2 - 1,
3);
### $len
### $level
# offset to make bottom left corner X=0,Y=0
{
my $offset = (3*$len-1)/2;
$x += $offset;
$y += $offset;
### $offset
### offset to: "$x,$y"
### assert: $x >= 0
### assert: $y >= 0
### assert: $x < 3*$len
### assert: $y < 3*$len
}
if (is_infinite($x)) {
return $x;
}
if (is_infinite($y)) {
return $y;
}
my $arms = $self->{'arms'};
my $npow = $len*$len;
my $n = ($x * 0 * $y); # + (9*$npow - 1)/2;
my $rot = ($level & 1 ? 2 : 0);
my @x = digit_split_lowtohigh ($x, 3);
my @y = digit_split_lowtohigh ($y, 3);
### @x
### @y
for ( ; $level >= 0; $level--) {
### $n
### $rot
$x = $x[$level] || 0;
$y = $y[$level] || 0;
### raw xy digits: "$x,$y"
if ($rot&1) {
($x,$y) = (2-$y,$x) # rotate +90
}
if ($rot&2) {
$x = 2-$x; # rotate 180
$y = 2-$y;
}
### rotated xy digits: "$x,$y"
my $k = $y*3+$x;
$rot += $yx_to_rot[$k];
my $digit = $yx_to_digit[$k];
$n += $npow*$digit;
### $digit
### add to n: $npow*$digit
if ($n < 0 && $self->{'arms'} < 2) {
### negative when only 1 arm ...
return undef;
}
$npow /= 9;
}
### final n: $n
if ($arms < 2) {
return $n;
}
if ($n < 0) {
return -1-2*$n;
} else {
return 2*$n;
}
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### MooreSpiral rect_to_n_range(): "$x1,$y1, $x2,$y2"
$x1 = round_nearest ($x1);
$x2 = round_nearest ($x2);
$y1 = round_nearest ($y1);
$y2 = round_nearest ($y2);
my ($len, $level) = round_down_pow (max(abs($x1),abs($y1),
abs($x2),abs($y2))*2-1,
3);
### $len
### $level
return (0,
($x1 * 0 * $y1 * $x2 * $y2)
+ (9*$len*$len - 1) * $self->{'arms'} / 2);
}
1;
__END__
=for stopwords eg Ryde ie MooreSpiral Math-PlanePath Moore
=head1 NAME
Math::PlanePath::MooreSpiral -- 9-segment self-similar spiral
=head1 SYNOPSIS
use Math::PlanePath::MooreSpiral;
my $path = Math::PlanePath::MooreSpiral->new;
my ($x, $y) = $path->n_to_xy (123);
=head1 DESCRIPTION
This is an integer version of a 9-segment self-similar curve by ...
61-62 67-68-69-70 4
| | | |
60 63 66 73-72-71 3
| | | |
59 64-65 74-75-76 2
| |
11-10 5--4--3--2 58-57-56 83-82 77 1
| | | | | | | |
12 9 6 0--1 53-54-55 84 81 78 <- Y=0
| | | | | | |
13 8--7 52-51-50 85 80-79 -1
| | |
14-15-16 25-26 31-32-33-34 43-44 49 86-87-88 97-98 -2
| | | | | | | | | | |
19-18-17 24 27 30 37-36-35 42 45 48 91-90-89 96 99 -3
| | | | | | | | | | |
20-21-22-23 28-29 38-39-40-41 46-47 92-93-94-95 ... -4
-4 -3 -2 -1 X=0 1 2 3 4 5 6 7 8 9 10 11 12
The base pattern is the N=0 to N=9 shape. Then there's 9 copies of that
shape in the same relative directions as those segments and with reversals
in the 3,6,7,8 parts. The first reversed section is N=3*9=27 to N=4*9=36.
rev
5------4------3------2
| |
| |
9 6 0------1
| |rev
rev| |
8------7
rev
Notice the points N=9,18,27,...,81 are the base shape rotated 180 degrees.
Likewise for N=81,162,etc and any multiples of N=9^level, with each
successive level being rotated 180 degrees relative to the preceding. The
effect is to spiral around with an ever fatter 3^level width,
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
*************************** *********
*************************** *********
*************************** *********
*************************** ****** *********
*************************** *** ** *********
*************************** *** *********
*************************** ******************
*************************** ******************
*************************** ******************
***************************
***************************
***************************
***************************
***************************
***************************
***************************
***************************
***************************
=head2 Arms
The optional C 2> parameter can give a second copy of the spiral
rotated 180 degrees. With two arms all points of the plane are covered.
93--91 81--79--77--75 57--55 45--43--41--39 122-124 ..
| | | | | | | | | | |
95 89 83 69--71--73 59 53 47 33--35--37 120 126 132
| | | | | | | | | | |
97 87--85 67--65--63--61 51--49 31--29--27 118 128-130
| | |
99-101-103 22--20 10-- 8-- 6-- 4 13--15 25 116-114-112
| | | | | | | | |
109-107-105 24 18 12 1 0-- 2 11 17 23 106-108-110
| | | | | | | | |
111-113-115 26 16--14 3-- 5-- 7-- 9 19--21 104-102-100
| | |
129-127 117 28--30--32 50--52 62--64--66--68 86--88 98
| | | | | | | | | | |
131 125 119 38--36--34 48 54 60 74--72--70 84 90 96
| | | | | | | | | | |
.. 123-121 40--42--44--46 56--58 76--78--80--82 92--94
The first arm is the even numbers N=0,2,4,etc and the second arm is the odd
numbers N=1,3,5,etc.
=head2 Wunderlich Serpentine Curve
The way the ends join makes little "S" shapes similar to the PeanoCurve.
The first is at N=5 to N=13,
11-10 5
| | |
12 9 6
| | |
13 8--7
The wider parts then have these sections alternately horizontal or vertical
in the style of Walter Wunderlich's "serpentine" type 010 101 010 curve.
For example the 9x9 block N=41 to N=101,
61--62 67--68--69--70 115-116 121
| | | | | | |
60 63 66 73--72--71 114 117 120
| | | | | | |
59 64--65 74--75--76 113 118-119
| | |
58--57--56 83--82 77 112-111-110
| | | | |
53--54--55 84 81 78 107-108-109
| | | | |
52--51--50 85 80--79 106-105-104
| | |
43--44 49 86--87--88 97--98 103
| | | | | | |
42 45 48 91--90--89 96 99 102
| | | | | | |
41 46--47 92--93--94--95 100-101
The whole curve is in fact like the Wunderlich serpentine started from the
middle. This can be seen in the two arms picture above (in mirror image of
the usual PlanePath start direction for Wunderlich's curve).
=head1 FUNCTIONS
See L for the behaviour common to all path
classes.
=over 4
=item C<$path = Math::PlanePath::MooreSpiral-Enew ()>
Create and return a new path object.
=item C<($x,$y) = $path-En_to_xy ($n)>
Return the X,Y coordinates of point number C<$n> on the path. Points begin
at 0 and if C<$n E 0> then the return is an empty list.
=back
=head1 FORMULAS
=head2 X,Y to N
The correspondence to Wunderlich's 3x3 serpentine curve can be used to turn
X,Y coordinates in base 3 into an N. Reckoning the innermost 3x3 as level=1
then the smallest abs(X) or abs(Y) in a level is
Xlevelmin = (3^level + 1) / 2
eg. level=2 Xlevelmin=5
which can be reversed as
level = log3floor( max(abs(X),abs(Y)) * 2 - 1 )
eg. X=7 level=log3floor(2*7-1)=2
An offset can be applied to put X,Y in the range 0 to 3^level-1,
offset = (3^level-1)/2
eg. level=2 offset=4
Then a table can give the N base-9 digit corresponding to X,Y digits
Y=2 4 3 2 N digit
Y=1 -1 0 1
Y=0 -2 -3 -4
X=0 X=1 X=2
A current rotation maintains the "S" part directions and is updated by a
table
Y=2 0 +3 0 rotation when descending
Y=1 +1 +2 +1 into sub-part
Y=0 0 +3 0
X=0 X=1 X=2
The negative digits of N represent backing up a little in some higher part.
If N goes negative at any state then X,Y was off the main curve and instead
on the second arm. If the second arm is not of interest the calculation can
stop at that stage.
It no doubt would also work to take take X,Y as balanced ternary digits
1,0,-1, but it's not clear that would be any faster or easier to calculate.
=head1 SEE ALSO
L,
L
=head1 HOME PAGE
L
=head1 LICENSE
Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along with
Math-PlanePath. If not, see .
=cut
Math-PlanePath-122/devel/lib/Math/PlanePath/WythoffLines.pm 0000644 0001750 0001750 00000025725 12606435145 021311 0 ustar gg gg # Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# x=45,y=10 x=59,y=19 dx=14,dy=9 14/9=1.55
#
# x=42,y=8 x=113,y=52 dx=71,dy=44 71/44=1.613
#
# below
# 32,12 to 36,4 sqrt((32-36)^2+(12-4)^2) = 9
# 84,34 to 99,14 sqrt((84-99)^2+(34-14)^2) = 25
# 180,64 to 216,11 sqrt((180-216)^2+(64-11)^2) = 64
#
# above
# 14,20 to 5,32 sqrt((14-5)^2+(20-32)^2) = 15 = 9*1.618 3
# 34,50 to 14,85 sqrt((34-14)^2+(50-85)^2) = 40 = 25*1.618 5
# 132,158 to 77,247 sqrt((132-77)^2+(158-247)^2) = 104 = 64*1.618 8
# 8,525 to 133,280 sqrt((8-133)^2+(525-280)^2) = 275 = 169*1.618 13
package Math::PlanePath::WythoffLines;
use 5.004;
use strict;
use List::Util 'max';
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'bit_split_lowtohigh';
# uncomment this to run the ### lines
# use Smart::Comments;
use constant parameter_info_array =>
[ { name => 'shift',
display => 'Shift',
type => 'integer',
default => 0,
width => 3,
},
];
# shift x_minimum() y_minimum()
# -4 13 8
# -3 8 5
# -2 5 3
# -1 3 2
# 1 2 1
# 0 2 1 ...
# 1 1 1 fib(1)
# 2 1 /---> 0 -----^ fib(0)
# 3 0 <--/ 1 a
# 4 1 -1 b
# 5 -1 2 c
# 6 2 -4 d -4=2*-1-2
# 7 -4 4 e 4=2*2-0
# 8 4 -12 -12=2*-4-4
# 9 -12 9 9=2*4-(-1)
# 10 9 -33
# 11 -33 22 22=3*9-4-1 a(n)=3a(n-2)-a(n-4)-1
# 12 22 -88 -88=2*-33-22 2*a(n-2)-a(n-1)
# 13 -88 56 56=2*22+12 2*a(n-2)-a(n-5)
# 14 56 -232 -232=2*-88-56 2*a(n-2)-a(n-1)
# 15 -232 145 145=2*56+33 2*a(n-2)-a(n-5)
# 16 -609 -609=2*-232-145
# 17 -609 378 378=2*145-(-88)
#
# shift -4,-12,-33,-88,-232 = 1-Fib(2*s+1)
# shift 9,22,56,145,378,988
# a(n)=3*a(n-1)-a(n-2)-1
# with $shift reckoned for y_minimum()
sub _calc_minimum {
my ($shift) = @_;
if ($shift <= 2) {
return _fibonacci(2-$shift);
}
if ($shift & 1) {
# shift odd >= 3, so (shift-1)/2 >= 1
my $a = 1;
my $b = 2;
foreach (2 .. ($shift-1)/2) {
($a,$b) = ($b, 3*$b-$a-1);
}
return $a;
} else {
# shift even >= 4
return 1 - _fibonacci($shift-1);
}
# $a = 1;
# $b = -1;
# my $c = 2;
# my $d = -4;
# my $e = 4;
# for (my $i = 2; $i < $shift; $i++) {
# ($a,$b,$c,$d,$e) = ($b,$c,$d,$e, 2*$d-$e);
# $i++;
# last unless $i < $shift;
# ($a,$b,$c,$d,$e) = ($b,$c,$d,$e, 2*$d-$a);
# }
# return $a;
}
sub _fibonacci {
my ($n) = @_;
$a = 0;
$b = 1;
foreach (1 .. $n) {
($a,$b) = ($b,$a+$b);
}
return $a;
}
sub x_minimum {
my ($self) = @_;
return _calc_minimum($self->{'shift'}-1);
}
sub y_minimum {
my ($self) = @_;
return _calc_minimum($self->{'shift'});
}
#------------------------------------------------------------------------------
use Math::PlanePath::WythoffArray;
my $wythoff = Math::PlanePath::WythoffArray->new;
sub new {
my $self = shift->SUPER::new(@_);
$self->{'shift'} ||= 0;
return $self;
}
sub n_to_xy {
my ($self, $n) = @_;
### WythoffLines n_to_xy(): $n
if ($n < 1) { return; }
if (is_infinite($n) || $n == 0) { return ($n,$n); }
{
# fractions on straight line
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
# $n -= 1;
# my $y = $wythoff->xy_to_n(0,$n);
# my $x = $wythoff->xy_to_n(1,$n);
# 1 2.000, 1.000 1 1_100000 5.000,3.000(5.831)
# 2 7.000, 4.000 2 1_100000 3.000,2.000(3.606)
# 3 10.000, 6.000 3 1_100000 5.000,3.000(5.831)
# 4 15.000, 9.000 4 1_100000 5.000,3.000(5.831)
# 5 20.000, 12.000 5 1_100000 3.000,2.000(3.606)
# 6 23.000, 14.000 6 1_100000 5.000,3.000(5.831)
# 7 28.000, 17.000 7 1_100000 3.000,2.000(3.606)
my $zero = $n*0;
# spectrum(Y+1) so Y,Ybefore are notional two values at X=-2 and X=-1
my $y = $n-1;
my $x = int((sqrt(5*$n*$n) + $n) / 2);
# ($y,$x) = (1*$x + 1*$y,
# 2*$x + 1*$y);
# shift s to -1
# 1 to s
# but forward by 2 extra
# s to -1+2=1
# 1+2=3 to s
foreach ($self->{'shift'} .. 1) {
($y,$x) = ($x,$x+$y);
}
foreach (3 .. $self->{'shift'}) {
# prev+y=x
# prev = x-y
($y,$x) = ($x-$y,$y);
}
return ($x,$y);
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### WythoffLines xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
# if (is_infinite($y)) { return $y; }
# unshift
#
foreach ($self->{'shift'} .. -1) {
($y,$x) = ($x-$y,$y);
}
foreach (1 .. $self->{'shift'}) {
($y,$x) = ($x,$x+$y);
}
### unshifted to: "$x,$y"
if (my ($cy,$ny) = $wythoff->n_to_xy($y)) {
### y: "cy=$cy ny=$ny"
if ($cy == 0) {
if (my ($cx,$nx) = $wythoff->n_to_xy($x)) {
if ($cx == 1 && $nx == $ny) {
return $nx+1;
}
}
}
}
return undef;
# my $y = $wythoff->xy_to_n(0,$n);
# my $x = $wythoff->xy_to_n(1,$n);
}
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### WythoffLines rect_to_n_range(): "$x1,$y1 $x2,$y2"
my $zero = $x1 * 0 * $y1 * $x2 * $y2;
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
# FIXME: probably not quite right
my $phi = (1 + sqrt(5+$zero)) / 2;
return (1,
max (1,
int($phi**($self->{'shift'}-2)
* max ($x1,$x2, max($y1,$y2)*$phi))));
}
1;
__END__
=for stopwords eg Ryde Math-PlanePath Moore Wythoff Zeckendorf concecutive fibbinary OEIS
=head1 NAME
Math::PlanePath::WythoffLines -- table of Fibonacci recurrences
=head1 SYNOPSIS
use Math::PlanePath::WythoffLines;
my $path = Math::PlanePath::WythoffLines->new;
my ($x, $y) = $path->n_to_xy (123);
=head1 DESCRIPTION
XThis path is the Wythoff preliminary triangle by Clark
Kimberling,
=cut
# math-image --path=WythoffLines --output=numbers --all --size=60x14
=pod
13 | 105 118 131 144 60 65 70 75 80 85 90 95 100
12 | 97 110 47 52 57 62 67 72 77 82 87 92
11 | 34 39 44 49 54 59 64 69 74 79 84
10 | 31 36 41 46 51 56 61 66 71 76
9 | 28 33 38 43 48 53 58 63 26
8 | 25 30 35 40 45 50 55 23
7 | 22 27 32 37 42 18 20
6 | 19 24 29 13 15 17
5 | 16 21 10 12 14
4 | 5 7 9 11
3 | 4 6 8
2 | 3 2
1 | 1
Y=0 |
+-----------------------------------------------------
X=0 1 2 3 4 5 6 7 8 9 10 11 12
A coordinate pair Y and X are the start of a Fibonacci style recurrence,
F[1]=Y, F[2]=X F[i+i] = F[i] + F[i-1]
Any such sequence eventually becomes a row of the Wythoff array
(L) after some number of initial iterations.
The N value at X,Y is the row number of the Wythoff array containing
sequence beginning Y and X. Rows are numbered starting from 1. Eg.
Y=4,X=1 sequence: 4, 1, 5, 6, 11, 17, 28, 45, ...
row 7 of WythoffArray: 17, 28, 45, ...
so N=7 at Y=4,X=1
Conversely a given N is positioned in the triangle according to where row
number N of the Wythoff array "precurses" by running the recurrence in
reverse,
F[i-1] = F[i+i] - F[i]
It can be shown that such a precurse always reaches a pair Y and X with
YE=1 and 0E=XEY, hence making the triangular X,Y arrangement
above.
N=7 WythoffArray row 7 is 17,28,45,73,...
go backwards from 17,28 by subtraction
11 = 28 - 17
6 = 17 - 11
5 = 11 - 6
1 = 6 - 5
4 = 5 - 1
stop on reaching 4,1 which is Y=4,X=1 satisfying Y>=1 and 0<=X=XEY
=cut
# (r-1 + floor(r*phi)) / (r-1 + 2*floor(r*phi))
# ~= (r-1+r*phi)/(r-1+2*r*phi)
# = (r*(phi+1) - 1) / (r*(2phi+1) - 1)
# -> r*(phi+1) / r*(2*phi+1)
# = (phi+1) / (2*phi+1)
# = 1/phi = 0.618
=pod
=head1 FUNCTIONS
See L for the behaviour common to all path
classes.
=over 4
=item C<$path = Math::PlanePath::WythoffLines-Enew ()>
Create and return a new path object.
=back
=head1 OEIS
The Wythoff array is in Sloane's Online Encyclopedia of Integer Sequences
in various forms,
=over
L (etc)
=back
A165360 X
A165359 Y
A166309 N by rows
=head1 SEE ALSO
L,
L
=head1 HOME PAGE
L
=head1 LICENSE
Copyright 2013, 2014, 2015 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along with
Math-PlanePath. If not, see .
=cut
Math-PlanePath-122/devel/lib/Math/PlanePath/BinaryTerms-oeis.t 0000644 0001750 0001750 00000006634 12132055333 021700 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
use Test;
plan tests => 46;
use lib 't','xt';
use MyTestHelpers;
MyTestHelpers::nowarnings();
use MyOEIS;
use Math::PlanePath::BinaryTerms;
{
require Math::BaseCnv;
my $radix = 3;
my $path = Math::PlanePath::BinaryTerms->new (radix => $radix);
foreach my $y ($path->y_minimum .. 8) {
printf '%2d', $y;
foreach my $x ($path->x_minimum .. 7) {
my $n = $path->xy_to_n($x,$y);
my $nr = Math::BaseCnv::cnv($n,10,$radix);
printf " %10s", $nr;
}
print "\n";
}
}
#------------------------------------------------------------------------------
# A068076 X = num integers 'A068076',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::BinaryTerms->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $x-1;
}
return \@got;
});
#------------------------------------------------------------------------------
# A067576 binary by anti-diagonals upwards
MyOEIS::compare_values
(anum => 'A067576',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::BinaryTerms->new (radix => 2);
my $diag = Math::PlanePath::Diagonals->new (direction => 'up',
x_start=>1,y_start=>1);
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
push @got, $path->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A066884 binary diagonals downwards
MyOEIS::compare_values
(anum => 'A066884',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::BinaryTerms->new;
my $diag = Math::PlanePath::Diagonals->new (x_start=>1,y_start=>1);
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
push @got, $path->xy_to_n($x,$y);
}
return \@got;
});
# A067587 inverse
MyOEIS::compare_values
(anum => 'A067587',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::BinaryTerms->new;
my $diag = Math::PlanePath::Diagonals->new (x_start=>1,y_start=>1);
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $diag->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/devel/lib/Math/PlanePath/Godfrey.pm 0000644 0001750 0001750 00000007605 12606435145 020264 0 ustar gg gg # Copyright 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Edwin L. Godfrey, "Enumeration of the Rational Points Between 0 and 1",
# National Mathematics Magazine, volume 12, number 4, January 1938, pages
# 163-166. http://www.jstor.org/stable/3028080
# cf
# A126572 Array read by antidiagonals: a(n,m) = the m-th integer from among those positive integers coprime to n.
# 1/1 1/2 1/3 1/4 1/5 1/6 1/7 ...
# 2/1 2/3 2/5 2/7 2/9 2/11 2/13 ...
# 3/1 3/2 3/4 3/5 3/7 3/8 3/10 ...
# 4/1 4/3 4/5 4/7 4/9 4/11 4/13 ...
# 5/1 5/2 5/3 5/4 5/6 5/7 5/8 ...
# 6/1 6/5 6/7 6/11 6/13 6/17 6/19 ...
# 7/1 7/2 7/3 7/4 7/5 7/6 7/8 ...
# 1/2 1/3 1/4 1/5 1/6 1/7
# 2/3 2/5 2/7 2/9 2/11 2/13
# 3/4 3/5 3/7 3/8 3/10 3/11
# 4/5 4/7 4/9 4/11 4/13 4/15
package Math::PlanePath::Godfrey;
use 5.004;
use strict;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
*_divrem = \&Math::PlanePath::_divrem;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::CoprimeColumns;
# uncomment this to run the ### lines
# use Smart::Comments;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant x_minimum => 1;
use constant y_minimum => 2;
use constant diffxy_maximum => -1; # upper octant X<=Y-1 so X-Y<=-1
use constant gcdxy_maximum => 1; # no common factor
#------------------------------------------------------------------------------
sub n_to_xy {
my ($self, $n) = @_;
### Godfrey n_to_xy(): $n
if ($n < 1) { return; }
if (is_infinite($n)) { return ($n,$n); }
my $d = int((sqrt(8*$n-7) + 1) / 2);
### $d
### base: ($d-1)*$d/2
$n -= ($d-1)*$d/2;
my $y = $n;
my $q = $d - $y;
# ### assert: $n >= 0
# ### assert: $y >= 1
my $tot = Math::PlanePath::CoprimeColumns::_totient($y);
my ($f, $count) = _divrem ($q, $tot);
### $y
### $q
### $tot
my $x = 1;
if ($count) {
for (;;) {
$x++;
if (Math::PlanePath::CoprimeColumns::_coprime($x,$y)) {
--$count or last;
}
}
}
# final den: $x + ($f+1)*$y)
return ($y, $x + ($f+1)*$y);
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### Godfrey xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 1 || $y < 1) {
return undef;
}
if (is_infinite($x)) {
return $x;
}
my ($f, $r) = _divrem ($y, $x);
### $f
### $r
my $w = ($f-1) * Math::PlanePath::CoprimeColumns::_totient($x);
### w from totient: $w
foreach my $i (1 .. $r) {
if (Math::PlanePath::CoprimeColumns::_coprime($i,$x)) {
### coprime: "$i, x=$x, increment"
$w++;
}
}
my $d = $x + $w - 1;
### $x
### $w
### $d
### return: $d*($d-1)/2 + $x
return $d*($d-1)/2 + $x;
}
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### Godfrey rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 1 || $y2 < 1) { return (1,0); }
return (1, $self->xy_to_n($x2,$y2));
}
1;
__END__
=cut
# math-image --path=Godfrey --output=numbers --all --size=60x14
=pod
Math-PlanePath-122/devel/lib/Math/PlanePath/BinaryTerms.pm 0000644 0001750 0001750 00000022765 12606435146 021131 0 ustar gg gg # Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# cf A134562 base-3 Y=sum digits
# http://cut-the-knot.org/wiki-math/index.php?n=Probability.ComboPlayground
# combinations
# row
# Y=1 2^k
# Y=2 2-bit numbers
# column
# X=1 first with Y many bits is Zeck 11111
# A027941 Fib(2n+1)-1
# X=2 second with Y many bits is Zeck 101111 high 1, low 1111
# A005592 F(2n+1)+F(2n-1)-1
# X=3 third with Y many bits is Zeck 110111
# A005592 F(2n+1)+F(2n-1)-1
# X=4 fourth with Y many bits is Zeck 111011
# 111101
# 111110
# 1001111
# 1010111
# 1011011
# 1011101
# 1011110
# 1100111
# 1101011
# 1101101
# 1101110
# 1110011
# 1110101
# 1110110
# 1111001
# 1111010
# 1111100
# 15 binomial(6,4)=15
#
# binomial(a,b) = a! / (b! * (a-b!))
#
# binomial(X-1,X-1) 4,4
# binomial(X, X-1) 5,4
# binomial(X+1,X-1) 5,4
# bin(a+1,b) = (a+1)!/(b! * (a+1-b)!)
# bin(a+1,b) = a!/(b! * (a-b)!) * (a+1)/(a+1-b)
# bin(a+1,b) = bin(a,b) * (a+1)/(a+1-b)
#
# bin(a,b+1) = (a)!/((b+1)! * (a-b-1)!)
# bin(a,b+1) = (a)!/(b! * (a-b)!) * (b+1)*(a-b)
# bin(a,b+1) = bin(a,b) * (b+1)*(a-b)
#
# bin(a-1,b) = (a-1)! / (b! * (a-1-b)!)
# bin(a-1,b) = a! / (b! * (a-b)!) ( (a-b)/a
# bin(a-1,b) = bin(a,b) * (a-b)/a
# bin(a,b-1) = a!/((b-1)! * (a-b+1)!)
# bin(a,b-1) = a!/(b! * (a-b)!) * b/(a-b+1)
# bin(a,b-1) = bin(a,b) * b/(a-b+1)
#
#
# 1 2 3 4 5 6
# Y=2 11 101 110 1001 1010 1100
# 3 5 6 9 10 12
# 1 \------2 \-------------3
# 1 2 3 4 5 6
# Y=3 111 1011 1101 1110
# 3 11 13 14
# 1 \-------------3 \-------------
# 1 2 3 4 5 6
# Y=4 111 1011 1101 1110
# 3 11 13 14
# 1 \-------------3 \-------------
package Math::PlanePath::BinaryTerms;
use 5.004;
use strict;
use List::Util 'sum';
#use List::Util 'max';
*max = \&Math::PlanePath::_max;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
*_divrem = \&Math::PlanePath::_divrem;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh',
'digit_join_lowtohigh';
# uncomment this to run the ### lines
# use Smart::Comments;
use constant parameter_info_array =>
[ Math::PlanePath::Base::Digits::parameter_info_radix2(),
];
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant y_minimum => 1;
use constant x_minimum => 1;
#------------------------------------------------------------------------------
my $global_radix = 0;
my $next_n = 1;
my @n_to_x;
my @n_to_y;
my @yx_to_n;
sub new {
my $self = shift->SUPER::new(@_);
$self->{'radix'} ||= 2;
if ($global_radix != $self->{'radix'}) {
$global_radix = $self->{'radix'};
$next_n = 1;
@n_to_x = ();
@n_to_y = ();
@yx_to_n = ();
}
return $self;
}
sub _extend {
my ($self) = @_;
### _extend() ...
### $next_n
my $n = $next_n++;
my @ndigits = digit_split_lowtohigh($n,$self->{'radix'});
### ndigits low to high: join(',',@ndigits)
my $y = 0;
foreach (@ndigits) {
if ($_) { $y++; }
}
my $row = ($yx_to_n[$y] ||= []);
my $x = scalar(@$row) || 1;
$row->[$x] = $n;
$n_to_x[$n] = $x;
$n_to_y[$n] = $y;
### push: "x=$x y=$y n=$n"
### @yx_to_n
}
sub n_to_xy {
my ($self, $n) = @_;
### BinaryTerms n_to_xy(): "$n radix=$self->{'radix'}"
if ($n < 1) { return; }
if (is_infinite($n) || $n == 0) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
my $radix = $self->{'radix'};
if ($radix > 2) {
while ($next_n <= $n) {
_extend($self);
}
return ($n_to_x[$n], $n_to_y[$n]);
}
{
my @ndigits = digit_split_lowtohigh($n,$radix);
pop @ndigits; # drop high 1-bit
my $ones = sum(0,@ndigits);
my $y = $ones + 1;
### $y
### ndigits low to high: join(',',@ndigits)
### $ones
my $binomial
= my $x
= $n * 0 + 1; # inherit bignum 1
for (my $len = $ones; $len <= $#ndigits; ) {
### block add to x: $binomial
$x += $binomial * ($radix-1)**$ones;
# bin(a+1,b) = bin(a,b) * (a+1)/(a+1-b)
$len++;
$binomial *= $len;
### assert: $binomial % ($len-$ones) == 0
$binomial /= ($len-$ones);
### assert: $binomial == _binomial($len,$ones)
}
# here $binomial = binomial(len,ones)
my $len = scalar(@ndigits);
foreach my $digit (reverse @ndigits) { # high to low
### digit: "$digit len=$len ones=$ones binomial=$binomial x=$x"
if ($len == $ones || $ones == 0) {
last;
}
# bin(a-1,b) = bin(a,b) * (a-b)/a
$binomial *= ($len-$ones);
### assert: $binomial % $len == 0
$binomial /= $len;
$len--;
### decr len to: "len=$len ones=$ones binomial=$binomial"
### assert: $binomial == _binomial($len,$ones)
if ($digit) {
### add to x: $binomial
$x += $binomial * $digit * ($radix-1)**$ones;
# bin(a,b-1) = bin(a,b) * b/(a-b+1)
### assert: ($binomial * $ones) % ($len-$ones+1) == 0
$binomial *= $ones;
$ones--;
$binomial /= ($len-$ones);
### assert: $binomial == _binomial($len,$ones)
}
}
### result: "x=$x ones=$ones"
return ($x, $y);
}
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### BinaryTerms xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
my $radix = $self->{'radix'};
if ($radix > 2) {
if ($x < 1 || $y < 1) { return undef; }
if (is_infinite($x)) { return $x; }
if (is_infinite($y)) { return $y; }
for (;;) {
if (defined (my $n = $yx_to_n[$y][$x])) {
return $n;
}
_extend($self);
}
}
{
$x -= 1;
if ($x < 0 || $y < 1) { return undef; }
if (is_infinite($x)) { return $x; }
if (is_infinite($y)) { return $y; }
my $len = my $ones = $y-1;
my $binomial = 1;
while ($x >= $binomial * ($radix-1)**$ones) {
### subtract high from: "len=$len ones=$ones binomial=$binomial x=$x"
$x -= $binomial;
# bin(a+1,b) = bin(a,b) * (a+1)/(a+1-b)
$len++;
$binomial *= $len;
### assert: $binomial % ($len-$ones) == 0
$binomial /= ($len-$ones);
### assert: $binomial == _binomial($len,$ones)
}
### found high: "len=$len ones=$ones binomial=$binomial x=$x"
my @ndigits = (1); # high to low
while ($len > 0) {
### at: "len=$len ones=$ones binomial=$binomial x=$x"
### assert: $len >= $ones
if ($len == $ones) {
push @ndigits, (1) x $ones;
last;
}
if ($ones == 0) {
push @ndigits, (0) x $len;
last;
}
# bin(a-1,b) = bin(a,b) * (a-b)/a
$binomial *= ($len-$ones);
### assert: $binomial % $len == 0
$binomial /= $len;
$len--;
### decr len to: "len=$len ones=$ones binomial=$binomial"
### assert: $binomial == _binomial($len,$ones)
my $bcmp = $binomial * ($radix-1)**$ones;
### compare: "x=$x bcmp=$bcmp"
if ($x >= $bcmp) {
### yes, above, push digit ...
# (my $digit, $x) = _divrem($x,$bcmp);
# push @ndigits, $digit;
# ### assert: $digit >= 1
# ### assert: $digit < $radix
$x -= $binomial * ($radix-1)**$ones;
push @ndigits, 1;
# bin(a,b-1) = bin(a,b) * b/(a-b+1)
$binomial *= $ones;
$ones--;
### assert: ($binomial * $ones) % ($len-$ones) == 0
$binomial /= $len-$ones;
### assert: $binomial == _binomial($len,$ones)
} else {
### no, push 0 digit ...
push @ndigits, 0;
}
}
### ndigits: join(',',@ndigits)
@ndigits = reverse @ndigits;
return digit_join_lowtohigh(\@ndigits,$radix, $x*0*$y);
}
}
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### BinaryTerms rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 1 || $y2 < 1) { return (1,0); }
return (1, max($self->xy_to_n($x2,$y2),
$self->xy_to_n($x2,1)));
return (1, 10000);
}
sub _binomial {
my ($a,$b) = @_;
$a >= $b or die "_binomial($a,$b)";
my $ret = 1;
foreach (2 .. $a) { $ret *= $_ }
foreach (2 .. $b) { $ret /= $_ }
foreach (2 .. $a-$b) { $ret /= $_ }
### _binomial: "a=$a b=$b binomial=$ret"
return $ret;
}
1;
__END__
=cut
# math-image --path=BinaryTerms --output=numbers --all --size=60x14
=pod
Math-PlanePath-122/devel/lib/Math/PlanePath/WythoffTriangle.pm 0000644 0001750 0001750 00000005644 12606435145 022002 0 ustar gg gg # Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::PlanePath::WythoffTriangle;
use 5.004;
use strict;
use List::Util 'max';
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
# use Smart::Comments;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant y_minimum => 1;
use constant xy_is_visited => 1;
use Math::PlanePath::WythoffPreliminaryTriangle;
my $preliminary = Math::PlanePath::WythoffPreliminaryTriangle->new;
sub n_to_xy {
my ($self, $n) = @_;
### WythoffTriangle n_to_xy(): $n
if ($n < 1) { return; }
if (is_infinite($n) || $n == 0) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
my ($x,$y) = $preliminary->n_to_xy($n) or return;
$x = 0;
foreach my $x2 (0 .. $y-1) {
my $n2 = $preliminary->xy_to_n($x2,$y) or return;
### cf: "x2=$x2 n2=$n2"
if ($n2 < $n) {
### is below ...
$x++;
}
}
return ($x, $y);
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### WythoffTriangle xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($y < 1) { return undef; }
if (is_infinite($y)) { return $y; }
unless ($x >= 0 && $x < $y) { return undef; }
my @n = sort {$a<=>$b}
map { $preliminary->xy_to_n($_,$y) }
0 .. $y-1;
return $n[$x];
}
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### WythoffTriangle rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 0 || $y2 < 1) {
### all outside first quadrant ...
return (1, 0);
}
# bottom left into first quadrant
if ($x1 < 0) { $x1 *= 0; }
if ($y1 < 0) { $y1 *= 0; }
return (1,
$self->xy_to_n(0,2*$y2));
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/QuintetSide.pm 0000644 0001750 0001750 00000017022 12606435145 021115 0 ustar gg gg # mostly works, but any good ?
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# math-image --path=QuintetSide --lines --scale=10
# math-image --path=QuintetSide --output=numbers
package Math::PlanePath::QuintetSide;
use 5.004;
use strict;
use POSIX 'ceil';
use Math::Libm 'hypot';
#use List::Util 'max';
*max = \&Math::PlanePath::_max;
use vars '$VERSION', '@ISA', '@_xend','@_yend';
$VERSION = 122;
use Math::PlanePath 37;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh';
use Math::PlanePath::SacksSpiral;
# uncomment this to run the ### lines
#use Devel::Comments;
use constant n_start => 0;
sub n_to_xy {
my ($self, $n) = @_;
### QuintetSide n_to_xy(): $n
if ($n < 0) {
return;
}
if (is_infinite($n)) {
return ($n,$n);
}
my $x;
my $y = 0;
{ my $int = int($n);
$x = $n - $int;
$n = $int;
}
my $xend = 1;
my $yend = 0;
foreach my $digit (digit_split_lowtohigh($n,3)) {
my $xend_offset = $xend - $yend; # end + end rotated +90
my $yend_offset = $yend + $xend; # being the digit 2 position
### at: "$x,$y"
### $digit
### $xend
### $yend
### $xend_offset
### $yend_offset
if ($digit == 1) {
($x,$y) = (-$y + $xend, # rotate +90
$x + $yend);
} elsif ($digit == 2) {
$x += $xend_offset; # digit 2 offset position
$y += $yend_offset;
}
$xend += $xend_offset; # 2*end + end rotated +90
$yend += $yend_offset;
}
### final: "$x,$y"
return ($x, $y);
}
@_xend = (1);
@_yend = (0);
sub _ends_for_level {
my ($level) = @_;
### $#_xend
if ($#_xend < $level) {
my $x = $_xend[-1];
my $y = $_yend[-1];
do {
($x,$y) = (2*$x - $y, # 2*$x + rotate +90
2*$y + $x); # 2*$y + rotate +90
### _ends_for_level() push: scalar(@_xend)." $x,$y"
# ### assert: "$x,$y" eq join(','__PACKAGE__->n_to_xy(scalar(@xend) ** 3))
push @_xend, $x;
push @_yend, $y;
} while ($#_xend < $level);
}
}
sub xy_to_n {
my ($self, $x, $y) = @_;
$x = round_nearest($x);
$y = round_nearest($y);
### QuintetSide xy_to_n(): "$x, $y"
my $r = hypot($x,$y);
my $level = ceil(log($r+1)/log(sqrt(5)));
if (is_infinite($level)) {
return $level;
}
return _xy_to_n_in_level($x,$y,$level);
}
sub _xy_to_n_in_level {
my ($x, $y, $level) = @_;
_ends_for_level($level);
my @pending_n = (0);
my @pending_x = ($x);
my @pending_y = ($y);
my @pending_level = ($level);
while (@pending_n) {
my $n = pop @pending_n;
$x = pop @pending_x;
$y = pop @pending_y;
$level = pop @pending_level;
### consider: "$x,$y n=$n level=$level"
if ($level == 0) {
if ($x == 0 && $y == 0) {
return $n;
}
next;
}
my $xend = $_xend[$level-1];
my $yend = $_yend[$level-1];
if (hypot($x,$y) * (.9/sqrt(5)) > hypot($xend,$yend)) {
### radius out of range: hypot($x,$y)." cf end ".hypot($xend,$yend)
next;
}
$level--;
$n *= 3;
### descend: "end=$xend,$yend"
# digit 0
push @pending_n, $n;
push @pending_x, $x;
push @pending_y, $y;
push @pending_level, $level;
### push: "$x,$y digit=0"
# digit 1
$x -= $xend;
$y -= $yend;
($x,$y) = ($y, -$x); # rotate -90
push @pending_n, $n + 1;
push @pending_x, $x;
push @pending_y, $y;
push @pending_level, $level;
### push: "$x,$y digit=1"
# digit 2
$x -= $xend;
$y -= $yend;
($x,$y) = (-$y, $x); # rotate +90
push @pending_n, $n + 2;
push @pending_x, $x;
push @pending_y, $y;
push @pending_level, $level;
### push: "$x,$y digit=2"
}
return undef;
}
# radius = sqrt(5) ^ level
# log(radius) = level * log(sqrt(5))
# level = log(radius) * 1/log(sqrt(5))
#
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
$y1 *= sqrt(3);
$y2 *= sqrt(3);
my ($r_lo, $r_hi) = Math::PlanePath::SacksSpiral::_rect_to_radius_range
($x1,$y1, $x2,$y2);
my $level = ceil (log($r_hi+.1) * (1/log(sqrt(5))));
if ($level < 1) { $level = 1; }
return (0, 3**$level - 1);
}
1;
__END__
=for stopwords eg Ryde
=head1 NAME
Math::PlanePath::QuintetSide -- one side of the quintet tiling
=head1 SYNOPSIS
use Math::PlanePath::QuintetSide;
my $path = Math::PlanePath::QuintetSide->new;
my ($x, $y) = $path->n_to_xy (123);
=head1 DESCRIPTION
This path is ...
...
|
26----27
|
24----25
|
23----22
|
20----21
|
18----19
|
17----16
|
15----14
|
13----12 6
|
11----10 5
|
8---- 9 4
|
6---- 7 3
|
5---- 4 2
|
2---- 3 1
|
0---- 1 <- Y=0
^
X=0 1 2 3
It slowly spirals around counter clockwise, with a lot of wiggling in
between. The N=3^level point is at
N = 3^level
angle = level * atan(1/2)
= level * 26.56 degrees
radius = sqrt(5) ^ level
A full revolution for example takes roughly level=14 which is about
N=4,780,000.
Both ends of such levels are in fact sub-spirals, like an "S" shape.
=head1 FUNCTIONS
See L for the behaviour common to all path
classes.
=over 4
=item C<$path = Math::PlanePath::QuintetSide-Enew ()>
Create and return a new path object.
=item C<($x,$y) = $path-En_to_xy ($n)>
Return the X,Y coordinates of point number C<$n> on the path. Points begin
at 0 and if C<$n E 0> then the return is an empty list.
Fractional C<$n> gives a point on the straight line between surrounding
integer N.
=back
=head1 SEE ALSO
L,
L
L
=head1 HOME PAGE
L
=head1 LICENSE
Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along with
Math-PlanePath. If not, see .
=cut
Math-PlanePath-122/devel/lib/Math/PlanePath/ParabolicRows.pm 0000644 0001750 0001750 00000007222 12606435145 021427 0 ustar gg gg # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# A056520 1,2,6,15 (n+2)*(2*n^2-n+3)/6 starting n=0
#
package Math::PlanePath::ParabolicRows;
use 5.004;
use strict;
#use List::Util 'min', 'max';
*min = \&Math::PlanePath::_min;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
#use Smart::Comments;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant n_frac_discontinuity => .5;
# first N in row, counting from N=1 at X=0,Y=0
# [ 0,1,2,3 ],
# [ 1,2,6,15 ]
# N = (1/3 y^3 + 1/2 y^2 + 1/6 y + 1)
# = (2 y^3 + 3 y^2 + y + 1) / 6
# = ((2*y + 3)*y + 1)*y/6 + 1 + $x;
sub n_to_xy {
my ($self, $n) = @_;
### ParabolicRows n_to_xy(): $n
if ($n < 1) { return; }
if (is_infinite($n)) { return ($n,$n); }
my $int = int($n);
$n -= $int;
if (2*$n >= 1) { # if frac>=0.5
$int += 1;
$n -= 1;
}
### $int
### $n
my $yhi = int(sqrt($int)) + 2;
my $y = 0;
for (;;) {
my $ymid = int(($yhi+$y)/2);
### at: "y=$y ymid=$ymid yhi=$yhi"
if ($ymid == $y) {
### assert: $y+1 == $yhi
### found, row starting: ((2*$y + 3)*$y + 1)*$y/6 + 1
### $y
### x: $n + ($int - ((2*$y + 3)*$y + 1)*$y/6)
return ($n + ($int - ((2*$y + 3)*$y + 1)*$y/6 - 1),
$y);
}
### compare: ((2*$ymid + 3)*$ymid + 1)*$ymid/6 + 1
if ($int >= ((2*$ymid + 3)*$ymid + 1)*$ymid/6 + 1) {
$y = $ymid;
} else {
$yhi = $ymid;
}
}
# my $y = 0;
# for (;;) {
# my $max = ($y+1)**2;
# if ($int <= $max) {
# return ($n+$int-1,$y);
# }
# $y++;
# $int -= $max;
# }
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### ParabolicRows xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($y < 0) {
return undef;
}
my $ysquared = ($y+1)*($y+1);
if ($x >= $ysquared) {
return undef;
}
return ((2*$y + 3)*$y + 1)*$y/6 + 1 + $x;
}
# exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### ParabolicRows rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 0 || $y2 < 0) {
### all outside first quadrant ...
return (1, 0);
}
if ($y1 < 0) {
$y1 *= 0;
}
if ($x1 < 0) {
$x1 *= 0;
} elsif ($x1 >= ($y1+1)*($y1+1)) {
$y1 = _sqrt_ceil($x1+1);
### increase y1 to put x1 in range: $y1
}
### assert: defined $self->xy_to_n ($x1, $y1)
### assert: defined $self->xy_to_n (min($x2,($y2+2)*$y2), $y2)
# monotonic increasing in $x and $y directions, so this is exact
return ($self->xy_to_n ($x1, $y1),
$self->xy_to_n (min($x2,($y2+2)*$y2), $y2));
}
sub _sqrt_ceil {
my ($n) = @_;
my $sqrt = sqrt($n);
if ($sqrt*$sqrt < $n) {
$sqrt += 1;
}
return $sqrt;
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/PyramidReplicate.pm 0000644 0001750 0001750 00000016435 12606435145 022124 0 ustar gg gg # Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# math-image --path=PyramidReplicate --lines --scale=10
# math-image --path=PyramidReplicate --all --output=numbers_dash --size=80x50
package Math::PlanePath::PyramidReplicate;
use 5.004;
use strict;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'round_down_pow';
# uncomment this to run the ### lines
#use Devel::Comments;
use constant n_start => 0;
# 4 3 2
# 5 0 1
# 6 7 8
#
my @digit_to_x = (0,1,0,-1, -2,-3,-2,-1, 0,-1, 0, 1, 2,1,2,3);
my @digit_to_y = (0,0,1, 0, 1, 1, 0, 1, -1,-1,-2,-1, 1,1,0,1);
sub n_to_xy {
my ($self, $n) = @_;
### PyramidReplicate n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n,$n); }
{
my $int = int($n);
### $int
### $n
if ($n != $int) {
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $frac = $n - $int; # inherit possible BigFloat
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int; # BigFloat int() gives BigInt, use that
}
my $x = my $y = ($n * 0); # inherit bignum 0
my $len = ($x + 1); # inherit bignum 1
my $bx = 1;
my $by = 1;
while ($n) {
my $digit = $n % 16;
$n = int($n/16);
### at: "$x,$y"
### $digit
$x += $digit_to_x[$digit] * $bx;
$y += $digit_to_y[$digit] * $by;
$bx *= 6;
$by *= 4;
}
### final: "$x,$y"
return ($x,$y);
}
# mod digit
# 5 3 4 4 3 2 (x mod 3) + 3*(y mod 3)
# 2 0 1 5 0 1
# 8 6 7 6 7 8
#
my @mod_to_digit = (0,1,5, 3,2,4, 7,8,6);
sub xy_to_n {
my ($self, $x, $y) = @_;
### PyramidReplicate xy_to_n(): "$x, $y"
return undef;
$x = round_nearest ($x);
$y = round_nearest ($y);
my ($len,$level_limit);
{
my $xa = abs($x);
my $ya = abs($y);
($len,$level_limit) = round_down_pow (2*($xa > $ya ? $xa : $ya) || 1, 3);
### $level_limit
### $len
}
$level_limit += 2;
if (is_infinite($level_limit)) {
return $level_limit;
}
my $n = ($x * 0 * $y); # inherit bignum 0
my $power = ($n + 1); # inherit bignum 1
while ($x || $y) {
if ($level_limit-- < 0) {
### oops, level limit reached ...
return undef;
}
my $m = ($x % 3) + 3*($y % 3);
my $digit = $mod_to_digit[$m];
### at: "$x,$y m=$m digit=$digit"
$x -= $digit_to_x[$digit];
$y -= $digit_to_y[$digit];
### subtract: "$digit_to_x[$digit],$digit_to_y[$digit] to $x,$y"
### assert: $x % 3 == 0
### assert: $y % 3 == 0
$x /= 3;
$y /= 3;
$n += $digit * $power;
$power *= 9;
}
return $n;
}
# level N Xmax
# 1 9^1-1 1
# 2 9^2-1 1+3
# 3 9^3-1 1+3+9
# X <= 3^0+3^1+...+3^(level-1)
# X <= 1 + 3^0+3^1+...+3^(level-1)
# X <= (3^level - 1)/2
# 2*X+1 <= 3^level
# level >= log3(2*X+1)
#
# X < 1 + 3^0+3^1+...+3^(level-1)
# X < 1 + (3^level - 1)/2
# (3^level - 1)/2 > X-1
# 3^level - 1 > 2*X-2
# 3^level > 2*X-1
#
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### PyramidReplicate rect_to_n_range(): "$x1,$y1 $x2,$y2"
my $max = abs(round_nearest($x1));
foreach ($y1, $x2, $y2) {
my $m = abs(round_nearest($_));
if ($m > $max) { $max = $m }
}
my ($len,$level) = round_down_pow (2*($max||1)-1, 3);
return (0, 9*$len*$len - 1); # 9^level-1
}
1;
__END__
=for stopwords eg Ryde Math-PlanePath aabbccdd
=head1 NAME
Math::PlanePath::PyramidReplicate -- replicating squares
=head1 SYNOPSIS
use Math::PlanePath::PyramidReplicate;
my $path = Math::PlanePath::PyramidReplicate->new;
my ($x, $y) = $path->n_to_xy (123);
=head1 DESCRIPTION
This is a self-similar replicating pyramid shape made from 4 points each,
4
3
2
1
<- Y=0
-1
-2
-3
-4
^
-4 -3 -2 -1 X=0 1 2 3 4
The base shape is the initial N=0 to N=8 section,
+---+
| 2 |
+---+---+---+
| 3 | 0 | 1 |
+---+---+---+
It then repeats inverted to make a similar shape but upside-down,
+---+---+---+---+---+---+---+
| 5 4 7 | 2 |13 12 15 |
+---+ +---+ +---+ +---+
| 6 | 3 0 1 |14 |
+---+---+---+---+---+
| 9 8 11 |
+---+ +---+
|10 |
+---+
=head2 Level Ranges
A given replication extends to ...
Nlevel = 4^level - 1
- ... <= X <= ...
- ... <= Y <= ...
=head2 Complex Base
This pattern corresponds to expressing a complex integer X+i*Y in base b=...
X+Yi = a[n]*b^n + ... + a[2]*b^2 + a[1]*b + a[0]
using complex digits a[i] encoded in N in integer base 4 ...
a[i] digit N digit
---------- -------
0 0
1 1
i 2
-1 3
=head1 FUNCTIONS
See L for the behaviour common to all path
classes.
=over 4
=item C<$path = Math::PlanePath::PyramidReplicate-Enew ()>
Create and return a new path object.
=item C<($x,$y) = $path-En_to_xy ($n)>
Return the X,Y coordinates of point number C<$n> on the path. Points begin
at 0 and if C<$n E 0> then the return is an empty list.
=back
=head1 SEE ALSO
L,
L,
L,
L,
L,
L
=head1 HOME PAGE
L
=head1 LICENSE
Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along with
Math-PlanePath. If not, see .
=cut
Math-PlanePath-122/devel/lib/Math/PlanePath/wythoff-lines.pl 0000644 0001750 0001750 00000002540 12375744415 021461 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013, 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::WythoffLines;
{
foreach my $shift (-3 .. 17) {
my $path = Math::PlanePath::WythoffLines->new (shift => $shift);
my $x_minimum = $path->x_minimum;
my $y_minimum = $path->y_minimum;
my $m = Math::PlanePath::WythoffLines::_calc_minimum($shift);
printf "%2d %4d %4d %4d\n", $shift, $m, $x_minimum, $y_minimum;
}
exit 0;
}
{
my @values;
for (my $shift = 8; $shift < 28; $shift += 2) {
push @values, Math::PlanePath::WythoffLines::_calc_minimum($shift);
}
print join(',',@values),"\n";
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array=>\@values);
exit 0;
}
Math-PlanePath-122/devel/lib/Math/PlanePath/NxNvar.pm 0000644 0001750 0001750 00000006020 12606435145 020067 0 ustar gg gg # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::PlanePath::NxNvar;
use 5.004;
use strict;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
#use Smart::Comments;
use constant n_start => 0;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
sub n_to_xy {
my ($self, $n) = @_;
### NxN n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
# d = [ 0, 1, 2, 3, 4 ]
# n = [ 0, 1, 3, 6, 10 ]
# N = (d+1)*d/2
# d = (-1 + sqrt(8*$n+1))/2
my $d = int((sqrt(8*$n+1) - 1) / 2);
$n -= $d*($d+1)/2;
### $d
### $n
my $x = $d-$n; # downwards
my $y = $n; # upwards
my $diff = $x-$y;
### diagonals xy: "$x, $y diff=$diff"
if ($diff < 0) {
return (2*$x + (($diff+1) % 2),
2*$x + int((-$diff + ($diff%2))/2));
} elsif ($diff < 3) {
return (2*$y + $diff,
2*$y);
} else {
return (2*$y + int(($diff+1)/2) + (($diff+1) % 2),
2*$y + ($diff % 2));
}
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### NxN xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 0 || $y < 0) {
return undef;
}
return undef;
if ($x <= $y) {
my $h = int($x/2);
($x,$y) = ($h,
$h + ($x%2) + 2*($y - 2*$h - ($x%2)));
} else {
my $h = int($y/2);
($x,$y) = (1 + $h + ($y%2) + 2*($x-1 - 2*$h - ($y%2)),
$h);
}
return (($x+$y)**2 + $x+3*$y)/2;
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### NxN rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 0 || $y2 < 0) {
### all outside first quadrant ...
return (1, 0);
}
return (0, $x2 * $y2);
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/godfrey.pl 0000644 0001750 0001750 00000002772 12375744415 020331 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.010;
use strict;
use POSIX ();
use List::Util 'sum';
use Math::PlanePath::Base::Digits
'round_down_pow',
'digit_split_lowtohigh',
'digit_join_lowtohigh';
use Math::PlanePath::Godfrey;
# uncomment this to run the ### lines
use Smart::Comments;
{
my $path = Math::PlanePath::Godfrey->new;
foreach my $n (1 .. 1+2+3+4+5+6+7) {
my ($x,$y) = $path->n_to_xy($n);
print "$y,";
}
print "\n";
exit 0;
}
{
require Math::NumSeq::OEIS::File;
my $seq = Math::NumSeq::OEIS::File->new(anum=>'A126572'); # OFFSET=1
my $perm = Math::NumSeq::OEIS::File->new(anum=>'A038722'); # OFFSET=1
my @values;
foreach my $n (1 .. 1+2+3+4+5+6+7) {
my $pn = $perm->ith($n);
push @values, $seq->ith($n);
}
require Math::OEIS::Grep;
Math::OEIS::Grep->search(array => \@values);
exit 0;
}
Math-PlanePath-122/devel/lib/Math/PlanePath/WythoffDifference-oeis.t 0000644 0001750 0001750 00000006545 12113223613 023040 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
use Test;
plan tests => 46;
use lib 't','xt';
use MyTestHelpers;
MyTestHelpers::nowarnings();
use MyOEIS;
use Math::PlanePath::WythoffDifference;
sub BIGINT {
require Math::NumSeq::PlanePathN;
return Math::NumSeq::PlanePathN::_bigint();
}
#------------------------------------------------------------------------------
# A191361 -- Wythoff difference array X-Y, diagonal containing n
MyOEIS::compare_values
(anum => 'A191361',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::WythoffDifference->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $x-$y;
}
return \@got;
});
#------------------------------------------------------------------------------
# A080164 -- Wythoff difference array by anti-diagonals
MyOEIS::compare_values
(anum => 'A080164',
func => sub {
my ($count) = @_;
require Math::PlanePath::Diagonals;
my $path = Math::PlanePath::WythoffDifference->new;
my $diag = Math::PlanePath::Diagonals->new (direction => 'up');
my @got;
for (my $d = $diag->n_start; @got < $count; $d++) {
my ($x,$y) = $diag->n_to_xy($d); # by anti-diagonals
push @got, $path->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A000201 -- Wythoff difference Y axis
# lower Wythoff sequence, spectrum of phi
MyOEIS::compare_values
(anum => 'A000201',
max_count => 200,
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffDifference->new;
my @got;
for (my $y = BIGINT()->new(0); @got < $count; $y++) {
push @got, $path->xy_to_n (0, $y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A001519 -- Wythoff difference X axis, a(n) = 3*a(n-1) - a(n-2)
# A122367
MyOEIS::compare_values
(anum => 'A122367',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffDifference->new;
my @got;
for (my $x = BIGINT()->new(0); @got < $count; $x++) {
push @got, $path->xy_to_n ($x, 0);
}
return \@got;
});
MyOEIS::compare_values
(anum => 'A001519',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffDifference->new;
my @got = (1); # extra initial 1
for (my $x = BIGINT()->new(0); @got < $count; $x++) {
push @got, $path->xy_to_n ($x, 0);
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/devel/lib/Math/PlanePath/BalancedArray.pm 0000644 0001750 0001750 00000006425 12606435146 021355 0 ustar gg gg # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::PlanePath::BalancedArray;
use 5.004;
use strict;
use List::Util 'max';
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::NumSeq::BalancedBinary;
# uncomment this to run the ### lines
#use Smart::Comments;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant xy_is_visited => 1;
sub new {
my $self = shift->SUPER::new (@_);
$self->{'seq'} = Math::NumSeq::BalancedBinary->new;
return $self;
}
sub n_to_xy {
my ($self, $n) = @_;
### BalancedArray n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n) || $n == 0) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
my $value = $self->{'seq'}->ith($n)||0;
### value: sprintf '%#b', $value
my $x = 0;
while (($value % 4) == 2) {
$x++;
$value -= 2;
$value /= 4;
}
return ($x,
$value ? $self->{'seq'}->value_to_i($value) : 0);
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### BalancedArray xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 0 || $y < 0) {
return undef;
}
my $zero = $x * 0 * $y;
if (is_infinite($x)) { return $x; }
if (is_infinite($y)) { return $y; }
my $value = $self->{'seq'}->ith($y) || 0;
### value at y: $value
my $pow = (4+$zero)**$x;
$value *= $pow;
$value += 2*($pow-1)/3;
### mul: sprintf '%#b', $pow
### add: sprintf '%#b', 2*($pow-1)/3
### value: sprintf '%#b', $value
### $value
### value: ref $value && $value->as_bin
return $self->{'seq'}->value_to_i($value);
}
# exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### BalancedArray rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 0 || $y2 < 0) {
### all outside first quadrant ...
return (1, 0);
}
# bottom left into first quadrant
if ($x1 < 0) { $x1 *= 0; }
if ($y1 < 0) { $y1 *= 0; }
return (0,
4**($x2+$y2));
return ($self->xy_to_n($x1,$y1), # bottom left
$self->xy_to_n($x2,$y2)); # top right
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/WythoffTriangle-oeis.t 0000644 0001750 0001750 00000003750 12112751302 022546 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'max';
use Test;
plan tests => 46;
use lib 't','xt';
use MyTestHelpers;
MyTestHelpers::nowarnings();
use MyOEIS;
use Math::PlanePath::WythoffTriangle;
#------------------------------------------------------------------------------
# A166310 Wythoff Triangle, N by rows
MyOEIS::compare_values
(anum => 'A166310',
func => sub {
my ($count) = @_;
require Math::PlanePath::PyramidRows;
my $path = Math::PlanePath::WythoffTriangle->new;
my $rows = Math::PlanePath::PyramidRows->new (step=>1);
my @got;
for (my $r = $rows->n_start; @got < $count; $r++) {
my ($x,$y) = $rows->n_to_xy($r); # by rows
$y += 1;
push @got, $path->xy_to_n($x,$y);
}
return \@got;
});
#------------------------------------------------------------------------------
# A165359 column 1 of left justified Wythoff, gives triangle Y
MyOEIS::compare_values
(anum => 'A165359',
func => sub {
my ($count) = @_;
my $path = Math::PlanePath::WythoffTriangle->new;
my @got;
for (my $n = $path->n_start; @got < $count; $n++) {
my ($x,$y) = $path->n_to_xy($n);
push @got, $y;
}
return \@got;
});
#------------------------------------------------------------------------------
exit 0;
Math-PlanePath-122/devel/lib/Math/PlanePath/PowerRows.pm 0000644 0001750 0001750 00000007575 12606435145 020642 0 ustar gg gg # Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::PlanePath::PowerRows;
use 5.004;
use strict;
#use List::Util 'min', 'max';
*min = \&Math::PlanePath::_min;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'round_down_pow';
use constant class_y_negative => 0;
use constant n_frac_discontinuity => .5;
use constant parameter_info_array =>
[ Math::PlanePath::Base::Digits::parameter_info_radix2(),
{ name => 'align',
type => 'enum',
share_key => 'align_rl',
display => 'Align',
default => 'right',
choices => ['right', 'left'],
choices_display => ['Right', 'Left'],
},
];
sub x_minimum {
my ($self) = @_;
return ($self->{'align'} eq 'right' ? 0 : undef);
}
sub x_maximum {
my ($self) = @_;
return ($self->{'align'} eq 'left' ? 0 : undef);
}
#------------------------------------------------------------------------------
sub new {
my $self = shift->SUPER::new(@_);
$self->{'align'} ||= 'right';
$self->{'radix'} ||= 2;
return $self;
}
# Nrow = 1/2 + (r + r + r^2 + ... + r^(depth-1))
# = 1/2 + (r^depth - 1) / (r-1)
# (N-1/2)*(r-1) = r^depth - 1
# r^depth = (N-1/2)*(r-1) + 1
# = (2N-1)*(r-1)/2 + 1
# 2Nrow = 1 + 2*(r^depth - 1) / (r-1);
# = 1 + 2*(pow - 1) / (r-1);
#
sub n_to_xy {
my ($self, $n) = @_;
### PowerRows n_to_xy(): $n
$n *= 2;
if ($n < 1) { return; }
if (is_infinite($n)) { return ($n,$n); }
my $radix = $self->{'radix'};
my ($pow, $y) = round_down_pow (($n-1)*($radix-1)/2 + 1,
$radix);
if ($self->{'align'} eq 'left') {
$n -= 2*$pow;
} else {
$n -= 2;
}
return ($n/2 - ($pow-1)/($radix-1), $y);
}
# uncomment this to run the ### lines
# use Smart::Comments;
sub xy_to_n {
my ($self, $x, $y) = @_;
### PowerRows xy_to_n(): "$x, $y"
$y = round_nearest ($y);
if ($y < 0) {
### all Y negative ...
return undef;
}
my $radix = $self->{'radix'};
my $zero = $x * 0 * $y;
$y = ($radix + $zero) ** $y;
### Y power: $y
$x = round_nearest ($x);
if ($self->{'align'} eq 'left') {
if ($x > 0 || $x <= -$y) {
### X outside 0 to -R^Y ...
return undef;
}
$x += $y;
$x -= 1;
} else {
if ($x < 0 || $x >= $y) {
### X outside 0 to R^Y ...
return undef;
}
}
# Nrow = 1 + (r^depth - 1) / (r-1)
return $x + ($y-1)/($radix-1) + 1;
}
# Nrow = 1 + (r^Y - 1) / (r-1)
# Nlast = Nrow(Y+1)-1
# = 1 + (r^(Y+1) - 1) / (r-1) - 1
# = (r^(Y+1) - 1) / (r-1)
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### PowerRows rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($y2 < 0
|| ($self->{'align'} eq 'right' ? $x2 < 0 : $x1 > 0)) {
### all outside ...
return (1, 0);
}
my $radix = $self->{'radix'};
my $zero = $x1 * 0 * $x2 * $y1 * $y2;
return (1,
(($radix + $zero) ** ($y2+1) - 1) / ($radix-1))
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/PeanoHalf.pm 0000644 0001750 0001750 00000023731 12606435145 020520 0 ustar gg gg # Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# math-image --path=PeanoHalf,arms=2 --all --output=numbers_dash
# http://www.nahee.com/spanky/www/fractint/lsys/variations.html
# http://www.nahee.com/spanky/www/fractint/lsys/moore.gif
# William McWorter mcworter@midohio.net
package Math::PlanePath::PeanoHalf;
use 5.004;
use strict;
use List::Util 'min'; # 'max'
*max = \&Math::PlanePath::_max;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::PeanoCurve;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'round_down_pow';
# uncomment this to run the ### lines
#use Smart::Comments;
use constant n_start => 0;
use constant parameter_info_array =>
[ { name => 'radix',
share_key => 'radix_3',
display => 'Radix',
type => 'integer',
minimum => 2,
default => 3,
width => 3,
},
{ name => 'arms',
share_key => 'arms_2',
display => 'Arms',
type => 'integer',
minimum => 1,
maximum => 2,
default => 1,
width => 1,
description => 'Arms',
} ];
sub new {
my $self = shift->SUPER::new(@_);
if (! $self->{'radix'} || $self->{'radix'} < 2) {
$self->{'radix'} = 3;
}
$self->{'arms'} = max(1, min(2, $self->{'arms'} || 1));
return $self;
}
sub n_to_xy {
my ($self, $n) = @_;
### PeanoHalf n_to_xy(): $n
if ($n < 0) { return; }
my $arms = $self->{'arms'};
my $x_reverse;
if ($arms > 1) {
my $int = int($n);
my $x_reverse = _divrem_mutate($int,2);
$int = -$int;
} else {
$x_reverse = 0;
}
my $radix = $self->{'radix'};
my ($len, $level) = round_down_pow (2*$n*$radix, $radix);
### $len
### peano at: $n + ($len*$len-1)/2
my ($x,$y) = $self->Math::PlanePath::PeanoCurve::n_to_xy($n + ($len*$len-1)/2);
my $half = ($len-1)/2;
my $y_reverse;
if ($radix % 2) {
$x_reverse ^= ($level & 1);
$y_reverse = $x_reverse ^ 1;
} else {
$y_reverse = $x_reverse;
}
if ($x_reverse) {
$x = $half - $x;
} else {
$x -= $half;
}
if ($y_reverse) {
$y = $half - $y;
} else {
$y -= $half;
}
return ($x, $y);
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### PeanoHalf xy_to_n(): "$x, $y"
return undef;
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### PeanoHalf rect_to_n_range(): "$x1,$y1, $x2,$y2"
$x1 = round_nearest ($x1);
$x2 = round_nearest ($x2);
$y1 = round_nearest ($y1);
$y2 = round_nearest ($y2);
my $radix = $self->{'radix'};
my $zero = ($x1 * 0 * $y1 * $x2 * $y2); # inherit bignum
my ($len, $level) = round_down_pow ($zero + max(abs($x1),abs($y1),
abs($x2),abs($y2))*2-1,
$radix);
### $len
### $level
$len *= $radix;
return (0,
($len*$len - 1) * $self->{'arms'} / 2);
}
1;
__END__
=for stopwords eg Ryde ie PeanoHalf Math-PlanePath Moore
=head1 NAME
Math::PlanePath::PeanoHalf -- 9-segment self-similar spiral
=head1 SYNOPSIS
use Math::PlanePath::PeanoHalf;
my $path = Math::PlanePath::PeanoHalf->new;
my ($x, $y) = $path->n_to_xy (123);
=head1 DESCRIPTION
This is an integer version of a 9-segment self-similar curve by ...
=cut
# math-image --path=PeanoHalf --expression='i<=44?i:0' --output=numbers_dash
=pod
7-- 6-- 5-- 4-- 3-- 2 1
| |
8-- 9--10 0-- 1 <- Y=0
|
13--12--11 -1
|
14--15--16 29--30--31--32--33--34 -2
| | |
19--18--17 28--27--26 37--36--35 ...--44 -3
| | | |
20--21--22--23--24--25 38--39--40--41--42--43 -4
^
-4 -3 -2 -1 X=0 1 2 3 4 5 6 7
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
******************************************************
*************************** *********
*************************** *********
*************************** *********
*************************** ****** *********
*************************** *** ** *********
*************************** *** *********
*************************** ******************
*************************** ******************
*************************** ******************
***************************
***************************
***************************
***************************
***************************
***************************
***************************
***************************
***************************
=head2 Arms
The optional C 2> parameter can give a second copy of the spiral
rotated 180 degrees. With two arms all points of the plane are covered.
93--91 81--79--77--75 57--55 45--43--41--39 122-124 ..
| | | | | | | | | | |
95 89 83 69--71--73 59 53 47 33--35--37 120 126 132
| | | | | | | | | | |
97 87--85 67--65--63--61 51--49 31--29--27 118 128-130
| | |
99-101-103 22--20 10-- 8-- 6-- 4 13--15 25 116-114-112
| | | | | | | | |
109-107-105 24 18 12 1 0-- 2 11 17 23 106-108-110
| | | | | | | | |
111-113-115 26 16--14 3-- 5-- 7-- 9 19--21 104-102-100
| | |
129-127 117 28--30--32 50--52 62--64--66--68 86--88 98
| | | | | | | | | | |
131 125 119 38--36--34 48 54 60 74--72--70 84 90 96
| | | | | | | | | | |
.. 123-121 40--42--44--46 56--58 76--78--80--82 92--94
The first arm is the even numbers N=0,2,4,etc and the second arm is the odd
numbers N=1,3,5,etc.
=head1 FUNCTIONS
See L for the behaviour common to all path
classes.
=over 4
=item C<$path = Math::PlanePath::PeanoHalf-Enew ()>
Create and return a new path object.
=item C<($x,$y) = $path-En_to_xy ($n)>
Return the X,Y coordinates of point number C<$n> on the path. Points begin
at 0 and if C<$n E 0> then the return is an empty list.
=back
=head1 FORMULAS
=head2 X,Y to N
The correspondence to Wunderlich's 3x3 serpentine curve can be used to turn
X,Y coordinates in base 3 into an N. Reckoning the innermost 3x3 as level=1
then the smallest abs(X) or abs(Y) in a level is
Xlevelmin = (3^level + 1) / 2
eg. level=2 Xlevelmin=5
which can be reversed as
level = log3floor( max(abs(X),abs(Y)) * 2 - 1 )
eg. X=7 level=log3floor(2*7-1)=2
An offset can be applied to put X,Y in the range 0 to 3^level-1,
offset = (3^level-1)/2
eg. level=2 offset=4
Then a table can give the N base-9 digit corresponding to X,Y digits
Y=2 4 3 2 N digit
Y=1 -1 0 1
Y=0 -2 -3 -4
X=0 X=1 X=2
A current rotation maintains the "S" part directions and is updated by a
table
Y=2 0 +3 0 rotation when descending
Y=1 +1 +2 +1 into sub-part
Y=0 0 +3 0
X=0 X=1 X=2
The negative digits of N represent backing up a little in some higher part.
If N goes negative at any state then X,Y was off the main curve and instead
on the second arm. If the second arm is not of interest the calculation can
stop at that stage.
It no doubt would also work to take take X,Y as balanced ternary digits
1,0,-1, but it's not clear that would be any faster or easier to calculate.
=head1 SEE ALSO
L,
L
=head1 HOME PAGE
L
=head1 LICENSE
Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along with
Math-PlanePath. If not, see .
=cut
Math-PlanePath-122/devel/lib/Math/PlanePath/Z2DragonCurve.pm 0000644 0001750 0001750 00000011370 12606435144 021311 0 ustar gg gg # Copyright 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# much overlap
package Math::PlanePath::Z2DragonCurve;
use 5.004;
use strict;
use List::Util 'min'; # 'max'
*max = \&Math::PlanePath::_max;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath;
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest',
'xy_is_even';
use Math::PlanePath::Base::Digits
'digit_split_lowtohigh';
use vars '$VERSION', '@ISA';
$VERSION = 122;
@ISA = ('Math::PlanePath');
# uncomment this to run the ### lines
# use Smart::Comments;
use constant n_start => 0;
#------------------------------------------------------------------------------
#
# .
# h
# .
# .........
# .
# ....g...
# . .
# . . .
# . .
# .. f..10---d--11
# . |
# 7...|....
# | | .
# 8---c---9 e
# | .
# 6-------5 3
# |
# 2---b---3 2
# | |
# | 4 1
# |
# 0---a---1 0
#
# 0 1 2 3 4
# 10---*--11
# |
# 7 |
# | |
# 8---*---9
# |
# 6-------5
# \ / | \
# 2--/*---3
# /|\ |/ \
# | 4
# \ / \|/ /
# 0---*---1
# \ / / \
sub n_to_xy {
my ($self, $n) = @_;
### Z2DragonCurve n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n, $n); }
my $zero = ($n * 0); # inherit bignum 0
{
# high to low
my $x = 0;
my $y = 0;
my $dx = 1;
my $dy = 0;
# return if $n >=9;
my $lowdigit = _divrem_mutate($n, 4);
my @digits = digit_split_lowtohigh($n,3);
foreach my $digit (reverse(@digits), $lowdigit) {
### at: "$x,$y digit=$digit"
($x,$y) = ($x-$y,$x+$y); # rotate +45
$x += 1;
### rotate to: "$x,$y"
if ($digit == 0) {
$x -= $dx;
$y -= $dy;
} elsif ($digit == 1) {
$x += $dx;
$y += $dy;
($dx,$dy) = (-$dy,$dx); # rotate +90
} elsif ($digit == 2) {
$x += $dx - 2*$dy; # across then at +90
$y += $dy + 2*$dx;
} elsif ($digit == 3) {
$x += 3*$dx - 2*$dy; # across then at +90, for $lowdigit
$y += 3*$dy + 2*$dx;
}
}
### return: "$x,$y"
return ($x,$y);
}
{
# low to high
my $x = 0;
my $y = 0;
my $dx = 1 + $zero;
my $dy = $zero;
return if $n >=16;
my $lowdigit = _divrem_mutate($n, 3);
if ($lowdigit == 0) {
} elsif ($lowdigit == 1) {
$x = 2;
} elsif ($lowdigit == 2) {
$x = 2;
$y = 2;
} elsif ($lowdigit == 3) {
$x = 4;
$y = 2;
}
foreach my $digit (digit_split_lowtohigh($n,3)) {
# $dx *= 2;
# $dy *= 2;
($dx,$dy) = ($dx+$dy,$dy-$dx); # rotate 45
# ($dx,$dy) = (-$dy,$dx); # rotate +90
if ($digit == 0) {
} elsif ($digit == 1) {
($x,$y) = (-$y,$x); # rotate +90
$x += 3/2*$dx;
$y += 3/2*$dy;
($dx,$dy) = (-$dy,$dx); # rotate +90
$x += 1/2*$dx;
$y += 1/2*$dy;
} elsif ($digit == 2) {
$x -= 4/2*$dy;
$y += 4/2*$dx;
}
}
return ($x,$y);
}
}
sub xy_to_n {
my ($self, $x, $y) = @_;
return undef;
}
# minimum -- no, not quite right
#
# *----------*
# \
# \ *
# * \
# \
# *----------*
#
# width = side/2
# minimum = side*sqrt(3)/2 - width
# = side*(sqrt(3)/2 - 1)
#
# minimum 4/9 * 2.9^level roughly
# h = 4/9 * 2.9^level
# 2.9^level = h*9/4
# level = log(h*9/4)/log(2.9)
# 3^level = 3^(log(h*9/4)/log(2.9))
# = h*9/4, but big bigger for log
#
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### Z2DragonCurve rect_to_n_range(): "$x1,$y1 $x2,$y2"
my $xmax = int(max(abs($x1),abs($x2)));
my $ymax = int(max(abs($y1),abs($y2)));
return (0,
($xmax*$xmax + $ymax*$ymax + 1));
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/NxN.pm 0000644 0001750 0001750 00000006025 12606435145 017363 0 ustar gg gg # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::PlanePath::NxN;
use 5.004;
use strict;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
#use Smart::Comments;
use constant n_start => 0;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
sub n_to_xy {
my ($self, $n) = @_;
### NxN n_to_xy(): $n
if ($n < 0) { return; }
if (is_infinite($n)) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
# d = [ 0, 1, 2, 3, 4 ]
# n = [ 0, 1, 3, 6, 10 ]
# N = (d+1)*d/2
# d = (-1 + sqrt(8*$n+1))/2
my $d = int((sqrt(8*$n+1) - 1) / 2);
$n -= $d*($d+1)/2;
### $d
### $n
my $x = $d-$n; # downwards
my $y = $n; # upwards
my $diff = $x-$y;
### diagonals xy: "$x, $y diff=$diff"
if ($diff <= 0) {
### non-pos diff, use x ...
return (2*$x + ($diff % 2),
2*$x + int((1-$diff)/2));
} else {
### pos diff, use y ...
return (2*($y+1) - 1 + int($diff/2),
2*$y + (($diff+1) % 2));
}
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### NxN xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 0 || $y < 0) {
return undef;
}
if ($x <= $y) {
my $h = int($x/2);
($x,$y) = ($h,
$h + ($x%2) + 2*($y - 2*$h - ($x%2)));
} else {
my $h = int($y/2);
($x,$y) = (1 + $h + ($y%2) + 2*($x-1 - 2*$h - ($y%2)),
$h);
}
return (($x+$y)**2 + $x+3*$y)/2;
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### NxN rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
if ($x2 < 0 || $y2 < 0) {
### all outside first quadrant ...
return (1, 0);
}
if ($x1 < 0) { $x1 *= 0; }
if ($y1 < 0) { $y1 *= 0; }
return (0, $x2 * $y2);
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/PlanePath/z2-dragon.pl 0000644 0001750 0001750 00000005667 12300052537 020464 0 ustar gg gg # Copyright 2014 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use strict;
use Math::PlanePath::Z2DragonCurve;
{
require Image::Base::GD;
my $width = 1010;
my $height = 710;
my $image = Image::Base::GD->new (-width => $width, -height => $height);
$image->rectangle (0,0, $width-1,$height-1, 'black');
# -7/3 to +7/3
my @lines = ([int($width * .29), int($height*.5),
int($width * .71), int($height*.5)]);
foreach my $level (1 .. 10) {
my @new_lines;
foreach my $line (@lines) {
my ($x1,$y1, $x2,$y2) = @$line;
my $dx = ($x2 - $x1) / 4;
my $dy = ($y2 - $y1) / 4;
push @new_lines, [ $x1 - $dx + $dy,
$y1 - $dy - $dx,
$x1 + $dx - $dy,
$y1 + $dy + $dx ];
push @new_lines, [ $x1 + $dx - $dy,
$y1 + $dy + $dx,
$x2 - $dx + $dy,
$y2 - $dy - $dx ];
push @new_lines, [ $x2 - $dx + $dy,
$y2 - $dy - $dx,
$x2 + $dx - $dy,
$y2 + $dy + $dx ];
}
# push @lines, @new_lines;
@lines = @new_lines;
}
foreach my $line (@lines) {
$image->line (@$line, 'white');
}
# $image->ellipse ($x_offset-2,$y_offset-2,
# $x_offset+2,$y_offset+2, 'red');
$image->save('/tmp/x.png');
system('xzgv /tmp/x.png');
exit 0;
}
{
require Image::Base::GD;
my $width = 1210;
my $height = 810;
my $x_offset = int($width * .3);
my $y_offset = int($height * .2);
my $image = Image::Base::GD->new (-width => $width, -height => $height);
$image->rectangle (0,0, $width-1,$height-1, 'black');
my $foreground = 'white';
my $path = Math::PlanePath::Z2DragonCurve->new;
my $scale = 10;
foreach my $n (0 .. 100000) {
next if $n % 4 == 3;
my ($x1,$y1) = $path->n_to_xy($n);
my ($x2,$y2) = $path->n_to_xy($n+1);
$y1 = -$y1;
$y2 = -$y2;
$x1 *= $scale;
$y1 *= $scale;
$x2 *= $scale;
$y2 *= $scale;
$x1 += $x_offset;
$x2 += $x_offset;
$y1 += $y_offset;
$y2 += $y_offset;
$image->line ($x1,$y1, $x2,$y2, 'white');
}
$image->ellipse ($x_offset-2,$y_offset-2,
$x_offset+2,$y_offset+2, 'red');
$image->save('/tmp/x.png');
system('xzgv /tmp/x.png');
exit 0;
}
Math-PlanePath-122/devel/lib/Math/PlanePath/ZeckendorfTerms.pm 0000644 0001750 0001750 00000007602 12606435144 021766 0 ustar gg gg # Copyright 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# A134561 triangle T(n,k) = k-th number whose Zeckendorf has exactly n terms
# 4180 5777 6387 6620 6709 6743 6756 6761 6763 6764 8361
# 1596 2206 2439 2528 2562 2575 2580 2582 2583 3193 3426
# 609 842 931 965 978 983 985 986 1219 1308 1342
# 232 321 355 368 373 375 376 465 499 512 517
# 88 122 135 140 142 143 177 190 195 197 198
# 33 46 51 53 54 67 72 74 75 80 82
# 12 17 19 20 25 27 28 30 31 32 38
# 4 6 7 9 10 11 14 15 16 18 22
# 1 2 3 5 8 13 21 34 55 89 144
# Y=1 Fibonacci
# Y=2 A095096
# X=1 first with Y many bits is Zeck 101010101
# A027941 Fib(2n+1)-1
# X=2 second with Y many bits is Zeck 1001010101 high 1, low 10101
# A005592 F(2n+1)+F(2n-1)-1
# X=3 third with Y many bits is Zeck 1010010101
# A005592 F(2n+1)+F(2n-1)-1
# X=4 fourth with Y many bits is Zeck 1010100101
package Math::PlanePath::ZeckendorfTerms;
use 5.004;
use strict;
use List::Util 'max';
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
# uncomment this to run the ### lines
# use Smart::Comments;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant y_minimum => 1;
use constant x_minimum => 1;
use Math::NumSeq::FibbinaryBitCount;
my $fbc = Math::NumSeq::FibbinaryBitCount->new;
my $next_n = 1;
my @n_to_x;
my @n_to_y;
my @yx_to_n;
sub _extend {
my ($self) = @_;
my $n = $next_n++;
my $y = $fbc->ith($n);
my $row = ($yx_to_n[$y] ||= []);
my $x = scalar(@$row) || 1;
$row->[$x] = $n;
$n_to_x[$n] = $x;
$n_to_y[$n] = $y;
}
sub n_to_xy {
my ($self, $n) = @_;
### ZeckendorfTerms n_to_xy(): $n
if ($n < 1) { return; }
if (is_infinite($n) || $n == 0) { return ($n,$n); }
{
# fractions on straight line ?
my $int = int($n);
if ($n != $int) {
my $frac = $n - $int; # inherit possible BigFloat/BigRat
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int;
}
my $y = $fbc->ith($n);
while ($next_n <= $n) {
_extend($self);
}
### $self
return ($n_to_x[$n], $n_to_y[$n]);
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### ZeckendorfTerms xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 1 || $y < 1) { return undef; }
if (is_infinite($x)) { return $x; }
if (is_infinite($y)) { return $y; }
for (;;) {
if (defined (my $n = $yx_to_n[$y][$x])) {
return $n;
}
_extend($self);
}
}
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### ZeckendorfTerms rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
return (1, 1000);
# increasing horiziontal and vertical
return (1, $self->xy_to_n($x2,$y2));
}
1;
__END__
=cut
# math-image --path=ZeckendorfTerms --output=numbers --all --size=60x14
=pod
Math-PlanePath-122/devel/lib/Math/PlanePath/PeanoRounded.pm 0000644 0001750 0001750 00000034005 12606435145 021242 0 ustar gg gg # works, worth having separately ?
# alternating diagonals when even radix ?
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# math-image --path=PeanoRounded --all --output=numbers
# math-image --path=PeanoRounded,radix=5 --lines
#
package Math::PlanePath::PeanoRounded;
use 5.004;
use strict;
#use List::Util 'max';
*max = \&Math::PlanePath::_max;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'round_down_pow',
'digit_split_lowtohigh';
# uncomment this to run the ### lines
#use Smart::Comments;
use constant n_start => 0;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
use constant parameter_info_array =>
[ { name => 'radix',
share_key => 'radix_3',
display => 'Radix',
type => 'integer',
minimum => 2,
default => 3,
width => 3,
} ];
sub new {
my $self = shift->SUPER::new(@_);
if (! $self->{'radix'} || $self->{'radix'} < 2) {
$self->{'radix'} = 3;
}
return $self;
}
sub n_to_xy {
my ($self, $n) = @_;
### PeanoRounded n_to_xy(): $n
if ($n < 0) { # negative
return;
}
if (is_infinite($n)) {
return ($n,$n);
}
{
# ENHANCE-ME: for odd radix the ends join and the direction can be had
# without a full N+1 calculation
my $int = int($n);
### $int
### $n
if ($n != $int) {
my ($x1,$y1) = $self->n_to_xy($int);
my ($x2,$y2) = $self->n_to_xy($int+1);
my $frac = $n - $int; # inherit possible BigFloat
my $dx = $x2-$x1;
my $dy = $y2-$y1;
return ($frac*$dx + $x1, $frac*$dy + $y1);
}
$n = $int; # BigFloat int() gives BigInt, use that
}
# low to high
my $x = _divrem_mutate($n,2);
my $y = $x;
my $power = ($n * 0) + 2; # inherit BigInt 2
my $radix = $self->{'radix'};
my @digits = digit_split_lowtohigh($n,$radix);
while (@digits) {
### $n
### $power
{
my $digit = shift @digits; # low to high
if ($digit & 1) {
$y = $power-1 - $y; # 99..99 - Y
}
$x += $power * $digit;
}
last unless @digits;
{
my $digit = shift @digits; # low to high
$y += $power * $digit;
$power *= $radix;
if ($digit & 1) {
$x = $power-1 - $x;
}
}
}
return ($x, $y);
# # high to low
# my $radix = $self->{'radix'};
# my $radix_minus_1 = $radix - 1;
# my (@n);
# while ($n) {
# push @n, $n % $radix; $n = int($n/$radix);
# push @n, $n % $radix; $n = int($n/$radix);
# }
# my $x = 0;
# my $y = 0;
# my $xk = 0;
# my $yk = 0;
# while (@n) {
# {
# my $digit = pop @n;
# $xk ^= $digit;
# $y *= $radix;
# $y += ($yk & 1 ? $radix_minus_1-$digit : $digit);
# }
# {
# my $digit = pop @n;
# $yk ^= $digit;
# $x *= $radix;
# $x += ($xk & 1 ? $radix_minus_1-$digit : $digit);
# }
# }
# ### is: "$x,$y"
# return ($x, $y);
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### PeanoRounded xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 0 || $y < 0) {
return undef;
}
if (is_infinite($x)) {
return $x;
}
if (is_infinite($y)) {
return $y;
}
my $xlow = _divrem_mutate ($x, 2);
my $ylow = _divrem_mutate ($y, 2);
my $radix = $self->{'radix'};
my $radix_minus_1 = $radix - 1;
my @x = digit_split_lowtohigh($x,$radix);
my @y = digit_split_lowtohigh($y,$radix);
push @x, (0) x max(0, scalar(@y) - scalar(@x));
push @y, (0) x max(0, scalar(@x) - scalar(@y));
my $xk = 0;
my $yk = 0;
my $n = 0;
while (@x) {
{
my $digit = pop @y || 0;
if ($yk & 1) {
$digit = $radix_minus_1 - $digit;
}
$n = ($n * $radix) + $digit;
$xk ^= $digit;
}
{
my $digit = pop @x || 0;
if ($xk & 1) {
$digit = $radix_minus_1 - $digit;
}
$n = ($n * $radix) + $digit;
$yk ^= $digit;
}
}
if ($yk & 1) {
$ylow = 1-$ylow;
}
if ($xk & 1) {
$xlow = 1-$xlow;
}
$n *= 2;
if ($xlow == 0 && $ylow == 0) {
return $n;
} elsif ($xlow == 1 && $ylow == 1) {
return $n + 1;
}
return undef;
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
### rect_to_n_range(): "$x1,$y1 to $x2,$y2"
if ($x2 < 0 || $y2 < 0) {
return (1, 0);
}
my $radix = $self->{'radix'};
my ($power, $level) = round_down_pow (max($x2,$y2)*$radix/2, $radix);
if (is_infinite($level)) {
return (0, $level);
}
return (0, 2*$power*$power - 1);
# Would need to backtrack if the rectangle misses the 2/4 cells filled ...
# my $n_power = 2 * $power * $power * $radix;
# my $max_x = 0;
# my $max_y = 0;
# my $max_n = 0;
# my $max_xk = 0;
# my $max_yk = 0;
#
# my $min_x = 0;
# my $min_y = 0;
# my $min_n = 0;
# my $min_xk = 0;
# my $min_yk = 0;
#
# # l<=cc2 or h-1c2 or h<=c1
# # so does overlap if
# # l<=c2 and h>c1
# #
# my $radix_minus_1 = $radix - 1;
# my $overlap = sub {
# my ($c,$ck,$digit, $c1,$c2) = @_;
# if ($ck & 1) {
# $digit = $radix_minus_1 - $digit;
# }
# ### overlap consider: "inv".($ck&1)."digit=$digit ".($c+$digit*$power)."<=c<".($c+($digit+1)*$power)." cf $c1 to $c2 incl"
# return ($c + $digit*$power <= $c2
# && $c + ($digit+1)*$power > $c1);
# };
#
# while ($level-- >= 0) {
# ### $power
# ### $n_power
# ### $max_n
# ### $min_n
# {
# my $digit;
# for ($digit = $radix_minus_1; $digit > 0; $digit--) {
# last if &$overlap ($max_y,$max_yk,$digit, $y1,$y2);
# }
# $max_n += $n_power * $digit;
# $max_xk ^= $digit;
# if ($max_yk&1) { $digit = $radix_minus_1 - $digit; }
# $max_y += $power * $digit;
# ### max y digit (complemented): $digit
# ### $max_y
# ### $max_n
# }
# {
# my $digit;
# for ($digit = 0; $digit < $radix_minus_1; $digit++) {
# last if &$overlap ($min_y,$min_yk,$digit, $y1,$y2);
# }
# $min_n += $n_power * $digit;
# $min_xk ^= $digit;
# if ($min_yk&1) { $digit = $radix_minus_1 - $digit; }
# $min_y += $power * $digit;
# ### min y digit (complemented): $digit
# ### $min_y
# ### $min_n
# }
#
# $n_power = int($n_power/$radix);
# {
# my $digit;
# for ($digit = $radix_minus_1; $digit > 0; $digit--) {
# last if &$overlap ($max_x,$max_xk,$digit, $x1,$x2);
# }
# $max_n += $n_power * $digit;
# $max_yk ^= $digit;
# if ($max_xk&1) { $digit = $radix_minus_1 - $digit; }
# $max_x += $power * $digit;
# ### max x digit (complemented): $digit
# ### $max_x
# ### $max_n
# }
# {
# my $digit;
# for ($digit = 0; $digit < $radix_minus_1; $digit++) {
# last if &$overlap ($min_x,$min_xk,$digit, $x1,$x2);
# }
# $min_n += $n_power * $digit;
# $min_yk ^= $digit;
# if ($min_xk&1) { $digit = $radix_minus_1 - $digit; }
# $min_x += $power * $digit;
# ### min x digit (complemented): $digit
# ### $min_x
# ### $min_n
# }
#
# $power = int($power/$radix);
# $n_power = int($n_power/$radix);
# }
#
# ### is: "$min_n at $min_x,$min_y to $max_n at $max_x,$max_y"
# return ($min_n, $max_n);
}
1;
__END__
=for stopwords Guiseppe Peano Peano's eg Sur une courbe qui remplit toute aire Mathematische Annalen Ryde OEIS ZOrderCurve ie PeanoCurve Math-PlanePath versa Online Radix radix HilbertCurve
=head1 NAME
Math::PlanePath::PeanoRounded -- 3x3 self-similar quadrant traversal, with rounded corners
=head1 SYNOPSIS
use Math::PlanePath::PeanoRounded;
my $path = Math::PlanePath::PeanoRounded->new;
my ($x, $y) = $path->n_to_xy (123);
# or another radix digits ...
my $path5 = Math::PlanePath::PeanoRounded->new (radix => 5);
=head1 DESCRIPTION
This is a version of the PeanoCurve with rounded-off corners,
11 | 76-75 72-71 68-67
| / \ / \ / \
10 | 77 74-73 70-69 66
| | |
9 | 78 81-82 61-62 65
| \ / \ / \ /
8 | 79-80 83 60 63-64
| | |
7 | 88-87 84 59 56-55
| / \ / \ / \
6 | ...-89 86-85 58-57 54
| |
5 | 13-14 17-18 21-22 49-50 53
| / \ / \ / \ / \ /
4 | 12 15-16 19-20 23 48 51-52
| | | |
3 | 11 8--7 28-27 24 47 44-43
| \ / \ / \ / \ / \
2 | 10--9 6 29 26-25 46-45 42
| | | |
1 | 1--2 5 30 33-34 37-38 41
| / \ / \ / \ / \ /
Y=0 | 0 3--4 31-32 35-36 39-40
+------------------------------------------------------
X=0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
=head2 Radix
The C parameter can do the calculation in a base other than 3, using
the same kind of direction reversals. For example radix 5 gives 5x5 groups,
=cut
# math-image --path=PeanoRounded,radix=5 --all --output=numbers_dash
=pod
radix => 5
9 | 41-42 45-46 49-...
| / \ / \ /
8 | 40 43-44 47-48
| | radix=5
7 | 39 36-35 32-31
| \ / \ / \
6 | 38-37 34-33 30
| |
5 | 21-22 25-26 29
| / \ / \ /
4 | 20 23-24 27-28
| |
3 | 19 16-15 12-11
| \ / \ / \
2 | 18-17 14-13 10
| |
1 | 1--2 5--6 9
| / \ / \ /
Y=0 | 0 3--4 7--8
|
+---------------------------------
X=0 1 2 3 4 5 6 7 8 9
If the radix is even then the ends of each group don't join up. For example
in radix 4 N=31 isn't next to N=32.
=cut
# math-image --path=PeanoRounded,radix=4 --all --output=numbers_dash
=pod
7 | 30-29 26-25 32
| / \ / \ \
6 | 31 28-27 24 33--...
| |
5 | 17-18 21-22 |
| / \ / \ |
4 | 16 19-20 23
| |
3 | | 14-13 10--9
| | / \ / \
2 | 15 12-11 8
| |
1 | 1--2 5--6 |
| / \ / \ |
Y=0 | 0 3--4 7
+-----------------------------------------
X=0 1 2 4 5 6 7 8 9 10
=head1 FUNCTIONS
See L for the behaviour common to all path
classes.
=over 4
=item C<$path = Math::PlanePath::PeanoRounded-Enew ()>
=item C<$path = Math::PlanePath::PeanoRounded-Enew (radix =E $r)>
Create and return a new path object.
The optional C parameter gives the base for digit splitting. The
default is ternary, C 3>.
=item C<($x,$y) = $path-En_to_xy ($n)>
Return the X,Y coordinates of point number C<$n> on the path. Points begin
at 0 and if C<$n E 0> then the return is an empty list.
Fractional positions give an X,Y position along a straight line between the
integer positions.
=back
=head1 SEE ALSO
L,
L,
L
Guiseppe Peano, "Sur une courbe, qui remplit toute une aire plane",
Mathematische Annalen, volume 36, number 1, 1890, p157-160
=over
DOI 10.1007/BF01199438
http://www.springerlink.com/content/w232301n53960133/
=back
=head1 HOME PAGE
L
=head1 LICENSE
Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
more details.
You should have received a copy of the GNU General Public License along with
Math-PlanePath. If not, see .
=cut
Math-PlanePath-122/devel/lib/Math/PlanePath/ParabolicRuns.pm 0000644 0001750 0001750 00000004766 12606435145 021436 0 ustar gg gg # Copyright 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
package Math::PlanePath::ParabolicRuns;
use 5.004;
use strict;
#use List::Util 'max';
*max = \&Math::PlanePath::_max;
use vars '$VERSION', '@ISA';
$VERSION = 122;
use Math::PlanePath;
@ISA = ('Math::PlanePath');
*_divrem_mutate = \&Math::PlanePath::_divrem_mutate;
use Math::PlanePath::Base::Generic
'is_infinite',
'round_nearest';
use Math::PlanePath::Base::Digits
'round_down_pow';
# uncomment this to run the ### lines
#use Smart::Comments;
use constant class_x_negative => 0;
use constant class_y_negative => 0;
sub n_to_xy {
my ($self, $n) = @_;
### ParabolicRuns n_to_xy(): $n
if ($n < 1) { return; }
if (is_infinite($n)) { return ($n,$n); }
$n -= 1;
my @x;
for (my $k = 0; ; $k++) {
$x[$k] = 0;
for (my $y = $k; $y >= 0; $y--) {
my $len = $k-$y+1;
if ($n < $len) {
return ($x[$y] + $n, $y);
}
$x[$y] += $len;
$n -= $len;
}
}
}
sub xy_to_n {
my ($self, $x, $y) = @_;
### ParabolicRuns xy_to_n(): "$x, $y"
$x = round_nearest ($x);
$y = round_nearest ($y);
if ($x < 0 || $y < 0) { return undef; }
if (is_infinite($x)) { return $x; }
if (is_infinite($y)) { return $y; }
my $n = 1;
my @sx;
for (my $k = 0; ; $k++) {
$sx[$k] = 0;
for (my $sy = $k; $sy >= 0; $sy--) {
my $len = $k-$sy+1;
if ($y == $sy) {
if ($x < $len) {
return ($n + $x);
}
$x -= $len;
}
$n += $len;
}
}
}
# not exact
sub rect_to_n_range {
my ($self, $x1,$y1, $x2,$y2) = @_;
### ParabolicRuns rect_to_n_range(): "$x1,$y1 $x2,$y2"
$x1 = round_nearest ($x1);
$y1 = round_nearest ($y1);
$x2 = round_nearest ($x2);
$y2 = round_nearest ($y2);
($x1,$x2) = ($x2,$x1) if $x1 > $x2;
($y1,$y2) = ($y2,$y1) if $y1 > $y2;
return (1,
2*($x2+1)*($y2+1)**2);
}
1;
__END__
Math-PlanePath-122/devel/lib/Math/square-radical.pl 0000644 0001750 0001750 00000001662 12171603336 017676 0 ustar gg gg # Copyright 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::SquareRadical;
# uncomment this to run the ### lines
use Smart::Comments;
{
my $s = Math::SquareRadical->new(1);
print "$s\n";
}
{
my $s = Math::SquareRadical->new(1,2,3);
### $s
print "$s\n";
}
exit 0;
Math-PlanePath-122/devel/fractions-tree.pl 0000644 0001750 0001750 00000003200 11745170634 016263 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# Usage: perl fractions-tree.pl
#
# Print the FractionsTree paths in tree form.
#
use 5.004;
use strict;
use Math::PlanePath::FractionsTree;
foreach my $tree_type ('Kepler') {
print "$tree_type tree\n";
my $path = Math::PlanePath::FractionsTree->new
(tree_type => $tree_type);
printf "%31s", '';
foreach my $n (1) {
my ($x,$y) = $path->n_to_xy($n);
print "$x/$y";
}
print "\n";
printf "%15s", '';
foreach my $n (2 .. 3) {
my ($x,$y) = $path->n_to_xy($n);
printf "%-32s", "$x/$y";
}
print "\n";
printf "%7s", '';
foreach my $n (4 .. 7) {
my ($x,$y) = $path->n_to_xy($n);
printf "%-16s", "$x/$y";
}
print "\n";
printf "%3s", '';
foreach my $n (8 .. 15) {
my ($x,$y) = $path->n_to_xy($n);
printf "%-8s", "$x/$y";
}
print "\n";
foreach my $n (16 .. 31) {
my ($x,$y) = $path->n_to_xy($n);
printf "%4s", "$x/$y";
}
print "\n";
print "\n";
}
exit 0;
Math-PlanePath-122/devel/numseq.pl 0000644 0001750 0001750 00000052777 12606146374 014676 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2011, 2012, 2013, 2014, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::Trig 'pi';
# uncomment this to run the ### lines
# use Smart::Comments;
{
# max turn Left etc
require Math::NumSeq::PlanePathTurn;
require Math::NumSeq::PlanePathDelta;
my $planepath;
$planepath = "TerdragonMidpoint,arms=6";
$planepath = "AnvilSpiral,wider=17";
$planepath = "QuintetCurve,arms=4";
$planepath = "OneOfEight,parts=wedge";
$planepath = "LCornerTree,parts=diagonal-1";
$planepath = "UlamWarburton,parts=octant_up";
$planepath = "TriangularHypot,points=hex_rotated";
$planepath = "TriangularHypot,points=hex_centred";
$planepath = "TriangularHypot,points=hex";
$planepath = "TriangularHypot,points=even";
$planepath = "PixelRings";
$planepath = "FilledRings";
$planepath = "MultipleRings,step=9,shape=polygon,n_start=0";
$planepath = "ChanTree,k=11,reduced=1";
$planepath = "DigitGroups,radix=5";
$planepath = "CfracDigits,radix=37";
$planepath = "GrayCode,radix=37";
$planepath = "CellularRule,rule=8";
$planepath = "LCornerTree,parts=1";
my $seq = Math::NumSeq::PlanePathTurn->new (planepath => $planepath,
turn_type => 'LSR');
# $planepath = "FractionsTree";
# my $seq = Math::NumSeq::PlanePathDelta->new (planepath => $planepath,
# delta_type => 'Dir4');
my $max = -99;
my $min = 99;
my $prev_i = undef;
my %seen;
for (1 .. 1000000) {
my ($i, $value) = $seq->next;
if (! defined $i) {
print "no more values after i=$prev_i\n";
last;
}
# $value = -$value; next unless $value;
if (! $seen{$value}++) {
printf "%d %s new value\n", $i, $value;
}
# if ($value > $max) {
# printf "%d %.5f new max\n", $i, $value;
# $max = $value;
# }
# if ($value < $min) {
# printf "%d %.5f new min\n", $i, $value;
# $min = $value;
# }
$prev_i = $i;
}
exit 0;
}
{
# when X neg, Y neg
require Math::NumSeq::PlanePathCoord;
my $planepath;
$planepath = "AR2W2Curve,start_shape=A2rev";
$planepath = "BetaOmega,arms=1";
$planepath = "Math::PlanePath::SierpinskiArrowhead";
$planepath = "Math::PlanePath::FlowsnakeCentres,arms=1";
$planepath = "GosperSide";
$planepath = "FlowsnakeCentres,arms=3";
$planepath = "HexSpiral,wider=10";
$planepath = "Math::PlanePath::QuintetCentres,arms=1";
$planepath = "Math::PlanePath::R5DragonCurve,arms=1";
$planepath = "Math::PlanePath::R5DragonMidpoint,arms=2";
$planepath = "Math::PlanePath::AlternatePaper,arms=5";
$planepath = "ComplexPlus";
print "$planepath\n";
my $seq = Math::NumSeq::PlanePathCoord->new (planepath => $planepath);
my $path = $seq->{'planepath_object'};
my ($x_negative_at_n, $y_negative_at_n, $sum_negative_at_n);
for (my $n = $path->n_start; ; $n++) {
my ($x,$y) = $path->n_to_xy($n);
if ($x < 0 && ! defined $x_negative_at_n) {
$x_negative_at_n = $n;
print "X negative $x_negative_at_n\n";
}
if ($y < 0 && ! defined $y_negative_at_n) {
$y_negative_at_n = $n;
print "Y negative $y_negative_at_n\n";
}
my $sum = $x+$y;
if ($sum < 0 && ! defined $sum_negative_at_n) {
$sum_negative_at_n = $n;
print "Sum negative $sum_negative_at_n\n";
}
last if defined $x_negative_at_n && defined $y_negative_at_n
&& defined $sum_negative_at_n;
}
exit 0;
}
{
require Math::NumSeq::PlanePathCoord;
foreach my $path_type (@{Math::NumSeq::PlanePathCoord->parameter_info_array->[0]->{'choices'}}) {
my $class = "Math::PlanePath::$path_type";
### $class
eval "require $class; 1" or die;
my @pinfos = $class->parameter_info_list;
my $params = parameter_info_list_to_parameters(@pinfos);
PAREF:
foreach my $paref (@$params) {
### $paref
my $path = $class->new(@$paref);
my $seq = Math::NumSeq::PlanePathCoord->new(planepath_object => $path,
coordinate_type => 'Sum');
foreach (1 .. 10) {
$seq->next;
}
foreach (1 .. 1000) {
my ($i, $value) = $seq->next;
if (! defined $i || $value < $i) {
next PAREF;
}
}
print "$path_type ",join(',',@$paref),"\n";
}
}
exit 0;
sub parameter_info_list_to_parameters {
my @parameters = ([]);
foreach my $info (@_) {
info_extend_parameters($info,\@parameters);
}
return \@parameters;
}
sub info_extend_parameters {
my ($info, $parameters) = @_;
my @new_parameters;
if ($info->{'name'} eq 'planepath') {
my @strings;
foreach my $choice (@{$info->{'choices'}}) {
my $path_class = "Math::PlanePath::$choice";
Module::Load::load($path_class);
my @parameter_info_list = $path_class->parameter_info_list;
if ($path_class->isa('Math::PlanePath::Rows')) {
push @parameter_info_list,{ name => 'width',
type => 'integer',
width => 3,
default => '1',
minimum => 1,
};
}
if ($path_class->isa('Math::PlanePath::Columns')) {
push @parameter_info_list, { name => 'height',
type => 'integer',
width => 3,
default => '1',
minimum => 1,
};
}
my $path_parameters
= parameter_info_list_to_parameters(@parameter_info_list);
### $path_parameters
foreach my $aref (@$path_parameters) {
my $str = $choice;
while (@$aref) {
$str .= "," . shift(@$aref) . '=' . shift(@$aref);
}
push @strings, $str;
}
}
### @strings
foreach my $p (@$parameters) {
foreach my $choice (@strings) {
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
@$parameters = @new_parameters;
return;
}
if ($info->{'name'} eq 'arms') {
print " skip parameter $info->{'name'}\n";
return;
}
if ($info->{'choices'}) {
my @new_parameters;
foreach my $p (@$parameters) {
foreach my $choice (@{$info->{'choices'}}) {
next if ($info->{'name'} eq 'rotation_type' && $choice eq 'custom');
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
@$parameters = @new_parameters;
return;
}
if ($info->{'type'} eq 'boolean') {
my @new_parameters;
foreach my $p (@$parameters) {
foreach my $choice (0, 1) {
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
@$parameters = @new_parameters;
return;
}
if ($info->{'type'} eq 'integer'
|| $info->{'name'} eq 'multiples') {
### $info
my $max = ($info->{'minimum'}||-5)+10;
if ($info->{'name'} eq 'straight_spacing') { $max = 2; }
if ($info->{'name'} eq 'diagonal_spacing') { $max = 2; }
if ($info->{'name'} eq 'radix') { $max = 17; }
if ($info->{'name'} eq 'realpart') { $max = 3; }
if ($info->{'name'} eq 'wider') { $max = 3; }
if ($info->{'name'} eq 'modulus') { $max = 32; }
if ($info->{'name'} eq 'polygonal') { $max = 32; }
if ($info->{'name'} eq 'factor_count') { $max = 12; }
if (defined $info->{'maximum'} && $max > $info->{'maximum'}) {
$max = $info->{'maximum'};
}
if ($info->{'name'} eq 'power' && $max > 6) { $max = 6; }
my @new_parameters;
foreach my $choice (($info->{'minimum'}||0) .. $max) {
foreach my $p (@$parameters) {
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
@$parameters = @new_parameters;
return;
}
if ($info->{'name'} eq 'fraction') {
### fraction ...
my @new_parameters;
foreach my $p (@$parameters) {
my $radix = p_radix($p) || die;
foreach my $den (995 .. 1021) {
next if $den % $radix == 0;
my $choice = "1/$den";
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
foreach my $num (2 .. 10) {
foreach my $den ($num+1 .. 15) {
next if $den % $radix == 0;
next unless _coprime($num,$den);
my $choice = "$num/$den";
push @new_parameters, [ @$p, $info->{'name'}, $choice ];
}
}
}
@$parameters = @new_parameters;
return;
}
print " skip parameter $info->{'name'}\n";
}
}
{
# max Dir4
require Math::BaseCnv;
# print 4-atan2(2,1)/atan2(1,1)/2,"\n";
require Math::NumSeq::PlanePathDelta;
require Math::NumSeq::PlanePathTurn;
my $realpart = 3;
my $radix = $realpart*$realpart + 1;
my $planepath;
$planepath = "RationalsTree,tree_type=Drib";
$planepath = "GosperReplicate";
$planepath = "QuintetReplicate";
$planepath = "RationalsTree,tree_type=HCS";
$planepath = "ToothpickReplicate,parts=1";
$planepath = "CfracDigits,radix=2";
$planepath = "DiagonalRationals,direction=up";
$planepath = "OneOfEight,parts=wedge";
$planepath = "QuadricIslands";
$planepath = "WunderlichSerpentine";
$planepath = "ComplexMinus,realpart=3";
$planepath = "UlamWarburton,parts=4";
$planepath = "ToothpickTreeByCells,parts=two_horiz";
$planepath = "LCornerTreeByCells,parts=octant_up+1";
$planepath = "ChanTree,k=5";
$planepath = "ComplexPlus,realpart=2";
$planepath = "CfracDigits,radix=".($radix-1);
$planepath = "GosperIslands";
$planepath = "ImaginaryHalf"; # ,digit_order=XnXY";
$planepath = "SquareReplicate";
$planepath = "GrayCode,radix=$radix,apply_type=Ts";
$planepath = "SquareReplicate";
$planepath = "ToothpickTree,parts=2";
$planepath = "ToothpickUpist";
$planepath = "CornerReplicate";
$radix = 3;
$planepath = "ZOrderCurve,radix=$radix";
$planepath = "LCornerReplicate";
$planepath = "LCornerTree,parts=diagonal-1";
$planepath = "PowerArray,radix=$radix";
$planepath = "DigitGroups,radix=$radix";
$planepath = "FactorRationals,sign_encoding=negabinary";
$planepath = "GcdRationals,pairs_order=diagonals_up";
$planepath = "LTiling";
$planepath = "TriangularHypot,points=hex_rotated";
$planepath = "Hypot,points=all";
$planepath = "MultipleRings,step=3";
$planepath = "ArchimedeanChords";
$planepath = "DragonMidpoint";
$planepath = "HexSpiral,wider=1";
$planepath = "AlternatePaper";
$planepath = "VogelFloret";
$planepath = "MultipleRings,step=6,ring_shape=polygon";
$planepath = "PythagoreanTree,coordinates=MC,tree_type=UMT";
$planepath = "R5DragonMidpoint";
$planepath = "OctagramSpiral";
$planepath = "Columns,height=6";
$planepath = "SacksSpiral";
$planepath = "CellularRule,rule=6";
$planepath = "Z2DragonCurve";
$planepath = "WythoffPreliminaryTriangle";
$planepath = "UlamWarburton,parts=octant";
my $seq = Math::NumSeq::PlanePathDelta->new (planepath => $planepath,
# delta_type => 'dX',
delta_type => 'Dir4',
# delta_type => 'dTRadius',
# delta_type => 'dRSquared',
# delta_type => 'dDiffXY',
# delta_type => 'TDir6',
# delta_type => 'dAbsDiff',
);
my $dx_seq = Math::NumSeq::PlanePathDelta->new (planepath => $planepath,
delta_type => 'dX');
my $dy_seq = Math::NumSeq::PlanePathDelta->new (planepath => $planepath,
delta_type => 'dY');
# my $seq = Math::NumSeq::PlanePathTurn->new (planepath => $planepath,
# turn_type => 'Turn4',
# );
# my $dx_seq = Math::NumSeq::PlanePathCoord->new (planepath => $planepath,
# coordinate_type => 'X');
# my $dy_seq = Math::NumSeq::PlanePathCoord->new (planepath => $planepath,
# coordinate_type => 'Y');
my $min = 99;
my $max = -99;
for (1 .. 10_000_000) {
my ($i, $value) = $seq->next;
# $seq->seek_to_i(2*$i+2);
if ($value > $max) {
my $dx = $dx_seq->ith($i);
my $dy = $dy_seq->ith($i);
my $prev_dx = $dx_seq->ith($i-1) // 'u';
my $prev_dy = $dy_seq->ith($i-1) // 'u';
my $ri = Math::BaseCnv::cnv($i,10,$radix);
my $rdx = Math::BaseCnv::cnv($dx,10,$radix);
my $rdy = Math::BaseCnv::cnv($dy,10,$radix);
my $f = $dy && $dx/$dy;
$max = $value;
printf "max i=%d[%s] %.5f px=%s,py=%s dx=%s,dy=%s[%s,%s] %.3f\n",
$i,$ri, $value,
$prev_dx,$prev_dy,
$dx,$dy, $rdx,$rdy, $f;
}
if ($value < $min) {
my $dx = $dx_seq->ith($i);
my $dy = $dy_seq->ith($i);
my $prev_dx = $dx_seq->ith($i-1) // 'u';
my $prev_dy = $dy_seq->ith($i-1) // 'u';
my $ri = Math::BaseCnv::cnv($i,10,$radix);
my $rdx = Math::BaseCnv::cnv($dx,10,$radix);
my $rdy = Math::BaseCnv::cnv($dy,10,$radix);
my $f = $dy && $dx/$dy;
$min = $value;
printf " min i=%d[%s] %.5f px=%s,py=%s dx=%s,dy=%s %.3f\n",
$i,$ri, $value,
$prev_dx,$prev_dy,
$dx,$dy, $f;
my $slope_dy_dx = ($dx == 0 ? 0 : $dy/$dx);
printf " dy/dx=%.5f\n", $slope_dy_dx;
}
}
exit 0;
}
{
# dx,dy seen
require Math::NumSeq::PlanePathCoord;
my $planepath = "CellularRule,rule=2";
$planepath = "AR2W2Curve,start_shape=A2rev";
$planepath = "BetaOmega,arms=1";
$planepath = "Math::PlanePath::SierpinskiArrowhead";
$planepath = "PixelRings";
$planepath = "DiamondArms";
$planepath = "Math::PlanePath::QuintetCurve,arms=1";
$planepath = "Math::PlanePath::GreekKeySpiral,turns=3";
$planepath = "WunderlichSerpentine,radix=5,serpentine_type=coil";
$planepath = "KnightSpiral";
print "$planepath\n";
my $seq = Math::NumSeq::PlanePathCoord->new (planepath => $planepath);
my $path = $seq->{'planepath_object'};
my %seen_dxdy;
for (my $n = $path->n_start; ; $n++) {
my ($dx,$dy) = $path->n_to_dxdy($n);
unless ($seen_dxdy{"$dx,$dy"}++) {
my $desc = ($dx == 1 && $dy == 0 ? 'E'
: $dx == 2 && $dy == 0 ? 'E'
: $dx == -1 && $dy == 0 ? 'W'
: $dx == -2 && $dy == 0 ? 'W'
: $dx == 0 && $dy == 1 ? 'N'
: $dx == 0 && $dy == -1 ? 'S'
: $dx == 1 && $dy == 1 ? 'NE'
: $dx == -1 && $dy == 1 ? 'NW'
: $dx == 1 && $dy == -1 ? 'SE'
: $dx == -1 && $dy == -1 ? 'SW'
: '');
print "$dx,$dy, # $desc N=$n\n";
}
}
exit 0;
}
{
# min/max PlanePathCoord
require Math::BaseCnv;
require Math::NumSeq::PlanePathCoord;
my $realpart = 3;
my $radix = $realpart*$realpart + 1;
my $planepath;
$planepath = "MultipleRings,step=3";
$planepath = "MultipleRings,step=3,ring_shape=polygon";
my $seq = Math::NumSeq::PlanePathCoord->new (planepath => $planepath,
coordinate_type => 'AbsDiff');
my $path = $seq->{'planepath_object'};
my $min = 99;
my $max = -99;
for (1 .. 10000000) {
my ($i, $value) = $seq->next;
# if ($value > $max) {
# my $dx = $dx_seq->ith($i);
# my $dy = $dy_seq->ith($i);
# my $prev_dx = $dx_seq->ith($i-1) // 'u';
# my $prev_dy = $dy_seq->ith($i-1) // 'u';
# my $ri = Math::BaseCnv::cnv($i,10,$radix);
# my $rdx = Math::BaseCnv::cnv($dx,10,$radix);
# my $rdy = Math::BaseCnv::cnv($dy,10,$radix);
# my $f = $dy && $dx/$dy;
# $max = $value;
# printf "max i=%d[%s] %.5f px=%s,py=%s dx=%s,dy=%s[%s,%s] %.3f\n",
# $i,$ri, $value,
# $prev_dx,$prev_dy,
# $dx,$dy, $rdx,$rdy, $f;
# }
if ($value < $min) {
my ($x,$y) = $path->n_to_xy($i);
$min = $value;
my $ri = Math::BaseCnv::cnv($i,10,$radix);
printf " min i=%d[%s] %.5f x=%s,y=%s\n",
$i,$ri, $value, $x,$y;
}
}
exit 0;
}
{
require Math::NumSeq::PlanePathDelta;
for (my $a = 0; $a <= 360; $a += 5) {
print "$a ",Math::NumSeq::PlanePathDelta::_dir360_to_tdir6($a),"\n";
}
exit 0;
}
{
# kronecker cf A215200
require Math::NumSeq::PlanePathCoord;
foreach my $n (1 .. 10) {
foreach my $k (1 .. $n) {
my $x = $n - $k;
my $y = $k;
my $kron = Math::NumSeq::PlanePathCoord::_kronecker_symbol($x,$y);
printf "%3d,", $kron;
}
print "\n";
}
exit 0;
}
{
# axis increasing
my $radix = 4;
my $rsquared = $radix * $radix;
my $re = '.' x $radix;
require Math::NumSeq::PlanePathN;
my $planepath;
$planepath = "AlternatePaperMidpoint,arms=7";
$planepath = "ImaginaryBase,radix=37";
$planepath = "ImaginaryHalf,radix=37";
$planepath = "DekkingCurve";
$planepath = "DekkingCentres";
$planepath = "LCornerReplicate";
$planepath = "LCornerTree,parts=3";
LINE_TYPE: foreach my $line_type ('X_axis',
'Y_axis',
'X_neg',
'Y_neg',
'Diagonal_SE',
'Diagonal_SW',
'Diagonal_NW',
'Diagonal',
) {
my $seq = Math::NumSeq::PlanePathN->new
(
planepath => $planepath,
line_type => $line_type,
);
### $seq
my $i_start = $seq->i_start;
my $prev_value = -1;
my $prev_i = -1;
my $i_limit = 10000;
my $i_end = $i_start + $i_limit;
for my $i ($i_start .. $i_end) {
my $value = $seq->ith($i);
next if ! defined $value;
### $value
if ($value <= $prev_value) {
# print "$line_type_type decrease at i=$i value=$value cf prev=$prev\n";
my $path = $seq->{'planepath_object'};
my ($prev_x,$prev_y) = $path->n_to_xy($prev_value);
my ($x,$y) = $path->n_to_xy($value);
print "$line_type not N=$prev_value $prev_x,$prev_y N=$value $x,$y\n";
next LINE_TYPE;
}
$prev_i = $i;
$prev_value = $value;
}
print "$line_type all increasing (to i=$prev_i)\n";
}
exit 0;
}
{
# PlanePathCoord increasing
require Math::NumSeq::PlanePathCoord;
my $planepath;
$planepath = "SierpinskiTriangle,align=right";
COORDINATE_TYPE: foreach my $coordinate_type ('BitAnd',
'BitOr',
'BitXor',
) {
my $seq = Math::NumSeq::PlanePathCoord->new
(
planepath => $planepath,
coordinate_type => $coordinate_type,
);
### $seq
my $i_start = $seq->i_start;
my $prev_value;
my $prev_i;
my $i_limit = 100000;
my $i_end = $i_start + $i_limit;
for my $i ($i_start .. $i_end) {
my $value = $seq->ith($i);
next if ! defined $value;
### $i
### $value
if (defined $prev_value && $value < $prev_value) {
# print "$coordinate_type_type decrease at i=$i value=$value cf prev=$prev\n";
my $path = $seq->{'planepath_object'};
my ($prev_x,$prev_y) = $path->n_to_xy($prev_value);
my ($x,$y) = $path->n_to_xy($value);
print "$coordinate_type not i=$i value=$value cf prev_value=$prev_value\n";
next COORDINATE_TYPE;
}
$prev_i = $i;
$prev_value = $value;
}
print "$coordinate_type all increasing (to i=$prev_i)\n";
}
exit 0;
}
{
require Math::BigInt;
my $x = Math::BigInt->new(8);
my $y = Math::BigInt->new(-2);
$x = (8);
$y = (-2);
my $z = $x ^ $y;
print "$z\n";
printf "%b\n", $z & 0xFFF;
if ((($x<0) ^ ($y<0)) != ($z<0)) {
$z = Math::BigInt->new("$z");
$z = ($z - (1<<63)) + -(1<<63);
}
print "$z\n";
printf "%b\n", $z & 0xFFF;
sub sign_extend {
my ($n) = @_;
return ($n - (1<<63)) + -(1<<63);
}
exit 0;
}
{
my $pi = pi();
my %seen;
foreach my $x (0 .. 100) {
foreach my $y (0 .. 100) {
my $factor;
$factor = 1;
$factor = sqrt(3);
# next unless ($x&1) == ($y&1);
$factor = sqrt(8);
my $radians = atan2($y*$factor, $x);
my $degrees = $radians / $pi * 180;
my $frac = $degrees - int($degrees);
if ($frac > 0.5) {
$frac -= 1;
}
if ($frac < -0.5) {
$frac += 1;
}
my $int = $degrees - $frac;
next if $seen{$int}++;
if ($frac > -0.001 && $frac < 0.001) {
print "$x,$y $int ($degrees)\n";
}
}
}
exit 0;
}
Math-PlanePath-122/devel/biguv.pl 0000644 0001750 0001750 00000002073 11753117277 014464 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Inline 'C';
use Math::BigInt try => 'GMP';
# uncomment this to run the ### lines
use Smart::Comments;
my $big = - Math::BigInt->new(2) ** 65;
### $big
print "big ",ref $big,"\n";
my $uv = touv($big);
print "touv $uv\n";
my $nv = $big->numify;
print "as_number $nv\n";
exit 0;
__END__
__C__
unsigned touv(unsigned n) {
return n;
}
Math-PlanePath-122/devel/t-square.pl 0000644 0001750 0001750 00000004672 12255722606 015114 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011, 2012, 2013 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use Math::PlanePath::Base::Digits 'round_down_pow';
{
require Image::Base::GD;
my $width = 810;
my $height = 810;
my $image = Image::Base::GD->new (-width => $width, -height => $height);
$image->rectangle (0,0, $width-1,$height-1, 'black');
my $foreground = 'white';
# *---------*
# | |
# *----* . |
# |
# *----* *----*
# | |
# * *
my $recurse;
$recurse = sub {
my ($x,$y, $dx,$dy, $level) = @_;
if (--$level < 0) {
$image->line($x,$y, $x+$dx,$y+$dy, $foreground);
$x += $dx;
$y += $dy;
($dx,$dy) = (-$dy,$dx); # rotate +90
$image->line($x,$y, $x+$dx,$y+$dy, $foreground);
} else {
$dx /= 2;
$dy /= 2;
$image->line($x,$y, $x+$dx,$y+$dy, $foreground);
$x += $dx;
$y += $dy;
($dx,$dy) = ($dy,-$dx); # rotate -90
$recurse->($x,$y, $dx,$dy, $level);
$x += $dx;
$y += $dy;
($dx,$dy) = (-$dy,$dx); # rotate +90
$x += $dx;
$y += $dy;
$recurse->($x,$y, $dx,$dy, $level);
$x += $dx;
$y += $dy;
($dx,$dy) = (-$dy,$dx); # rotate +90
$x += $dx;
$y += $dy;
$recurse->($x,$y, $dx,$dy, $level);
$x += $dx;
$y += $dy;
($dx,$dy) = (-$dy,$dx); # rotate +90
$x += $dx;
$y += $dy;
($dx,$dy) = ($dy,-$dx); # rotate -90
$image->line($x,$y, $x+$dx,$y+$dy, $foreground);
}
};
my $scale = 2;
my ($pow,$exp) = round_down_pow($height/$scale, 2);
foreach my $level (0 .. $exp) {
my $len = 2**$level * $scale;
$recurse->(0, $height-1 - $len, $len,0, $level);
}
$image->save('/tmp/x.png');
system('xzgv /tmp/x.png');
exit 0;
}
Math-PlanePath-122/devel/exe-complex-minus.c 0000644 0001750 0001750 00000006402 11701770574 016534 0 ustar gg gg /* Copyright 2012 Kevin Ryde
This file is part of Math-PlanePath.
Math-PlanePath is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either version 3, or (at your option) any later
version.
Math-PlanePath is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received a copy of the GNU General Public License along
with Math-PlanePath. If not, see .
*/
#include
#include
#include
#include
typedef unsigned long my_unsigned;
typedef long long my_signed;
#define MY_SIGNED_ABS llabs
#define HYPOT_LIMIT 0x7FFFFFFF
char *
to_base (unsigned long long n, int radix)
{
static char str[256];
static char dstr[256];
int pos = sizeof(str)-1;
do {
int digit = n % radix;
n /= radix;
sprintf (dstr, "[%d]", digit);
int dlen = strlen(dstr);
pos -= dlen;
memcpy (str+pos, dstr, dlen);
} while (n);
return str+pos;
}
int
base_len (unsigned long long n, int radix)
{
int len = 0;
while (n) {
n /= radix;
len++;
}
return len;
}
int
main (void)
{
int realpart, level;
for (realpart = 3; realpart < 10; realpart++) {
int norm = realpart*realpart + 1;
int level_limit = 20;
if (realpart == 2) level_limit = 10;
if (realpart == 3) level_limit = 9;
if (realpart == 4) level_limit = 9;
for (level = 0; level < level_limit; level++) {
unsigned long long min_h = ~0ULL;
my_unsigned min_n = 0;
my_signed min_x = 0;
my_signed min_y = 0;
{
my_unsigned lo = pow(norm, level);
my_unsigned hi = lo * norm;
printf ("%2d lo=%lu hi=%lu\n", level, lo, hi);
my_unsigned n;
for (n = lo; n < hi; n++) {
my_signed x = 0;
my_signed y = 0;
my_signed bx = 1;
my_signed by = 0;
my_unsigned digits = n;
while (digits != 0) {
int digit = digits % norm;
digits /= norm;
x += digit * bx;
y += digit * by;
/* (bx,by) = (bx + i*by)*(i-$realpart) */
my_signed new_bx = bx*-realpart - by;
my_signed new_by = bx + by*-realpart;
bx = new_bx;
by = new_by;
}
unsigned long long abs_x = MY_SIGNED_ABS(x);
unsigned long long abs_y = MY_SIGNED_ABS(y);
if (abs_x > HYPOT_LIMIT
|| abs_y > HYPOT_LIMIT) {
continue;
}
unsigned long long h = abs_x*abs_x + abs_y*abs_y;
/* printf ("%2d %lu %Ld,%Ld %LX\n", level, n, x,y, h); */
if (h < min_h) {
min_h = h;
min_n = n;
min_x = abs_x;
min_y = abs_y;
}
}
}
/* printf ("%lX %Ld,%Ld %s\n", min_n, min_x,min_y, */
/* binary(min_h)); */
printf ("%2d", level);
printf (" %s [%d]", to_base(min_h,norm), base_len(min_h,norm));
printf ("\n");
/* printf ("\n"); */
}
}
return 0;
}
Math-PlanePath-122/devel/gcd-rationals-integer.pl 0000644 0001750 0001750 00000003250 11702424166 017520 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2012 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.004;
use strict;
use List::Util 'min', 'max';
use Math::PlanePath::GcdRationals;
my $height = 20;
my $path = Math::PlanePath::GcdRationals->new;
my $n_lo = $path->n_start;
my $n_hi = $height*($height+1)/2 - 1;
my @array;
foreach my $n ($n_lo .. $n_hi) {
my ($x,$y) = $path->n_to_xy ($n);
my $int = int($x/$y);
if ($int >= 10) { $int = 'z' }
$array[$y]->[$x] = $int;
}
my $cell_width = max (map {length}
grep {defined}
map {@$_}
grep {defined}
@array);
foreach my $y (reverse 1 .. $#array) {
foreach my $x (1 .. $#{$array[$y]}) {
my $int = $array[$y]->[$x];
if (! defined $int) { $int = ''; }
printf '%*s', $cell_width, $int;
}
print "\n";
}
print "\n";
foreach my $y (reverse 1 .. 20) {
foreach my $x (1 .. $y) {
my $int = Math::PlanePath::GcdRationals::_gcd($x,$y) - 1;
if ($int >= 10) { $int = 'z' }
print "$int";
}
print "\n";
}
exit 0;
Math-PlanePath-122/devel/cont-frac.pl 0000644 0001750 0001750 00000002574 11535000617 015215 0 ustar gg gg #!/usr/bin/perl -w
# Copyright 2010, 2011 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
use 5.006;
use strict;
use warnings;
use POSIX 'fmod';
use Math::Libm 'M_PI', 'M_E', 'hypot';
use Math::Trig 'pi';
use POSIX;
# sqrt(pi*e/2) = 1 / (1+ 1/(1 + 2/(1+ 3/(1 + 4/(...)))))
{
use Math::BigFloat;
my $rot;
$rot = M_PI;
$rot = sqrt(17);
# $rot = Math::BigFloat->bpi(1000); # PI to 100 digits
# $rot = Math::BigFloat->bsqrt(5);
# $rot = (Math::BigFloat->bsqrt(5) +1) / 2;
$rot = sqrt(M_PI() * M_E() / 2);
$rot = 0.5772156649015328606065120;
$rot = sqrt(5);
foreach (1..30) {
my $int = int($rot);
my $frac = $rot - $int;
print $int,"\n";
$rot = 1/$frac;
}
# use constant ROTATION => PHI;
# use constant ROTATION =>
exit 0;
}
Math-PlanePath-122/devel/Makefile 0000644 0001750 0001750 00000002030 12530306624 014432 0 ustar gg gg # Copyright 2011, 2012, 2013, 2015 Kevin Ryde
# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath. If not, see .
# CFLAGS = -Wall -O0 -g
CFLAGS = -Wall -O2 -DINLINE=inline -g
LOADLIBES = -lm
size:
perl -e '$$/=undef; $$_=<>; \
s{(?<>g; \
s<""><" ">g; \
s{quit.*}{}s; \
s{\n}{}sg; \
print $$_,"\n",length($$_),"\n"' \