├── .gitignore ├── LICENSE ├── META6.json ├── README.md ├── bin └── symbolic ├── lib └── Math │ ├── Symbolic.rakumod │ └── Symbolic │ ├── Actions.rakumod │ ├── Constants.rakumod │ ├── Grammar.rakumod │ ├── Language.rakumod │ ├── MultiHash.rakumod │ ├── Operation.rakumod │ └── Tree.rakumod ├── symbolic └── t └── 01-basics.t /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | blib/ 3 | .precomp/ 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Artistic License 2.0 2 | 3 | Copyright (c) 2000-2006, The Perl Foundation. 4 | 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | This license establishes the terms under which a given free software 11 | Package may be copied, modified, distributed, and/or redistributed. 12 | The intent is that the Copyright Holder maintains some artistic 13 | control over the development of that Package while still keeping the 14 | Package available as open source and free software. 15 | 16 | You are always permitted to make arrangements wholly outside of this 17 | license directly with the Copyright Holder of a given Package. If the 18 | terms of this license do not permit the full use that you propose to 19 | make of the Package, you should contact the Copyright Holder and seek 20 | a different licensing arrangement. 21 | 22 | Definitions 23 | 24 | "Copyright Holder" means the individual(s) or organization(s) 25 | named in the copyright notice for the entire Package. 26 | 27 | "Contributor" means any party that has contributed code or other 28 | material to the Package, in accordance with the Copyright Holder's 29 | procedures. 30 | 31 | "You" and "your" means any person who would like to copy, 32 | distribute, or modify the Package. 33 | 34 | "Package" means the collection of files distributed by the 35 | Copyright Holder, and derivatives of that collection and/or of 36 | those files. A given Package may consist of either the Standard 37 | Version, or a Modified Version. 38 | 39 | "Distribute" means providing a copy of the Package or making it 40 | accessible to anyone else, or in the case of a company or 41 | organization, to others outside of your company or organization. 42 | 43 | "Distributor Fee" means any fee that you charge for Distributing 44 | this Package or providing support for this Package to another 45 | party. It does not mean licensing fees. 46 | 47 | "Standard Version" refers to the Package if it has not been 48 | modified, or has been modified only in ways explicitly requested 49 | by the Copyright Holder. 50 | 51 | "Modified Version" means the Package, if it has been changed, and 52 | such changes were not explicitly requested by the Copyright 53 | Holder. 54 | 55 | "Original License" means this Artistic License as Distributed with 56 | the Standard Version of the Package, in its current version or as 57 | it may be modified by The Perl Foundation in the future. 58 | 59 | "Source" form means the source code, documentation source, and 60 | configuration files for the Package. 61 | 62 | "Compiled" form means the compiled bytecode, object code, binary, 63 | or any other form resulting from mechanical transformation or 64 | translation of the Source form. 65 | 66 | 67 | Permission for Use and Modification Without Distribution 68 | 69 | (1) You are permitted to use the Standard Version and create and use 70 | Modified Versions for any purpose without restriction, provided that 71 | you do not Distribute the Modified Version. 72 | 73 | 74 | Permissions for Redistribution of the Standard Version 75 | 76 | (2) You may Distribute verbatim copies of the Source form of the 77 | Standard Version of this Package in any medium without restriction, 78 | either gratis or for a Distributor Fee, provided that you duplicate 79 | all of the original copyright notices and associated disclaimers. At 80 | your discretion, such verbatim copies may or may not include a 81 | Compiled form of the Package. 82 | 83 | (3) You may apply any bug fixes, portability changes, and other 84 | modifications made available from the Copyright Holder. The resulting 85 | Package will still be considered the Standard Version, and as such 86 | will be subject to the Original License. 87 | 88 | 89 | Distribution of Modified Versions of the Package as Source 90 | 91 | (4) You may Distribute your Modified Version as Source (either gratis 92 | or for a Distributor Fee, and with or without a Compiled form of the 93 | Modified Version) provided that you clearly document how it differs 94 | from the Standard Version, including, but not limited to, documenting 95 | any non-standard features, executables, or modules, and provided that 96 | you do at least ONE of the following: 97 | 98 | (a) make the Modified Version available to the Copyright Holder 99 | of the Standard Version, under the Original License, so that the 100 | Copyright Holder may include your modifications in the Standard 101 | Version. 102 | 103 | (b) ensure that installation of your Modified Version does not 104 | prevent the user installing or running the Standard Version. In 105 | addition, the Modified Version must bear a name that is different 106 | from the name of the Standard Version. 107 | 108 | (c) allow anyone who receives a copy of the Modified Version to 109 | make the Source form of the Modified Version available to others 110 | under 111 | 112 | (i) the Original License or 113 | 114 | (ii) a license that permits the licensee to freely copy, 115 | modify and redistribute the Modified Version using the same 116 | licensing terms that apply to the copy that the licensee 117 | received, and requires that the Source form of the Modified 118 | Version, and of any works derived from it, be made freely 119 | available in that license fees are prohibited but Distributor 120 | Fees are allowed. 121 | 122 | 123 | Distribution of Compiled Forms of the Standard Version 124 | or Modified Versions without the Source 125 | 126 | (5) You may Distribute Compiled forms of the Standard Version without 127 | the Source, provided that you include complete instructions on how to 128 | get the Source of the Standard Version. Such instructions must be 129 | valid at the time of your distribution. If these instructions, at any 130 | time while you are carrying out such distribution, become invalid, you 131 | must provide new instructions on demand or cease further distribution. 132 | If you provide valid instructions or cease distribution within thirty 133 | days after you become aware that the instructions are invalid, then 134 | you do not forfeit any of your rights under this license. 135 | 136 | (6) You may Distribute a Modified Version in Compiled form without 137 | the Source, provided that you comply with Section 4 with respect to 138 | the Source of the Modified Version. 139 | 140 | 141 | Aggregating or Linking the Package 142 | 143 | (7) You may aggregate the Package (either the Standard Version or 144 | Modified Version) with other packages and Distribute the resulting 145 | aggregation provided that you do not charge a licensing fee for the 146 | Package. Distributor Fees are permitted, and licensing fees for other 147 | components in the aggregation are permitted. The terms of this license 148 | apply to the use and Distribution of the Standard or Modified Versions 149 | as included in the aggregation. 150 | 151 | (8) You are permitted to link Modified and Standard Versions with 152 | other works, to embed the Package in a larger work of your own, or to 153 | build stand-alone binary or bytecode versions of applications that 154 | include the Package, and Distribute the result without restriction, 155 | provided the result does not expose a direct interface to the Package. 156 | 157 | 158 | Items That are Not Considered Part of a Modified Version 159 | 160 | (9) Works (including, but not limited to, modules and scripts) that 161 | merely extend or make use of the Package, do not, by themselves, cause 162 | the Package to be a Modified Version. In addition, such works are not 163 | considered parts of the Package itself, and are not subject to the 164 | terms of this license. 165 | 166 | 167 | General Provisions 168 | 169 | (10) Any use, modification, and distribution of the Standard or 170 | Modified Versions is governed by this Artistic License. By using, 171 | modifying or distributing the Package, you accept this license. Do not 172 | use, modify, or distribute the Package, if you do not accept this 173 | license. 174 | 175 | (11) If your Modified Version has been derived from a Modified 176 | Version made by someone other than you, you are nevertheless required 177 | to ensure that your Modified Version complies with the requirements of 178 | this license. 179 | 180 | (12) This license does not grant you the right to use any trademark, 181 | service mark, tradename, or logo of the Copyright Holder. 182 | 183 | (13) This license includes the non-exclusive, worldwide, 184 | free-of-charge patent license to make, have made, use, offer to sell, 185 | sell, import and otherwise transfer the Package with respect to any 186 | patent claims licensable by the Copyright Holder that are necessarily 187 | infringed by the Package. If you institute patent litigation 188 | (including a cross-claim or counterclaim) against any party alleging 189 | that the Package constitutes direct or contributory patent 190 | infringement, then this Artistic License to you shall terminate on the 191 | date that such litigation is filed. 192 | 193 | (14) Disclaimer of Warranty: 194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 195 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 202 | -------------------------------------------------------------------------------- /META6.json: -------------------------------------------------------------------------------- 1 | { 2 | "raku" : "6.*", 3 | "name" : "Math::Symbolic", 4 | "license" : "Artistic-2.0", 5 | "version" : "*", 6 | "description" : "Symbolic math for Raku", 7 | "author" : "raydiak", 8 | "depends" : [ ], 9 | "provides" : { 10 | "Math::Symbolic" : "lib/Math/Symbolic.rakumod", 11 | "Math::Symbolic::Actions" : "lib/Math/Symbolic/Actions.rakumod", 12 | "Math::Symbolic::Constants" : "lib/Math/Symbolic/Constants.rakumod", 13 | "Math::Symbolic::Grammar" : "lib/Math/Symbolic/Grammar.rakumod", 14 | "Math::Symbolic::Language" : "lib/Math/Symbolic/Language.rakumod", 15 | "Math::Symbolic::Operation" : "lib/Math/Symbolic/Operation.rakumod", 16 | "Math::Symbolic::Tree" : "lib/Math/Symbolic/Tree.rakumod", 17 | "Math::Symbolic::MultiHash" : "lib/Math/Symbolic/MultiHash.rakumod" 18 | }, 19 | "source-url" : "git://github.com/raydiak/Math-Symbolic.git" 20 | } 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Math::Symbolic 2 | 3 | This is a Raku symbolic math module. It parses, manipulates, evaluates, and 4 | outputs mathematical expressions and relations. This module is PRE-ALPHA 5 | quality. 6 | 7 | ## Synopsis 8 | 9 | Either of 10 | 11 | symbolic --m=1 --b=0 'y=m*x+b' x 12 | 13 | on the command line, or 14 | 15 | say Math::Symbolic.new("y=m*x+b").isolate("x").evaluate(:m(1), :b(0)); 16 | 17 | in Raku code, will print 18 | 19 | x=y 20 | 21 | ## Usage 22 | 23 | ### Command line 24 | 25 | A basic command line program named 'symbolic' is provided, and may be installed 26 | in your PATH. It takes at least one positional argument: the relation or 27 | expression to work with. If a second positional is passed, it is the name of 28 | the variable to isolate in the given relation (non-relation expressions are 29 | unsupported for isolation). If "0" is passed instead of a variable name, the 30 | relation is arranged with 0 on the right side and terms grouped by variable 31 | (when possible) on the left side. 32 | 33 | If any named args are passed, they are substituted into the expression for the 34 | variables they name. Each named argument's value is parsed as an expression 35 | itself, so it doesn't just have to be a numeric value to give the variable. 36 | 37 | The resulting expression will be printed after applying all requested 38 | transformations, and attempting to simplify. 39 | 40 | For development of Math::Symbolic itself, there is also a 'symbolic' bash 41 | script in the module's root directory. This will use the module and command 42 | line script in the wrapper's directory, instead of the installed versions. It 43 | also intentionally does not include blib, since precompilation isn't ordinarily 44 | done during development. 45 | 46 | ### API 47 | 48 | At the time of this writing, most of the API is too unstable to document yet. 49 | To minimize exposure to the internal chaos and to provide a starting point for 50 | thinking about what functionality needs to exist in a more formal future API, a 51 | minimal temporary public interface is implemented as a small collection of 52 | simple methods in the main Math::Symbolic class. Note that where the actual 53 | signatures differ from what is documented here, the undocumented differences 54 | are considered "private", and may not do what is expected. 55 | 56 | #### .new(Str:D $expression) 57 | 58 | Creates a new Math::Symbolic object, initialized with the tree resulting from a 59 | parse of $expression (which may also be a relation; currently only "=" equality 60 | is supported for relations). 61 | 62 | #### .clone() 63 | 64 | Returns a clone of the object with an independent copy of the tree structure. 65 | This is important because all manipulations (below) are done in place, and 66 | cloning avoids the parsing overhead of .new(). 67 | 68 | #### .isolate(Str:D $var) 69 | 70 | Arranges a relation with $var on the left and everything else on the right. Or 71 | attempts to. It supports simple operation inversion when only one instance of a 72 | variable exists, as well as attempting to combine instances via distributive 73 | property and/or factoring of polynomial expressions, if necessary. Calling 74 | .isolate on a non-relation expression is not supported. 75 | 76 | #### .evaluate(\*%values) 77 | 78 | Replaces all instances of variables named by the keys of the hash, with the 79 | expressions in the values of the hash, and simplifies the result as much as 80 | possible (see .simplify below). If the resulting expression has no variables, 81 | this means it can be fully evaluated down to a single value. 82 | 83 | Note that fully evaluating an equation with valid values would result in 84 | something mostly unhelpful like "0=0" if the simplifier is smart enough. 85 | Though in the future, when such a relation can be evaluated for truth, that 86 | will become useful. 87 | 88 | #### .simplify() 89 | 90 | Makes a childish attempt to reduce the complexity of the expression by 91 | evaluating operations on constants, removing operations on identity values (and 92 | eventually other special cases like 0, inverse identity, etc). Also already 93 | does a very small number of rearrangements of combinations of operations, like 94 | transforming a+-b into a-b. 95 | 96 | .simplify is sometimes called after certain manipulations like .isolate and 97 | .poly which might otherwise leave messy expressions e.g. operations with 98 | identity values and awkward forms of negation and inversion. It is also called 99 | at the end of the command line tool for output of the final result. 100 | 101 | #### .poly(Str $var?) 102 | 103 | Attempts to arrange the equation/expression in polynomial form. If $var is 104 | given, terms are grouped for that specific variable. Otherwise terms are 105 | grouped separately according to the set of all variables in a term. For example 106 | "x²+x²\*y" will be unchanged by .poly(), but .poly('x') will rearrange it to 107 | something like "x²\*(1+y)". Unlike the formal definition of a polynomial, this 108 | function may accept and return any expression for coefficients, and allows for 109 | exponents of any constant value. 110 | 111 | If .poly is called on a relation, it is first arranged so that the right side 112 | is equal to zero, before grouping terms on the left. An attempt is made to 113 | guess which side should be subtracted from the other to avoid ending up with an 114 | excessive amount of negation. 115 | 116 | #### .expression(Str:D $var) 117 | 118 | Creates a new Math::Symbolic object from the expression on the right-hand side 119 | of a relation after isolating $var on the left. Note that unlike the above 120 | transformations, no changes are made to the original object. 121 | 122 | #### .compile($positional = False, $defaults?) 123 | 124 | Returns a Raku subroutine which is mathematically equivalent to the 125 | Math::Symbolic expression. Not all operations are currently supported. 126 | Compiling relations is also undefined behavior at this time. 127 | 128 | All arguments are named by default. If $positional is True, all arguments are 129 | positional instead, sorted in default Raku sort order. If $positional is itself 130 | a Positional class then only the listed variables will be taken positionally, 131 | in the specified order. 132 | 133 | All arguments are also required by default. If $defaults is an Associative 134 | object, it is taken as a map of variable names to default values, and the 135 | listed variables will be optional. If $defaults is any other defined value, 136 | that value is taken as the default for all arguments. 137 | 138 | #### .routine($positional = False, $defaults?) 139 | 140 | Identical to .compile (above), but returns the code as a string without 141 | compiling via EVAL, for instance to embed the code into another module or 142 | script. 143 | 144 | #### .count() 145 | 146 | Returns the number of nodes in the expression's tree. This could be useful to 147 | determine if an expression has been fully evaluated, or used as a crude 148 | complexity metric. 149 | 150 | #### .dump_tree() 151 | 152 | Prints out the tree structure of the expression. This really should return the 153 | string instead, and perhaps be renamed. 154 | 155 | #### .Str() 156 | 157 | Returns the expression re-assembled into a string by the same syntactic 158 | constructs which govern parsing. As with all Raku objects, this is also the 159 | method which gets called when the object is coerced to a string by other means, 160 | e.g. interpolation, context, or the ~ prefix. The .gist() method is also 161 | handled by this routine, for easy printing of a readable result. 162 | 163 | Passing the result of .Str() back in to .new() should always yield a 164 | mathematically equivalent structure (exact representation may vary by some 165 | auto-simplification), giving the same type of round-trip characteristics to 166 | expressions that .raku() and EVAL() provide for Raku objects. This allows a 167 | user to, for instance, isolate a variable in an equation, then plug the result 168 | in to .evaluate() for that variable in a different equation, all with the 169 | simplicity of strings; no additional classes or APIs for the user to worry 170 | about (albeit at a steep performance penalty). 171 | 172 | #### .Numeric() 173 | 174 | Returns the expression coerced first to a string (see above), then to a number. 175 | This will fail if the expression hasn't already been evaluated/simplified (see 176 | further above) to a single constant value. As with all Raku objects, this is 177 | also the method which gets called when the object is coerced to a number by 178 | other means, e.g. context or the + prefix. 179 | 180 | ## Syntax and Operations 181 | 182 | All whitespace is optional. Implicit operations, e.g. multiplication by putting 183 | two variables in a row with no infix operator, are not supported, and likely 184 | never will be. It leads to far too many consequences, compromises, complexities 185 | and non-determinisms. 186 | 187 | The available operations and syntax in order of precedence are currently: 188 | 189 | * Terms 190 | * Variables 191 | * valid characters for variable names are alphanumerics and underscore 192 | * first character must not be a number, mainly to avoid collisions with 193 | E notation (see below) 194 | * Values 195 | * optional sign (only "-" for now) 196 | * E notation supported 197 | * case insensitive 198 | * no restriction on value of exponent, with sign and decimal 199 | * subexpressions not supported (e is numeric syntax, not an op) 200 | * leading zeros before decimals not required 201 | * imaginary, complex, quaternion, etc NYI 202 | * vector, matrix, set, etc NYI 203 | * Circumfix 204 | * () Grouping Parens 205 | * || Absolute Value 206 | * cannot invert this op for solving/manipulating, ± NYI 207 | * Postfix 208 | * ! Factorial 209 | * syntax only, no functional implementation 210 | * ² Square (same as ^ 2) 211 | * Prefix 212 | * - Negate (same as * -1) 213 | * √ Square Root (same as ^ .5) 214 | * Infix Operation 215 | * Power 216 | * ^ Exponentiation, like raku's ** 217 | * mathematical convention dictates that this operation be chained 218 | right-to-left, which is NYI 219 | * √ Root, n√x is the same as x^(1/n) 220 | * evaluates to positive only (± NYI) 221 | * imaginary numbers NYI 222 | * ^/ is a Texan variant of √ with the operands reversed 223 | * x^/n is the same as x^(1/n) or n√x 224 | * Logarithms are NYI, so no solving for variables in exponents yet 225 | * Scale 226 | * * Multiplication 227 | * / Division 228 | * Shift 229 | * + Addition 230 | * - Subtraction 231 | * Infix Relation 232 | * = Equality is currently the only relation supported 233 | * this is really because proper relations are more-or-less NYI 234 | * note that relations are optional in the input string, it automatically 235 | detects whether it is working with an expression or a relation 236 | * really it just breaks if you call 'solve' on an expression ATM 237 | 238 | ## BUGS 239 | 240 | Many, in all likelihood. Please report them to raydiak@cyberuniverses.com. 241 | Patches graciously accepted. 242 | 243 | -------------------------------------------------------------------------------- /bin/symbolic: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env raku 2 | 3 | # simple command-line interface 4 | # a few other front ends eventually could be cool 5 | # REPL 6 | # GUI analyzer/solver/teacher 7 | 8 | use Math::Symbolic; 9 | 10 | sub MAIN ( 11 | $expression, 12 | $isolate_var?, 13 | Bool:D :$raku-routine = False, 14 | Bool:D :$strip-var = False, 15 | *%vars 16 | ) { 17 | my $obj = Math::Symbolic.new($expression); 18 | 19 | $obj.evaluate(|%vars) if %vars; 20 | 21 | if defined $isolate_var { 22 | if $isolate_var eq '0' { $obj.poly } 23 | else { 24 | if $strip-var { 25 | $obj .= expression: $isolate_var; 26 | } else { 27 | $obj.isolate: $isolate_var 28 | } 29 | } 30 | } 31 | 32 | $obj.simplify; 33 | 34 | say $raku-routine ?? $obj.routine !! $obj.Str; 35 | } 36 | 37 | 38 | -------------------------------------------------------------------------------- /lib/Math/Symbolic.rakumod: -------------------------------------------------------------------------------- 1 | unit class Math::Symbolic; 2 | 3 | use Math::Symbolic::Tree; 4 | use Math::Symbolic::Language; 5 | use Math::Symbolic::Grammar; 6 | use Math::Symbolic::Actions; 7 | 8 | my %ops := Math::Symbolic::Language.by_name; 9 | my %syn := Math::Symbolic::Language.by_syntax; 10 | my %syn_syn := Math::Symbolic::Language.syntax_by_syntax; 11 | 12 | has $.tree handles ; 13 | 14 | multi method new ($in, *%args is copy) { 15 | %args = Math::Symbolic::Grammar.parse(~$in, actions => Math::Symbolic::Actions).made; 16 | die 'Parse failure: invalid expression' unless %args; 17 | 18 | self.bless: |%args; 19 | } 20 | 21 | method clone () { 22 | self.new: tree => self.tree.clone; 23 | } 24 | 25 | method child (|args) { 26 | self.new: tree => $!tree.child: |args; 27 | } 28 | 29 | method list () { 30 | my @vars = $.tree.list; 31 | 32 | @vars > 1 ?? 33 | @vars.map: { self.new: tree => $_ } !! 34 | self; 35 | } 36 | 37 | method expression (Str:D $var) { 38 | my $new := self.clone.isolate($var); 39 | my $tree := $new.tree; 40 | $tree.set: $tree.children[1]; 41 | $new; 42 | } 43 | 44 | method code ($language = 'raku', $tree = $!tree) { 45 | $tree.translate: $language; 46 | } 47 | 48 | method routine ($positional = False, $defaults? is copy, $tree = $!tree) { 49 | my @vars = $tree.find_all(:type)».content.sort.squish; 50 | if defined $defaults { 51 | $defaults = Hash.new: @vars.map: * => $defaults 52 | unless $defaults ~~ Associative; 53 | } else { 54 | $defaults = {}; 55 | } 56 | if $positional === True { @$positional = @vars; @vars = (); } 57 | elsif $positional { @vars .= grep: * !∈ @$positional; } 58 | 59 | my @sig; 60 | if $positional { 61 | for @$positional { 62 | my $default = $defaults{$_}; 63 | $default = $default.defined ?? " = $default" !! ''; 64 | @sig.push: "Numeric:D \$$_$default"; 65 | } 66 | } 67 | 68 | for @vars { 69 | my $default = $defaults{$_}; 70 | $default = $default.defined ?? " = $default" !! '!'; 71 | @sig.push: "Numeric:D :\$$_$default"; 72 | } 73 | 74 | my $sig = '--> Numeric:D'; 75 | $sig = @sig.join(', ') ~ " $sig" if @sig; 76 | 77 | "sub ($sig) is pure \{ " ~ $tree.translate('raku') ~ ' };'; 78 | } 79 | 80 | method compile (|args) { 81 | use MONKEY-SEE-NO-EVAL; 82 | EVAL self.routine(|args); 83 | } 84 | 85 | method evaluate (*%vals is copy) { 86 | for %vals.values { 87 | when Math::Symbolic::Tree {} 88 | when Math::Symbolic { 89 | $_ = $_.tree; 90 | } 91 | default { 92 | $_ = self.new(~$_).tree; 93 | } 94 | } 95 | 96 | for $!tree.find_all: :type, :content(%vals.keys.any) { 97 | $_.set: %vals{$_.content}.clone; 98 | } 99 | 100 | self.simplify; 101 | } 102 | 103 | # TODO need more property-based generic manipulations and per-op special cases, like *0, ^0, etc 104 | # but avoid adding code in the ops 105 | # iow properties are good for Operations (as long as they're optional with sane defaults), but code in those properties is bad, because the point of the Operation class is to be a simple declarative way to express the language, so minimizing complexity in the public API of ::Operation is central to its intended purpose 106 | # TODO BUG speaking of minimizing complexity in ::Operation, please convert the .function/.syntax/.syntaxes/BUILD mess to Roles or something soon 107 | # this is also highly inefficient 108 | method simplify () { 109 | my $tree = $!tree; 110 | my $hit = True; 111 | while $hit { 112 | $hit = False; 113 | my $node; 114 | 115 | # x^-n = 1/x^n 116 | if $node = $tree.find( :type, :content('power'|'root'), :children( 117 | *, 118 | {:type, :content} 119 | ) ) { 120 | $node.children[1] = $node.children[1].children[0]; 121 | $node.children[1] = $node.clone; 122 | $node.content = %ops
; 123 | $node.children[0] = Math::Symbolic::Tree.new(:type, :content(1)); 124 | $hit = True; 125 | } 126 | 127 | # x^-n = 1/x^n 128 | elsif $node = $tree.find( :type, :content('power'|'root'), :children( 129 | *, 130 | {:type, :content(* < 0)} 131 | ) ) { 132 | $node.children[1].content *= -1; 133 | $node.children[1] = $node.clone; 134 | $node.content = %ops
; 135 | $node.children[0] = Math::Symbolic::Tree.new(:type, :content(1)); 136 | $hit = True; 137 | } 138 | 139 | # sqr 140 | elsif $node = $tree.find( :type, :content, :children( 141 | *, 142 | {:type, :content(2)} 143 | ) ) { 144 | $node.content = %ops; 145 | $node.children[1] :delete; 146 | $hit = True; 147 | } 148 | 149 | # sqrt 150 | elsif $node = $tree.find( :type, :content, :children( 151 | *, 152 | {:type, :content(2)} 153 | ) ) { 154 | $node.content = %ops; 155 | $node.children[1] :delete; 156 | $hit = True; 157 | } 158 | 159 | # neg 160 | elsif $node = $tree.find( :type, :content('mul'|'div'), :children( 161 | *, 162 | {:type, :content(-1)} 163 | ) ) { 164 | $node.content = %ops; 165 | $node.children[1] :delete; 166 | $hit = True; 167 | } 168 | 169 | # neg 170 | elsif $node = $tree.find( :type, :content, :children( 171 | {:type, :content(-1)}, 172 | * 173 | ) ) { 174 | $node.content = %ops; 175 | $node.children[0] = $node.children[1]:delete; 176 | $hit = True; 177 | } 178 | 179 | # invert -> division 180 | elsif $node = $tree.find( :type, :content ) { 181 | $node.content = %ops
; 182 | $node.children[1] = $node.children[0]; 183 | $node.children[0] = $tree.new(:type, :content(1)); 184 | $hit = True; 185 | } 186 | 187 | # a/b/c -> a/(b*c) 188 | elsif $node = $tree.find( :type, :content
, :children( 189 | {:type, :content
}, 190 | * 191 | ) ) { 192 | $node.content = %ops
; 193 | $node.children[1] = $tree.new(:type, :content(%ops), :children( 194 | $node.children[0].children[1], 195 | $node.children[1] 196 | )); 197 | $node.children[0] = $node.children[0].children[0]; 198 | $hit = True; 199 | } 200 | 201 | # a/(b/c) -> a*c/b 202 | elsif $node = $tree.find( :type, :content
, :children( 203 | *, 204 | {:type, :content
} 205 | ) ) { 206 | $node.content = %ops
; 207 | $node.children[0] = Math::Symbolic::Tree.new(:type, :content(%ops), :children( 208 | $node.children[0], 209 | $node.children[1].children[1] 210 | )); 211 | $node.children[1] = $node.children[1].children[0]; 212 | $hit = True; 213 | } 214 | 215 | # a*(b/c) -> a*b/c 216 | elsif $node = $tree.find( :type, :content, :children( 217 | *, 218 | {:type, :content
} 219 | ) ) { 220 | $node.content = %ops
; 221 | $node.children[0] = Math::Symbolic::Tree.new(:type, :content(%ops), :children( 222 | $node.children[0], 223 | $node.children[1].children[0] 224 | )); 225 | $node.children[1] = $node.children[1].children[1]; 226 | $hit = True; 227 | } 228 | 229 | elsif my @nodes = $tree.find_all( :type ) { 230 | # TODO we could use a smarter pattern to not have to re-test every single op in the tree repeatedly 231 | # except now we're doing many things in here 232 | while @nodes && !$hit { 233 | $node = @nodes.shift; 234 | my $op = $node.content; 235 | my $func = $op.function; 236 | 237 | # identity value stuff 238 | my $ident = $func.identity; 239 | if defined $ident { 240 | my $do = False; 241 | my $val = $node.children[1]; 242 | $do = ($val.type eq 'value' && $val.content ~~ $ident); 243 | my $flip = False; 244 | unless $do { 245 | $val = $node.children[0]; 246 | $do = ( 247 | $func.commute ~~ Bool && 248 | $func.commute && 249 | $val.type eq 'value' && 250 | $val.content ~~ $ident 251 | ); 252 | $flip = True; 253 | } 254 | if $do { 255 | my $new; 256 | if $flip { 257 | $new = $node.children[1]; 258 | } else { 259 | $new = $node.children[0]; 260 | } 261 | $node.type = $new.type; 262 | $node.content = $new.content; 263 | $node.children = $new.children; 264 | $hit = True; 265 | } 266 | } 267 | 268 | # inversion 269 | if !$hit { 270 | if $func.arity == 1 { 271 | my $child = $node.children[0]; 272 | if $child.type eq 'operation' { 273 | my $child_op = $child.content; 274 | my $child_func = $child_op.function; 275 | if $child_op.arity == 1 && $func.inverse === $child_op { 276 | $node.type = $child.children[0].type; 277 | $node.content = $child.children[0].content; 278 | $node.children = $child.children; 279 | $hit = True; 280 | } elsif $child_op.arity == 2 && $child_func.commute !=== True && 281 | $child_func.invert-via === $node.content { 282 | $node.content = $child_op; 283 | $node.children = $child.children.reverse; 284 | #self.dump_tree($node); 285 | $hit = True; 286 | } 287 | } 288 | } elsif $func.arity == 2 { 289 | my $inv_via = $func.invert-via; 290 | if $inv_via { 291 | for 1, 0 -> $i { 292 | my $child := $node.children[$i]; 293 | 294 | my $do = False; 295 | if $child.type eq 'operation' && 296 | $child.content === $inv_via { 297 | $child = $child.children[0]; 298 | $do = True; 299 | } elsif $inv_via eq 'neg' && 300 | $child.type eq 'value' && 301 | $child.content < 0 { 302 | $child.content *= -1; 303 | $do = True; 304 | } 305 | 306 | if $do { 307 | $node.content = $func.inverse; 308 | $node.children .= reverse unless $i; 309 | $hit = True; 310 | last; 311 | } 312 | 313 | last unless $func.commute === True; 314 | } 315 | } 316 | } 317 | } 318 | } 319 | } 320 | 321 | # invert -> division - we put this last, so that inversion is preserved for matching against inv-via 322 | elsif $node = $tree.find( :type, :content ) { 323 | $node.content = %ops
; 324 | $node.children[1] = $node.children[0]; 325 | $node.children[0] = $tree.new(:type, :content(1)); 326 | $hit = True; 327 | } 328 | } 329 | 330 | self.fold; 331 | } 332 | 333 | method fold ($tree = $!tree) { 334 | my $hit = True; 335 | while $hit && my @nodes = $tree.find_all: :type { 336 | $hit = False; 337 | for @nodes -> $node { 338 | my $func = $node.content.function; 339 | if $func && (my &eval := $func.eval) && 340 | $node.children.all.type eq 'value' { 341 | $node.type = 'value'; 342 | $node.content = eval( |@($node.children».content) ); 343 | $node.children = (); 344 | $hit = True; 345 | } 346 | } 347 | } 348 | 349 | self; 350 | } 351 | 352 | method poly ($var?, :$coef) { 353 | self.normalize; 354 | self.expand; 355 | 356 | my $tree = $!tree; 357 | 358 | my $work = $tree; 359 | 360 | if $tree.type eq 'relation' { 361 | my $side = 0; 362 | if defined $var { 363 | my @paths = $tree.find_all: :type, :content($var), :path; 364 | die "Error: variable '$var' not found in '$tree'" unless @paths; 365 | 366 | my %side_var := @paths»[0].Bag; 367 | $side = +(%side_var{0} < %side_var{1}); 368 | 369 | if %side_var.keys == 1 { 370 | my @path; 371 | my $i = 0; 372 | my $max_elems = @paths».elems.min; 373 | while $max_elems > $i && @paths»[$i].unique == 1 { 374 | @path[$i] = @paths[0][$i]; 375 | $i++; 376 | } 377 | 378 | if @path > 1 { 379 | self.isolate: :@path; 380 | $side = 0; 381 | } 382 | } # TODO else do something clever? can't solve t=√t, but can solve t²=t... 383 | } else { 384 | $side = ($tree.children[0].count < $tree.children[1].count); 385 | } 386 | 387 | $tree.children .= reverse if $side; 388 | $work = $tree.children[0]; 389 | my $opp := $tree.children[1]; 390 | 391 | my %zero = :type, :content(0); 392 | unless $opp.match: |%zero { 393 | @($work.children) = $work.clone, $tree.new( 394 | :type, :content(%ops), 395 | :children[ $tree.new(:type,:content(-1)), $opp ] 396 | ); 397 | $work.type = 'operation'; 398 | $work.content = %ops; 399 | 400 | $opp = $tree.new: |%zero; 401 | 402 | self.expand; 403 | } 404 | } 405 | 406 | my \ret = self.condense($var, $work, :$coef); 407 | self.simplify; 408 | ret; 409 | } 410 | 411 | method condense ($var?, $tree = $!tree, :$coef = False) { 412 | use Math::Symbolic::MultiHash; 413 | 414 | # self.normalize: $tree; 415 | 416 | my $type = $tree.type; 417 | 418 | if $type eq 'relation' { 419 | self.condense: $var, $_ for $tree.children; 420 | } 421 | 422 | if $type ne 'operation' { 423 | die 'Error: coefficient analysis is only available for operation nodes' 424 | if $coef; 425 | return self; 426 | } 427 | 428 | my $op = $tree.content; 429 | my $func = $op.function; 430 | my $up = $func.up; 431 | my @c = $tree.children; 432 | 433 | unless $up { 434 | self.condense: $var, $_ for @c; 435 | return self; 436 | } 437 | 438 | my @parts; 439 | my $upup = $up.function.up; 440 | my $vars = Math::Symbolic::MultiHash.new; 441 | my $n := $vars.elem(); 442 | for $tree.chain { 443 | my $type = $_.type; 444 | my $content = $_.content; 445 | if $type eq 'symbol' { 446 | $vars.elem($content => 1)[0]++; 447 | } elsif $type eq 'value' { 448 | if defined $n[0] { 449 | $n[0] = ($func.eval)($n[0], $content); 450 | } else { 451 | $n[0] = $content; 452 | } 453 | } elsif $type eq 'operation' { 454 | if $content eq $up { 455 | my %subvar_count; 456 | my @subparts; 457 | my $subfunc = $up.function; 458 | 459 | if $subfunc.commute { 460 | for $_.chain -> $sub { 461 | my $subtype = $sub.type; 462 | my $subcontent = $sub.content; 463 | if $subtype eq 'symbol' { 464 | %subvar_count{$subcontent}++; 465 | } elsif $subtype eq 'value' { 466 | if %subvar_count{''}:exists { 467 | %subvar_count{''} = ($subfunc.eval)( 468 | %subvar_count{''}, $subcontent ); 469 | } else { 470 | %subvar_count{''} = $subcontent; 471 | } 472 | } elsif $upup && $subtype eq 'operation' && $subcontent eq $upup && 473 | $sub.match: :children({:type,}, {:type,}) { 474 | %subvar_count{$sub.children[0].content} += $sub.children[1].content; 475 | } else { 476 | @subparts.push: $sub; 477 | } 478 | } 479 | } elsif $_.match: :children({:type,}, {:type,}) { 480 | %subvar_count{$_.children[0].content}++; 481 | %subvar_count{''} += $_.children[1].content; 482 | } else { 483 | @subparts.push: $_; 484 | } 485 | 486 | my $count = %subvar_count{''}:delete // 1; 487 | 488 | %subvar_count .= grep: *.value; 489 | my $elem := $vars.elem(|%subvar_count); 490 | if %subvar_count { 491 | $elem[0] += $count; 492 | } else { 493 | unshift @subparts: $tree.new: :type, :content($count) 494 | unless $count == $subfunc.identity; 495 | } 496 | 497 | $elem.push: $tree.new-chain: $up, @subparts if @subparts; 498 | } elsif $upup && $content eq $upup && $_.match: 499 | :children({:type,}, {:type,}) { 500 | $vars.elem($_.children[0].content => $_.children[1].content)[0] += 1; 501 | } else { 502 | @parts.push: $_; 503 | } 504 | } else { 505 | die "Error: cannot manipulate nodes of type '$type'"; 506 | } 507 | } 508 | 509 | if @parts { 510 | $n.push: 1 unless @$n; 511 | $n.append: @parts; 512 | } 513 | 514 | $vars.hash .= grep: { my $v := .value; $v[0] || $v.elems > 1 }; 515 | 516 | self.condense: Any, $_ for $vars.values».grep(Math::Symbolic::Tree).List.flat; 517 | 518 | if $var { 519 | my $newvars = $vars.new; 520 | # transform for requested $var here 521 | for $vars.kv -> $keyhash, $vals { 522 | my $power = $keyhash{$var} :delete // 0; 523 | my @subparts; 524 | if $upup { 525 | @subparts.append: $keyhash.map: { 526 | .value == $upup.function.identity ?? $tree.new-sym(.key) !! 527 | $tree.new-op($upup, $tree.new-sym(.key), $tree.new-val(.value)) 528 | }; 529 | } else { 530 | @subparts.append: $keyhash.map: -> $p { 531 | my @sub; 532 | @sub.push: $tree.new-sym($p.key) for ^($p.value); 533 | @sub; 534 | }; 535 | } 536 | my $elem := $newvars.elem($var => $power); 537 | my $co = @$vals.shift; 538 | if ($co ~~ Math::Symbolic::Tree) { 539 | unshift @subparts: $co.clone; 540 | } else { 541 | unshift @subparts: $tree.new-val: $co;# if $co != $up.function.identity; 542 | } 543 | $elem.push: $tree.new-chain: $up, @subparts if @subparts; 544 | $elem.append: @$vals; 545 | } 546 | 547 | $vars := $newvars; 548 | } 549 | 550 | # then convert back into a ::Tree and $tree.set 551 | my @new_parts; 552 | for $vars.keys -> $keyhash { 553 | my $vals := $vars.hash{$keyhash}; 554 | my @subparts; 555 | 556 | for $keyhash.keys.sort -> $kk { 557 | my $kv := $keyhash{$kk}; 558 | if (defined $var and $kk eq $var) || $kv != 1 { 559 | my $new; 560 | if $upup { 561 | $new = $tree.new-op: $upup, $tree.new-sym($kk), $tree.new-val($kv); 562 | } elsif $kv == $kv.Int && $kv > 0 { 563 | $new.push: $tree.new-sym($kk) for 1..$kv; 564 | $new = $tree.new-chain: $up, |@$new; 565 | } else { 566 | die "Error: this transformation would require the Knuth up arrow (NYI)"; 567 | } 568 | if defined($var) && $kk eq $var && $up.function.commute { 569 | @subparts.unshift: $new; 570 | } else { 571 | @subparts.push: $new; 572 | } 573 | } else { 574 | @subparts.push: $tree.new-sym($kk); 575 | } 576 | } 577 | 578 | if @$vals && $vals[0] ~~ Numeric && 579 | (my $v = $vals.shift) != $op.function.identity { 580 | if $op.function.commute { $vals.unshift: $tree.new-val: $v } 581 | else { $vals.push: $tree.new-val: $v } 582 | } 583 | 584 | @subparts.push: $tree.new-chain: $op, @$vals if @$vals; 585 | 586 | @new_parts.append: ($vals = $tree.new-chain: $up, @subparts); 587 | } 588 | 589 | $tree.set: $tree.new-chain($op, @new_parts); 590 | 591 | if $coef { 592 | die 'Error: returning coefficients is only supported for a single specific variable' 593 | unless defined $var; 594 | die "Error: couldn't reduce '$tree' to a polynomial in $var" 595 | unless $vars.keys».keys.all eq $var; 596 | 597 | my %return; 598 | for $vars.kv -> $k, $v { 599 | %return{$k.values[0]} = $v.children[1]; 600 | } 601 | return %return; 602 | } 603 | 604 | self; 605 | } 606 | 607 | # roughly opposite of simplify 608 | # expands shorthand ops (eg a² -> a^2) 609 | # inverts non-commutative ops to commutable forms (eg a-b -> a+-1*b) 610 | # folds constants 611 | method normalize ($tree = $!tree) { 612 | my $hit = True; 613 | while $hit { 614 | $hit = False; 615 | my $node; 616 | 617 | # sqr -> power 618 | if $node = $tree.find( :type, :content ) { 619 | $node.content = %ops; 620 | $node.children[1] = $tree.new( :type, :content(2) ); 621 | $hit = True; 622 | } 623 | 624 | # sqrt -> power 625 | elsif $node = $tree.find( :type, :content ) { 626 | $node.content = %ops; 627 | $node.children[1] = $tree.new( :type, :content(.5) ); 628 | $hit = True; 629 | } 630 | 631 | elsif my @nodes = $tree.find_all( :type ) { 632 | # TODO we could use a smarter pattern to not have to re-test every single op in the tree repeatedly 633 | # except now we're doing many things in here 634 | while @nodes && !$hit { 635 | $node = @nodes.shift; 636 | my $op = $node.content; 637 | my $func = $op.function; 638 | 639 | # inversion stuff 640 | my $inv = $func.inverse; 641 | my $inv-via = $func.invert-via; 642 | if !$func.normal && $func.arity == 2 && $inv && $inv.function.normal && $inv-via { 643 | $node.children[1] = $tree.new( 644 | :type, :content($inv-via), 645 | :children[$node.children[1]] 646 | ); 647 | $node.content = $inv; 648 | 649 | $hit = True; 650 | } 651 | 652 | # identity value stuff 653 | if !$hit && defined (my $ident = $func.identity) { 654 | my $do = False; 655 | my $val = $node.children[1]; 656 | $do = ($val.type eq 'value' && $val.content ~~ $ident); 657 | my $flip = False; 658 | unless $do { 659 | $val = $node.children[0]; 660 | $do = ( 661 | $func.commute ~~ Bool && 662 | $func.commute && 663 | $val.type eq 'value' && 664 | $val.content ~~ $ident 665 | ); 666 | $flip = True; 667 | } 668 | if $do { 669 | my $new; 670 | if $flip { 671 | $new = $node.children[1]; 672 | } else { 673 | $new = $node.children[0]; 674 | } 675 | $node.type = $new.type; 676 | $node.content = $new.content; 677 | $node.children = $new.children; 678 | $hit = True; 679 | } 680 | } 681 | } 682 | } 683 | 684 | # these two should come last to allow the former to match inverse ops 685 | 686 | # invert -> power 687 | if !$hit && ($node = $tree.find( :type, :content )) { 688 | $node.content = %ops; 689 | $node.children[1] = $tree.new(:type, :content(-1)); 690 | $hit = True; 691 | } 692 | 693 | # neg -> mul 694 | elsif $node = $tree.find( :type, :content ) { 695 | $node.content = %ops; 696 | $node.children[1] = $tree.new(:type, :content(-1)); 697 | $hit = True; 698 | } 699 | } 700 | 701 | self.fold; 702 | } 703 | 704 | # need sink_ops and float_ops (transform via down/up) 705 | # expand is sink 706 | # does .float need a param like .poly? .float=.poly? .poly=.isolate? 707 | # .poly = {.sink; .arrange;? .float;} 708 | method expand () { 709 | my $tree = $!tree; 710 | 711 | my $hit = True; 712 | while $hit { 713 | $hit = False; 714 | 715 | for $tree.find_all(:children( 716 | {:type,}, 717 | {:type,} 718 | )) -> $node { 719 | $node.content = +$node; 720 | $node.type = 'value'; 721 | $node.children = (); 722 | $hit = True; 723 | } 724 | 725 | for $tree.find_all(:type) -> $node { 726 | my $op = $node.content; 727 | next unless $op.arity == 2; 728 | next unless my $func = $op.function; 729 | next unless my $down = $func.down; 730 | my $i; 731 | if $node.match: :children( *, 732 | { 733 | :type, 734 | :content( {$_ == $_.Int and $_ > 0} ) 735 | } 736 | ) { 737 | $i = 0; 738 | } elsif $func.commute && 739 | $node.match: :children( 740 | { 741 | :type, 742 | :content( {$_ == $_.Int and $_ > 0} ) 743 | }, * 744 | ) { 745 | $i = 1; 746 | } 747 | 748 | if defined $i { 749 | my $child = $node.children[$i]; 750 | my $ident = $func.identity; 751 | my $rep = $node.children[1-$i].content - $ident; 752 | next unless $rep-- > 0; 753 | my $val = $child.content; 754 | my $tmpl = $tree.new: :type, :content($down), 755 | :children($child, $child.clone); 756 | my $new = $tmpl.clone; 757 | 758 | while $rep-- { 759 | my $old = $new; 760 | $new = $tmpl.clone; 761 | $new.children[1] = $old; 762 | } 763 | 764 | $node.content = $new.content; 765 | $node.children = $new.children; 766 | $hit = True; 767 | last; 768 | } 769 | 770 | # distribution 771 | my $content = $down.name | $down.function.inverse.name; 772 | if $node.children[0].match: :type, :$content 773 | { $i = 0 } 774 | elsif $func.commute === True && 775 | $node.children[1].match: :type, :$content 776 | { $i = 1 } 777 | if defined $i { 778 | my $child = $node.children[$i]; 779 | $child.children .= map: { 780 | my $new = $node.clone; 781 | $new.children[$i] = $_; 782 | $new; 783 | }; 784 | $node.content = $child.content; 785 | $node.children = $child.children; 786 | $hit = True; 787 | last; 788 | } 789 | } 790 | 791 | # btw this tree/while/hit/find thing is looking familiar...wrap? 792 | } 793 | 794 | self; 795 | } 796 | 797 | our ($det_template, $quad_template_det, $quad_template_nodet); 798 | method isolate_quadratic ($var, $a, $b, $c, :$tree = $!tree) { 799 | $det_template //= Math::Symbolic.new('b^2-4*a*c'); 800 | 801 | my $det = $det_template.clone(); 802 | $det.evaluate(:$a, :$b, :$c).fold; 803 | my $detval = $det.tree.type eq 'value' ?? +$det !! Any; 804 | 805 | my $new = $detval.defined && $detval == 0 ?? 806 | ($quad_template_nodet //= 807 | Math::Symbolic.new('x = -b / 2*a')).clone !! 808 | ($quad_template_det //= 809 | Math::Symbolic.new('x = (-b ± √det) / (2*a)')).clone; 810 | 811 | $new.evaluate: :$a, :$b, :$c, :$det, 812 | :x(Math::Symbolic::Tree.new-sym: $var); 813 | 814 | $tree.set: $new.tree; 815 | 816 | self; 817 | } 818 | 819 | proto method isolate (|) {*} 820 | 821 | multi method isolate (Str:D $var) { 822 | my $tree = $!tree; 823 | 824 | my @paths = $tree.find_all: :type, :content($var), :path; 825 | if @paths > 1 { 826 | my %coeffs = self.poly($var, :coef); 827 | die "Error: cannot isolate $var in '{self}': " ~ 828 | 'the polynomial must have only one variable term, or be degree 0, 1, or 2' 829 | unless %coeffs.keys.grep(* ne 0) <= 1 || %coeffs.keys.all == 0|1|2; 830 | 831 | if %coeffs{1 & 2} :exists { 832 | %coeffs<0> //= Math::Symbolic::Tree.new-val: 0; 833 | self.isolate_quadratic($var, |%coeffs{2...0}); 834 | } else { 835 | # removes extraneous x^0 before re-calling isolate for a single instance of $var 836 | for $tree.find_all: :type, :content, :children( 837 | { :type, :content($var) }, 838 | { :type, :content(0) } 839 | ) { 840 | $_.set: :type, :content(1), :children(); 841 | } 842 | 843 | self.isolate: $var; 844 | } 845 | } elsif !@paths { 846 | die "Error: symbol '$var' not found in relation '$tree'"; 847 | } else { 848 | self.isolate: :path(@paths[0]); 849 | } 850 | 851 | self.simplify; 852 | } 853 | 854 | multi method isolate (:@path) { 855 | my $tree = $!tree; 856 | 857 | die 'Error: can only isolate variables in relations' 858 | unless $tree.type eq 'relation'; 859 | 860 | my $i = @path.shift; 861 | $tree.children .= reverse if $i != 0; 862 | my $work = $tree.children[0]; 863 | 864 | my $complete = !$work.children; 865 | while defined($i = @path.shift) { 866 | my $next = $work.children[$i]; 867 | die 'Error: encountered non-operation parent node' 868 | unless $work.type eq 'operation'; 869 | 870 | my $op = $work.content; 871 | my $func = $op.function; 872 | my $invop = $func.inverse; 873 | die "Error: inversion of '$op' is NYI" unless $invop; 874 | my $new; 875 | 876 | if $i != 0 { 877 | my $commute = $func.commute; 878 | if $commute { 879 | if $commute eq 'inverse' { 880 | $next = $work; 881 | $next.children .= reverse; 882 | $next.children[0] = $tree.new( 883 | :type, :content($func.invert-via), 884 | :children($next.children[0]) 885 | ); 886 | @path.unshift: 0, 0; 887 | $new = False; 888 | } else { 889 | $work.children .= reverse; 890 | } 891 | } else { 892 | die "Error: reversing '$op' is NYI"; 893 | } 894 | } 895 | 896 | if !defined $new { 897 | die "Error: inversion of '$op' is NYI" if $op.arity > 2; 898 | my @children = $tree.children[1]; 899 | 900 | @children.push: $work.children[1] if $op.arity > 1; 901 | 902 | $new = Math::Symbolic::Tree.new( 903 | type => 'operation', 904 | content => $invop, 905 | :@children 906 | ); 907 | } 908 | 909 | $tree.children[0] = $next; 910 | $tree.children[1] = $new if $new; 911 | 912 | $work = $next; 913 | } 914 | 915 | self; 916 | } 917 | 918 | method !dump_parse ($tree, $level = 0, $anno is copy = '') { 919 | $anno = "$anno: " if $anno; 920 | my $is_array = !($tree ~~ Match); 921 | my $str = $tree.Str; 922 | $str = (@$tree».Str).join: ', ' if $is_array; 923 | say(' ' x 4*$level ~ $anno ~ $str); 924 | my @matches = $tree; 925 | @matches = @$tree unless $tree ~~ Match; 926 | for @matches -> $match { 927 | for $match.hash.keys { 928 | self!dump_parse($match.hash{$_}, $level+1, $_); 929 | } 930 | } 931 | } 932 | 933 | method dump_tree ($tree? is copy, $level = 0) { 934 | $tree //= $!tree; 935 | say( ' ' x 4*$level ~ $tree.type ~ ': ' ~ $tree.content); 936 | for $tree.children.list { 937 | self.dump_tree($_, $level+1); 938 | } 939 | } 940 | 941 | method raku () { 942 | my $str = self.HOW.name(self); 943 | $str ~= '.new(' ~ self.Str.raku ~ ')' if defined self; 944 | $str; 945 | } 946 | 947 | method gist () { self.Str } 948 | 949 | 950 | 951 | #`[[[ 952 | 953 | Inverse 954 | ↔ 955 | Negative Positive 956 | +----------------+----------------+ 957 | | | | 958 | | √ | ^ | 959 | | √ | ^ ^ | 960 | | √ √ | ^ ^ | 3 961 | | √ √ | | 962 | | √ | | 963 | | | | 964 | +----------------+----------------+ ↑ Up 965 | | | | 966 | | ÷ | × × | 967 | | | ×× ×× | 968 | | ÷÷÷÷÷÷÷ | × | 2 969 | | | ×× ×× | 970 | | ÷ | × × | 971 | | | | 972 | +----------------+----------------+ ↓ Down 973 | | | | 974 | | | + | 975 | | | + | 976 | | ------- | +++++++++ | 1 977 | | | + | 978 | | | + | 979 | | | | 980 | +----------------+----------------+ 981 | 982 | An op distributes over either op 1 level down from it. 983 | 984 | Positive ops associate and commute, except level 3. 985 | 986 | Level 1 has identity 0, while the rest have identity 1. 987 | 988 | Each subsequent positive op is a repetition of the op directly below it. However, no obvious similar relation seems to exist between the negative ops. 989 | 990 | A positive op with an integer second argument is equal to the op 1 level down iterated that many times on its own identity value, given the original first arg as the second. 991 | 992 | An op with a negative second arg is equal to the negative op 1 level down with it's first arg set to its own identity value, and the second arg set to the original op with a negd (positive) second arg. 993 | 994 | ]]] 995 | 996 | 997 | 998 | -------------------------------------------------------------------------------- /lib/Math/Symbolic/Actions.rakumod: -------------------------------------------------------------------------------- 1 | unit class Math::Symbolic::Actions; 2 | 3 | use Math::Symbolic::Tree; 4 | use Math::Symbolic::Language; 5 | my %ops_by_syn = Math::Symbolic::Language.by_syntax; 6 | 7 | method TOP ($/) { 8 | make $.made // $.made; 9 | } 10 | 11 | method equation ($/) { 12 | make Math::Symbolic::Tree.new: 13 | type => 'relation', 14 | content => '=', 15 | :children($[0].made, $[1].made); 16 | } 17 | 18 | method expression ($/) { 19 | make $.made // $.made; 20 | } 21 | 22 | method term ($/) { 23 | $ ?? 24 | make Math::Symbolic::Tree.new-sym($.Str) !! 25 | make Math::Symbolic::Tree.new-val($.Str); 26 | } 27 | 28 | method operation ($/) { 29 | make 30 | $.made // 31 | $.made // 32 | $.made // 33 | $.made; 34 | } 35 | 36 | method circumfix_operation ($/) { 37 | my $op = %ops_by_syn{"$0$1"}; 38 | my $made; 39 | 40 | $op && $op.function ?? 41 | make Math::Symbolic::Tree.new-op: 42 | %ops_by_syn{"$0$1"}, 43 | $.made !! 44 | make $.made; 45 | } 46 | 47 | method postfix_term ($/) { 48 | make $.made // 49 | $.made; 50 | } 51 | 52 | method postfix_operation_chain ($/) { 53 | my @ops = @».made; 54 | my $tree = $.made; 55 | $tree = Math::Symbolic::Tree.new-op(%ops_by_syn{@ops.shift}, $tree) 56 | while @ops; 57 | make $tree; 58 | } 59 | 60 | method postfix_operator ($/) { 61 | make $/.Str; 62 | } 63 | 64 | method prefix_operation ($/) { 65 | make Math::Symbolic::Tree.new-op: 66 | %ops_by_syn{$.made}, 67 | $.made; 68 | } 69 | 70 | method prefix_operator ($/) { 71 | make $/.Str; 72 | } 73 | 74 | method prefix_term ($/) { 75 | make 76 | $.made // 77 | $.made // 78 | $.made // 79 | $.made // 80 | $.made; 81 | } 82 | 83 | method infix_operation_chain ($/) { 84 | make 85 | $.made // 86 | $.made // 87 | $.made; 88 | } 89 | 90 | method infix_chain_a ($/) { 91 | my @terms = @».made; 92 | my @ops = @; 93 | my $tree = @terms.shift; 94 | $tree = Math::Symbolic::Tree.new-op: 95 | %ops_by_syn{@ops.shift.Str}, 96 | $tree, 97 | @terms.shift 98 | while @ops; 99 | make $tree; 100 | } 101 | 102 | method infix_chain_b ($/) { 103 | my @terms = @».made; 104 | my @ops = @; 105 | my $tree = @terms.shift; 106 | $tree = Math::Symbolic::Tree.new-op: 107 | %ops_by_syn{@ops.shift.Str}, 108 | $tree, 109 | @terms.shift 110 | while @ops; 111 | make $tree; 112 | } 113 | 114 | method infix_chain_c ($/) { 115 | my @terms = @».made; 116 | my @ops = @; 117 | my $tree = @terms.shift; 118 | $tree = Math::Symbolic::Tree.new-op: 119 | %ops_by_syn{@ops.shift.Str}, 120 | $tree, 121 | @terms.shift 122 | while @ops; 123 | make $tree; 124 | } 125 | 126 | method infix_term_a ($/) { 127 | make $.made // $.made; 128 | } 129 | 130 | method infix_term_b ($/) { 131 | make $.made // $.made; 132 | } 133 | 134 | method infix_term_c ($/) { 135 | make $.made; 136 | } 137 | 138 | method infix_term ($/) { 139 | make 140 | $.made // 141 | $.made // 142 | $.made // 143 | $.made; 144 | } 145 | 146 | 147 | -------------------------------------------------------------------------------- /lib/Math/Symbolic/Constants.rakumod: -------------------------------------------------------------------------------- 1 | unit module Math::Symbolic::Constants; 2 | 3 | # is this just another node type? 4 | #enum Representation is export ; 5 | 6 | enum Node is export ; 7 | enum Language is export ; 8 | 9 | subset NumIn of Numeric is export; 10 | subset NumOut of Real:D is export; 11 | 12 | -------------------------------------------------------------------------------- /lib/Math/Symbolic/Grammar.rakumod: -------------------------------------------------------------------------------- 1 | unit grammar Math::Symbolic::Grammar; 2 | 3 | #use Grammar::Debugger; 4 | 5 | # should have planned precedence levels: 6 | # circumfix () 7 | # postfix ! 8 | # prefix - √ 9 | # infix 10 | # root √ 11 | # special case: operands are backwards from its inverse op ( ^ ) 12 | # power ^ 13 | # special case: right-to-left 14 | # scale * / 15 | # shift + - 16 | 17 | use Math::Symbolic::Language; 18 | 19 | my (@circ, @pre, @post, %in); 20 | for Math::Symbolic::Language.operations.grep({.syntaxes}) -> $op { 21 | for $op.syntaxes -> $syn { 22 | next if defined $syn.language; 23 | given $syn.type { 24 | when 'circumfix' { 25 | @circ.push: $syn; 26 | } 27 | when 'prefix' { 28 | @pre.push: $syn; 29 | } 30 | when 'postfix' { 31 | @post.push: $syn; 32 | } 33 | when 'infix' { 34 | # would .push autovivify here? 35 | %in{$syn.precedence}[*-0] = $syn; 36 | } 37 | } 38 | } 39 | } 40 | my @prec = %in.keys.sort: +*; 41 | # TODO fix this listy mess 42 | my %circ; 43 | for @circ { 44 | my @parts := .parts; 45 | %circ{@parts[0]} = @parts[1]; 46 | } 47 | 48 | my %syn = %( 49 | in => $%(%in{*}.map({@$_}).flat.map: {.key => $_}), 50 | circ => $%(@circ.map: {.key => $_}), 51 | pre => $%(@pre.map: {.key => $_}), 52 | post => $%(@post.map: {.key => $_}) 53 | ); 54 | 55 | token TOP { | } 56 | 57 | token equation { + \= > \= } 58 | 59 | # putting term first here would speed things up, think about negate ramifications 60 | # also other places like infix_term etc 61 | # this ties in with the - prefix op vs negative constant question 62 | rule expression { \s* [|] } 63 | 64 | token sign { \+ | \- } 65 | token value { ? [ \.\d+ | \d+[\.\d*]? ] } 66 | token constant { [:i e ]? } 67 | 68 | token variable { * } 69 | rule term { \s* [|] } 70 | 71 | token operation { 72 | | 73 | | 74 | | 75 | 76 | } 77 | 78 | token infix_term { 79 | | 80 | | 81 | | 82 | 83 | } 84 | 85 | token postfix_term { 86 | | 87 | # | # TODO BUG postfix is hard-coded to take precedence over prefix for now 88 | 89 | } 90 | 91 | token prefix_term { 92 | | # TODO BUG postfix is hard-coded to take precedence over prefix for now 93 | | 94 | | 95 | | 96 | 97 | } 98 | 99 | # for now, we will have to use a hard-coded number of precedence levels 100 | # until the problem with the following block can be resolved 101 | my $in_ops_a = '[' ~ @(%in{@prec[2]}».parts»[0]).map("'" ~ * ~ "'").join('|') ~ ']'; 102 | my $in_ops_b = '[' ~ @(%in{@prec[1]}».parts»[0]).map("'" ~ * ~ "'").join('|') ~ ']'; 103 | my $in_ops_c = '[' ~ @(%in{@prec[0]}».parts»[0]).map("'" ~ * ~ "'").join('|') ~ ']'; 104 | rule infix_operation_chain { | | } 105 | rule infix_chain_a {>[ $=<$in_ops_a> ]+} 106 | rule infix_chain_b {>[ $=<$in_ops_b> ]+} 107 | rule infix_chain_c {>[ $=<$in_ops_c> ]+} 108 | token infix_term_a { | } 109 | token infix_term_b { | } 110 | token infix_term_c { } 111 | 112 | #`[[[ 113 | my (@in_terms, @in_chains); 114 | for ^@prec { 115 | my ($term, $chain); 116 | if $_ == 0 { 117 | $term = token { }; 118 | } else { 119 | $term = token { <{ @in_chains[*-1] }> | <{ @in_terms[*-1] }> }; 120 | } 121 | @in_terms.push: $term; 122 | @in_chains.push: rule {<$term>[ (<@(%in{@prec[$_]}».parts»[0])>) <$term>]+}; 123 | } 124 | rule infix_operation_chain { <@( reverse @in_chains )> } 125 | ]]] 126 | 127 | rule prefix_operation { <.ws> } 128 | my $pre_ops = '[' ~ @(@pre».parts»[0]).map("'" ~ * ~ "'").join('|') ~ ']'; 129 | token prefix_operator { <$pre_ops> } 130 | 131 | rule postfix_operation_chain { 132 | <.ws> > 133 | + 134 | } 135 | my $post_ops = '[' ~ @(@post».parts»[0]).map("'" ~ * ~ "'").join('|') ~ ']'; 136 | token postfix_operator { <$post_ops> } 137 | 138 | rule circumfix_operation { () () } 139 | my $circ_open = '[' ~ @(%circ.keys).map("'" ~ * ~ "'").join('|') ~ ']'; 140 | my $circ_close = '[' ~ @(%circ.values).map("'" ~ * ~ "'").join('|') ~ ']'; 141 | token circumfix_open { <$circ_open> } 142 | token circumfix_close { <$circ_close> } 143 | 144 | -------------------------------------------------------------------------------- /lib/Math/Symbolic/Language.rakumod: -------------------------------------------------------------------------------- 1 | unit class Math::Symbolic::Language; 2 | 3 | # should be instances, singletons are bad 4 | # think about dependency injection 5 | # ::Language (ops/syntax) 6 | # basically a collection of ::Operations and APIs thereto 7 | # if all syn and ops are just ::Operations, do we need a whole namespace for ::Language? 8 | # probably, so as to facilitate looking them up in the various ways needed, if nothing else 9 | # think about the ways in which both tree and grammar use these 10 | # also think about future internal and external use cases, API-wise 11 | 12 | # might prefer to turn this into an abstract base class for languages 13 | #`[[[ maybe reduce an entire language to a single table w/columns like: 14 | name/function 15 | sequence of static and dynamic parts 16 | not sure how best to represent this yet 17 | this one list will serve the purposes of arity, type, reverse, parts, and key 18 | though many of those may still exist as ro attrs/methods (like key is now), but won't need to be directly specified 19 | precedence and language are an interesting question: in an ideal world, they wouldn't be specified here at all, 20 | instead a precedence level would be an unordered set of its syntaxes, and a language would be an ordered set of precedence groups 21 | this is interesting, because things like -fixness position, arity, and rtl vs ltr should be consistent across a whole precedence group anyway 22 | so really, the sequence structure is a property of the precedence group, only the choice of characters for the static parts in that sequence varies per op 23 | btw rtl vs ltr isn't addressed here yet either...just another flag? associativity too 24 | 25 | currently: 26 | has $.name; 27 | has $.arity; 28 | has $.type; # prefix, postfix, infix, circumfix 29 | has $.precedence; 30 | has Bool $.reverse = False; 31 | has @.parts; 32 | has $.key = @!parts.join: ''; 33 | has $.language; 34 | ]]] 35 | 36 | use Math::Symbolic::Operation; 37 | 38 | sub Op (|args) { Math::Symbolic::Operation.new(|args) } 39 | 40 | my @operations = BEGIN ( 41 | Op( 42 | :name, 43 | :function{ 44 | :eval( &infix:<+> ), 45 | :up, 46 | :inverse, 47 | :invert-via, 48 | :identity(0), 49 | :commute, 50 | :associative, 51 | :normal 52 | }, 53 | :syntaxes( 54 | { 55 | :type, 56 | :precedence(3), 57 | :parts< + > 58 | }, 59 | { 60 | :language, 61 | :type, 62 | :parts< + > 63 | }, 64 | ), 65 | ), 66 | Op( 67 | :name, 68 | :function{ 69 | :eval( &infix:<-> ), 70 | :inverse, 71 | :invert-via, 72 | :identity(0) 73 | }, 74 | :syntaxes( 75 | { 76 | :type, 77 | :precedence(3), 78 | :parts< - > 79 | }, 80 | { 81 | :language, 82 | :type, 83 | :parts< - > 84 | }, 85 | ), 86 | ), 87 | Op( 88 | :name, 89 | :function{ 90 | :eval( &infix:<*> ), 91 | :up, 92 | :down, 93 | :inverse
, 94 | :invert-via, 95 | :identity(1), 96 | :commute, 97 | :associative, 98 | :normal 99 | }, 100 | :syntaxes( 101 | { 102 | :type, 103 | :precedence(2), 104 | :parts< * > 105 | }, 106 | { 107 | :language, 108 | :type, 109 | :parts< * > 110 | }, 111 | ), 112 | ), 113 | Op( 114 | :name
, 115 | :function{ 116 | :eval( &infix: ), 117 | :inverse, 118 | :invert-via, 119 | :identity(1) 120 | }, 121 | :syntaxes( 122 | { 123 | :type, 124 | :precedence(2), 125 | :parts< / > 126 | }, 127 | { 128 | :language, 129 | :type, 130 | :parts< / > 131 | }, 132 | ), 133 | ), 134 | Op( 135 | :name, 136 | :function{ 137 | :eval( &infix:<**> ), 138 | :down, 139 | :inverse, 140 | :invert-via, 141 | :identity(1), 142 | :normal 143 | }, 144 | :syntaxes( 145 | { 146 | :type, 147 | :precedence(1), 148 | :parts< ^ > 149 | }, 150 | { 151 | :language, 152 | :type, 153 | :parts< ** > 154 | }, 155 | ), 156 | ), 157 | Op( 158 | :name, 159 | :function{ 160 | :eval( * ** (1/*) ), 161 | :inverse, 162 | :invert-via, 163 | :identity(1) 164 | }, 165 | :syntaxes( 166 | { 167 | :type, 168 | :precedence(1), 169 | :reverse, 170 | :parts< √ > 171 | }, 172 | { 173 | :type, 174 | :precedence(1), 175 | :parts< ^/ > 176 | }, 177 | { 178 | :language, 179 | :type, 180 | :parts< **1/ > 181 | }, 182 | ) 183 | ), 184 | Op( 185 | :name, 186 | :function{ 187 | :eval( * ** .5 ), 188 | :inverse 189 | }, 190 | :syntaxes( 191 | { 192 | :type, 193 | :parts< √ > 194 | }, 195 | { 196 | :language, 197 | :type, 198 | :parts< **.5 > 199 | }, 200 | ), 201 | ), 202 | Op( 203 | :name, 204 | :function{ 205 | 206 | # TODO code in here receives null for the argument(s?) when precompiled 207 | # all evals in this file are broken when installed normally via panda :P 208 | # except those which point to external routines like &infix:<+> 209 | :eval( * ** 2 ), 210 | 211 | :inverse 212 | }, 213 | :syntaxes( 214 | { 215 | :type, 216 | :parts< ² > 217 | }, 218 | { 219 | :language, 220 | :type, 221 | :parts< **2 > 222 | }, 223 | ), 224 | ), 225 | Op( 226 | :name, 227 | :syntax{ 228 | :type, 229 | :parts< ! > 230 | } 231 | ), 232 | Op( 233 | :name, 234 | :function{ 235 | :eval( &abs ) 236 | }, 237 | :syntaxes( 238 | { 239 | :type, 240 | :parts< | | > 241 | }, 242 | { 243 | :language, 244 | :type, 245 | :parts< .abs > 246 | }, 247 | ), 248 | ), 249 | Op( 250 | :name, 251 | :function{ 252 | :eval( &prefix:<-> ), 253 | :inverse 254 | }, 255 | :syntaxes( 256 | { 257 | :type, 258 | :parts< - > 259 | }, 260 | { 261 | :language, 262 | :type, 263 | :parts< - > 264 | }, 265 | ), 266 | ), 267 | Op( 268 | :name, 269 | :function{ 270 | :eval( * ** -1 ), 271 | :inverse 272 | }, 273 | :syntaxes( 274 | { 275 | :type, 276 | :parts< ⁻¹ > 277 | }, 278 | { 279 | :language, 280 | :type, 281 | :parts< **-1 > 282 | }, 283 | ), 284 | ), 285 | Op( 286 | :name, 287 | :function{ 288 | :identity(0), 289 | :variants() 290 | }, 291 | :syntax{ 292 | :type, 293 | :precedence(3), 294 | :parts< ± > 295 | } 296 | ), 297 | Op( 298 | :syntax{ 299 | :type, 300 | :parts< ( ) > 301 | } 302 | ), 303 | Op( 304 | :name, 305 | :function{ 306 | :eval( &sin ), 307 | :inverse 308 | }, 309 | ), 310 | Op( 311 | :name, 312 | :function{ 313 | :eval( &asin ), 314 | :inverse 315 | }, 316 | ), 317 | Op( 318 | :name, 319 | :function{ 320 | :eval( &cos ), 321 | :inverse 322 | }, 323 | ), 324 | Op( 325 | :name, 326 | :function{ 327 | :eval( &acos ), 328 | :inverse 329 | }, 330 | ), 331 | Op( 332 | :name, 333 | :function{ 334 | :eval( &tan ), 335 | :inverse 336 | }, 337 | ), 338 | Op( 339 | :name, 340 | :function{ 341 | :eval( &atan ), 342 | :inverse 343 | }, 344 | ), 345 | ); 346 | 347 | our @.operations := @operations; 348 | 349 | my %by_name = @operations.grep({.name}).map: {.name => $_}; 350 | our %.by_name := %by_name; 351 | 352 | for @operations { 353 | my $func = $_.function; 354 | next unless $func; 355 | 356 | for -> $prop { 357 | for $func."$prop"() <-> $val { 358 | next unless $val && $val ~~ Str; 359 | my $op = %by_name{$val}; 360 | die "Cannot find '$val' operation" unless $op; 361 | $val = $op; 362 | } 363 | } 364 | 365 | for $func.variants.List.flat.kv -> $i, $var { 366 | my $op = %by_name{$var}; 367 | die "Cannot find '$var' operation" unless $op; 368 | $func.variants[$i] = $op; 369 | } 370 | 371 | if !(my $comm := $func.commute) && $func.invert-via && (my $inv = $func.inverse) { 372 | $comm = 'inverse' if $inv.function.commute === True; 373 | } 374 | 375 | next unless $func.arity == 1; 376 | my $name = $_.name; 377 | my @syn := $_.syntaxes; 378 | @syn.push( Math::Symbolic::Syntax.new: 379 | :$name, 380 | :arity(1), 381 | :type, 382 | :parts( "$name\(", ')' ) 383 | ); 384 | } 385 | 386 | #my %by_syntax = build_by_syntax(); 387 | our %.by_syntax = build_by_syntax(); 388 | our %.syntax_by_syntax = build_by_syntax(:syntax); 389 | 390 | sub build_by_syntax (Bool :$syntax = False) { 391 | my %by_syntax; 392 | 393 | for @operations { 394 | my @syn = $_.syntaxes; 395 | for @syn.keys -> $syn_i { 396 | my $syn = @syn[$syn_i]; 397 | next unless $syn && (my $type = $syn.type); 398 | next if defined $syn.language; 399 | my %syn_type := (%by_syntax{$type} //= Hash.new); 400 | my $key = $syn.key; 401 | my $entry := %syn_type{$key}; 402 | die "Error: Syntax conflict for $type $key between {$entry.name} and {$_.name}" if $entry; 403 | $entry = $syntax ?? $syn !! $_; 404 | } 405 | } 406 | 407 | return %by_syntax; 408 | } 409 | 410 | -------------------------------------------------------------------------------- /lib/Math/Symbolic/MultiHash.rakumod: -------------------------------------------------------------------------------- 1 | unit class Math::Symbolic::MultiHash is rw; 2 | 3 | # this is a hash keyed by hash with eqv semantics and extra lookup methods 4 | # it is used internally in math::symbolic for polynomials 5 | # doesn't actually support the Associative interface (yet) 6 | # after a bit of cleanup, it ought to go in its own repo 7 | 8 | has %.hash{Any} handles ; 9 | 10 | method elem (*@pairs, *%keyhash is copy) is rw { 11 | %keyhash{.key} = .value for @pairs; 12 | 13 | my $found_key; 14 | my %key; 15 | 16 | if %!hash { # TODO reduce & report 17 | for %!hash.keys { 18 | if %$_ eqv %keyhash { 19 | %key := $_; 20 | $found_key = True; 21 | last; 22 | } 23 | } 24 | } 25 | 26 | %key := %keyhash unless $found_key; 27 | 28 | %!hash{ $%key }; 29 | } 30 | 31 | method matching (*%keyhash) { 32 | my @hits; 33 | 34 | for %!hash.kv -> $k, $v { 35 | my $hit = True; 36 | 37 | for %keyhash.kv -> $kt, $vt { # t is for test 38 | next if $k{$kt}:exists && $k{$kt} eqv $vt; 39 | 40 | $hit = False; 41 | last; 42 | } 43 | 44 | push @hits, $v if $hit; 45 | } 46 | 47 | return |@hits; 48 | } 49 | 50 | -------------------------------------------------------------------------------- /lib/Math/Symbolic/Operation.rakumod: -------------------------------------------------------------------------------- 1 | class Math::Symbolic::Operation { ... }; 2 | 3 | class Math::Symbolic::Function { 4 | has $.name; 5 | has $.arity; 6 | has &.eval; 7 | 8 | # rw so it can be specified as a string but vivified to an object later 9 | has $.inverse is rw; 10 | has $.invert-via is rw; 11 | 12 | # rw so it can be pointed at its inverse if appropriate 13 | has $.commute is rw; 14 | 15 | has $.identity; 16 | has $.associative; 17 | 18 | has $.normal; 19 | 20 | has $.up is rw; 21 | has $.down is rw; 22 | 23 | has @.variants is rw; 24 | 25 | method Str () { $.name } 26 | 27 | multi method raku(::CLASS:D:) { 28 | my @attrs; 29 | for self.^attributes().grep: { .has_accessor } -> $attr { 30 | my $name := $attr.Str.substr(2); 31 | 32 | my $value = self."$name"(); 33 | if $value ~~ Math::Symbolic::Operation && $value.defined && (my $op_name := $value.name) { 34 | $value = "Math::Symbolic::Language.by_name\{{$op_name.raku}}"; 35 | } else { 36 | $value = $value.raku; 37 | } 38 | 39 | @attrs.push: "$name => $value"; 40 | } 41 | self.HOW.name(self) ~ '.new(' ~ @attrs.join(', ') ~ ')'; 42 | } 43 | } 44 | 45 | class Math::Symbolic::Syntax { 46 | has $.name; 47 | has $.arity; 48 | has $.type; # prefix, postfix, infix, circumfix 49 | has $.precedence; 50 | has Bool $.reverse = False; 51 | has @.parts; 52 | has $.key = @!parts.join: ''; 53 | has $.language; 54 | 55 | method make_str (@args) { 56 | my $str; 57 | 58 | given $.type { 59 | when 'infix' { 60 | $str = [@args]; 61 | $str .= reverse if $.reverse; 62 | $str .= join: @.parts[0]; 63 | } 64 | when 'prefix' { 65 | $str = @.parts[0] ~ @args[0]; 66 | } 67 | when 'postfix' { 68 | $str = @args[0] ~ @.parts[0]; 69 | } 70 | when 'circumfix' { 71 | $str = @.parts.join: @args[0]; 72 | } 73 | default { 74 | die "Error: cannot generate a string for syntax of type '$.type'"; 75 | } 76 | } 77 | 78 | return $str; 79 | } 80 | } 81 | 82 | class Math::Symbolic::Operation { 83 | has $.name; 84 | has Int $.arity; 85 | has Math::Symbolic::Function $.function; 86 | has Math::Symbolic::Syntax @.syntaxes; 87 | 88 | method Str () { $.name } 89 | 90 | method syntax (Int $i? is copy, :$language --> Math::Symbolic::Syntax) is rw { 91 | my $use-lang = defined $language; 92 | 93 | unless defined $i { 94 | my &check = $use-lang ?? 95 | { defined $_.value.language && $_.value.language eq $language } !! 96 | { !defined $_.value.language }; 97 | $i = @!syntaxes.pairs.first(&check).key; 98 | } 99 | 100 | die "Error: could not find {$use-lang ?? "$language " !! ''}syntax for $!name" 101 | unless defined $i; 102 | 103 | @!syntaxes[$i] // die "Error: could not find { 104 | $use-lang ?? "$language " !! ''}syntax for $!name"; 105 | } 106 | 107 | submethod BUILD (:%function, :%syntax, :@syntaxes, :$!name, :$arity is copy) { 108 | unless defined $arity { 109 | my $syn = @syntaxes[0] // %syntax; 110 | if $syn && $syn eq 'infix' { 111 | $arity = 2; 112 | } else { 113 | $arity = 1; 114 | } 115 | } 116 | 117 | $!arity = $arity; 118 | 119 | $!function = Math::Symbolic::Function.new( 120 | |%(%function // ()), 121 | :$!name, 122 | :$!arity 123 | ) if $!name || %function; 124 | 125 | if @syntaxes { 126 | for @syntaxes { 127 | my @parts = slip($_:delete); 128 | @!syntaxes.push: Math::Symbolic::Syntax.new(|%$_, :@parts, :$!name, :$!arity); 129 | } 130 | } elsif %syntax { 131 | my @parts = slip(%syntax:delete); 132 | @!syntaxes[0] = Math::Symbolic::Syntax.new(|%syntax, :@parts, :$!name, :$!arity); 133 | } 134 | } 135 | } 136 | 137 | 138 | 139 | -------------------------------------------------------------------------------- /lib/Math/Symbolic/Tree.rakumod: -------------------------------------------------------------------------------- 1 | unit class Math::Symbolic::Tree is rw; 2 | 3 | has $.type; 4 | has $.content; 5 | has @.children; 6 | 7 | submethod BUILD (:$!type, :$!content, :@children) { 8 | for @children.kv -> $i, $v { 9 | @!children[$i] = $v; 10 | } 11 | } 12 | 13 | method match (*%s) { 14 | CATCH {die "Error in match '%s.raku()':\n$_.Str.indent(4)"}; 15 | 16 | for .grep({%s{$_}:exists}) { 17 | my $criteria = %s{$_}; 18 | my $value = self."$_"(); 19 | return False unless $value ~~ $criteria; 20 | } 21 | 22 | if %s :exists { 23 | my @child_criteria = %s; 24 | for ^@child_criteria -> $child_i { 25 | my $child_criteria = @child_criteria[$child_i]; 26 | #next unless $child ~~ Positional && $child.keys; 27 | next if $child_criteria ~~ Whatever; 28 | my %child_params = %$child_criteria; 29 | next unless %child_params; 30 | my $child = self.children[$child_i]; 31 | return False unless $child && $child.match( |%child_params ); 32 | } 33 | } 34 | 35 | return True; 36 | } 37 | 38 | method find (*%s) { 39 | return self if self.match(|%s); 40 | 41 | for @.children { 42 | my $result = $_.find(|%s); 43 | return $result if $result; 44 | } 45 | 46 | return; 47 | } 48 | 49 | method find_all (Bool :$path = False, *%s) { 50 | my @results; 51 | @results.push: $path ?? [] !! self if self.match(|%s); 52 | 53 | for @.children.kv -> $i, $child { 54 | next unless my @child_results = $child.find_all(:$path, |%s); 55 | @child_results».unshift: $i if $path; 56 | @results.append: @child_results; 57 | } 58 | 59 | return @results; 60 | } 61 | 62 | method chain (Bool :$ops = False) { 63 | my $type = self.type; 64 | 65 | die "Error: can only call .chain() on operations; this is a{ 66 | ($type ~~ /^<[aeiou]>/ ?? 'n ' !! ' ') ~ $type 67 | }" unless $type eq 'operation'; 68 | 69 | my @chain; 70 | @chain.push: self if $ops; 71 | for @.children { 72 | if $_.type eq $.type && $_.content eq $.content { 73 | @chain.append: $_.chain(:$ops); 74 | } else { 75 | @chain.push: $_ unless $ops; 76 | } 77 | } 78 | 79 | @chain; 80 | } 81 | 82 | method count () { 83 | [+] @.children».count, 1 84 | } 85 | 86 | method list () { 87 | my @return; 88 | 89 | if $.type eq 'operation' && 90 | (my $func = $.content.function) && 91 | (my @vars = $func.variants) { 92 | for @vars.List.flat { 93 | my $var = self.clone; 94 | $var.content = $_; 95 | push @return, $var; 96 | } 97 | } else { 98 | @return = self; 99 | } 100 | 101 | for @.children.kv -> $i, $v { 102 | my @vars = $v.list; 103 | if @vars > 1 { 104 | my @orig_vars = @return; 105 | @return = (); 106 | for @vars -> $var { 107 | @return.append: @orig_vars.map({my $o = $_.clone; $o.child($i) = $var; $o}); 108 | } 109 | } 110 | } 111 | 112 | @return; 113 | } 114 | 115 | proto method child(|) {*} 116 | 117 | multi method child($i) is rw { 118 | @.children[$i]; 119 | } 120 | 121 | multi method child ($i, *@i) is rw { 122 | @.children[$i].child(|@i); 123 | } 124 | 125 | proto method set (|) {*} 126 | 127 | multi method set (Math::Symbolic::Tree $node, Bool :$type, Bool :$content, Bool :$children) { 128 | $.type = $node.type unless $type === False; 129 | $.content = $node.content unless $content === False; 130 | @.children = $node.children unless $children === False; 131 | 132 | self; 133 | } 134 | 135 | multi method set (*%props) { 136 | self."$_"() = %props{$_} for %props.keys; 137 | 138 | self; 139 | } 140 | 141 | method get () { 142 | %( :$.type, :$.content, :@.children ); 143 | } 144 | 145 | method swap (Math::Symbolic::Tree $node) { 146 | my %tmp = self.clone.get; 147 | 148 | self.set: $node; 149 | $node.set: |%tmp; 150 | 151 | self; 152 | } 153 | 154 | method Str () { 155 | return '' unless defined self; 156 | 157 | given $.type { 158 | when 'operation' { 159 | my $op = $.content; 160 | my $assoc = $op.function.associative; 161 | my $syn = $op.syntax // die "Error: No syntax to stringify for '{$op.name}' operations"; 162 | my @args = @.children».Str; 163 | my $prec = $syn.precedence; 164 | for ^@args -> $child_i { 165 | my $child = @.children[$child_i]; 166 | if $child.type eq 'operation' { 167 | my $this_op = $child.content; 168 | my $this_syn = $this_op.syntax; 169 | my $this_prec = $this_syn.precedence; 170 | if 171 | defined($prec) && 172 | defined($this_prec) && ( 173 | $this_prec > $prec 174 | or 175 | $child_i > 0 && 176 | ($this_prec == $prec) && 177 | (!$assoc or $this_op !=== $op) 178 | ) 179 | or 180 | $syn.type eq none('infix', 'circumfix', $this_syn.type) && 181 | not $syn.type eq 'prefix' && $this_syn.type eq 'postfix' 182 | { 183 | # () here is a hard-coded hack and should be looked up as the first defined non-function circumfix 184 | @args[$child_i] = '(' ~ @args[$child_i] ~ ')'; 185 | } 186 | } 187 | } 188 | return $syn.make_str(@args); 189 | } 190 | when 'relation' { 191 | return @.children».Str.join: $.content.Str; 192 | } 193 | when 'symbol' | 'value' { 194 | return $.content.Str; 195 | } 196 | default { 197 | die "Error: Can't stringify nodes of type '$.type'"; 198 | } 199 | } 200 | } 201 | 202 | method translate (Str:D $language is copy) { 203 | $language = 'raku' if $language eq ''; 204 | die "Error: translate to $language is not supported" 205 | unless $language eq 'raku'; 206 | 207 | return '' unless defined self; 208 | 209 | # it is hoped to extend this for pluggable language support, but for now is hard-coded for raku only, in spite of also requiring the $language parameter 210 | my $str = ''; 211 | given $.type { 212 | when 'operation' { 213 | my $op = $.content; 214 | my $syn = $op.syntax(:$language); 215 | my @args = @.children».translate: $language; 216 | $str = $syn.make_str(@args); 217 | } 218 | when 'relation' { 219 | $str = @.children».translate($language).join: $.content.Str; 220 | } 221 | when 'symbol' { 222 | $str = '$' ~ $.content.Str; 223 | } 224 | when 'value' { 225 | $str = $.content.Str; 226 | } 227 | default { 228 | die "Error: Can't stringify nodes of type '$.type'"; 229 | } 230 | } 231 | 232 | "($str)"; 233 | } 234 | 235 | method Numeric () { 236 | given self.type { 237 | when 'operation' { 238 | my $op = self.content; 239 | my $func = $op.function or 240 | die "Error: cannot numify; no function for operation $op"; 241 | my &eval = $op.function.eval or 242 | die "Error: cannot numify; no eval routine for operation $op"; 243 | eval(|@(self.children».Numeric)) 244 | }; 245 | when 'value' { +self.content }; 246 | default { die "Error: cannot numify nodes of type '$_'" }; 247 | } 248 | } 249 | 250 | method clone () { 251 | self.new( :$.type, :$.content, :children(@.children».clone) ); 252 | } 253 | 254 | method new-chain ($op, *@children is copy, *%args is copy) { 255 | die "Error: cannot create a chain with no children" unless @children; 256 | 257 | return @children[0] unless @children > 1; 258 | 259 | %args = 'operation'; 260 | %args = $op; 261 | 262 | my $chain = self.new: |%args, :children(@children.shift, @children.shift); 263 | $chain = self.new: |%args, :children($chain, @children.shift) while @children; 264 | 265 | $chain; 266 | } 267 | 268 | method new-val ($val, *%args is copy) { 269 | %args = 'value'; 270 | %args = $val; 271 | 272 | self.new: |%args; 273 | } 274 | 275 | method new-sym ($sym, *%args is copy) { 276 | %args = 'symbol'; 277 | %args = $sym; 278 | 279 | self.new: |%args; 280 | } 281 | 282 | method new-op ($op, *@children, *%args is copy) { 283 | %args = 'operation'; 284 | %args = $op; 285 | %args.append: @children if @children; 286 | 287 | self.new: |%args; 288 | } 289 | 290 | 291 | -------------------------------------------------------------------------------- /symbolic: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" 4 | 5 | time raku -I$DIR/lib $DIR/bin/symbolic "$@" 6 | 7 | -------------------------------------------------------------------------------- /t/01-basics.t: -------------------------------------------------------------------------------- 1 | use v6; 2 | 3 | use Test; 4 | plan 11; 5 | 6 | use Math::Symbolic; 7 | 8 | isa-ok Math::Symbolic.new('0'), Math::Symbolic, ".new() works"; 9 | 10 | is Math::Symbolic.new('x+y=1').isolate('x').Str, 'x=1-y', '.isolate() works'; 11 | 12 | is Math::Symbolic.new('x+y').evaluate(y => 2).Str, 'x+2', '.evaluate() works'; 13 | 14 | is Math::Symbolic.new('a^3+b*2').expand.Str, 'a*a*a+b+b', '.expand() works'; 15 | 16 | is Math::Symbolic.new('x*x*x*x').condense.Str, 'x^4', '.condense() works'; 17 | 18 | is Math::Symbolic.new('m=(y2-y1)/(x2-x1)').expression('y2').Str, 'm*(x2-x1)+y1', '.expression() works'; 19 | 20 | is 21 | Math::Symbolic.new('y=m*x+b').isolate('x').evaluate(:m(1), :b(0)).Str, 22 | 'x=y', 23 | 'README slope-intercept example works'; 24 | 25 | is Math::Symbolic.new("a+-b").simplify.Str, 'a-b', '.simplify documentation is correct'; 26 | 27 | is Math::Symbolic.new("x²").routine(< x >).EVAL.(4), 16, '.routine().EVAL works'; 28 | 29 | is 30 | Math::Symbolic.new('a²+b²=c²').expression('c')\ 31 | .evaluate(:a, :b).compile().( -1,-1, 2,3 ), 32 | 5, 33 | 'can convert Pythagorean theorem into Raku distance subroutine'; 34 | 35 | is 36 | Math::Symbolic.new('t²=x²').evaluate(:x)\ 37 | .evaluate(:V(2), :P(-3)).expression('t').list».Numeric.sort, 38 | "1 3", 39 | 'quadratic solution to the leading problem in 1D seems correct'; 40 | 41 | --------------------------------------------------------------------------------