| blib/lib/Arithmetic/PaperAndPencil.pm | |||
|---|---|---|---|
| Criterion | Covered | Total | % |
| statement | 44 | 44 | 100.0 |
| branch | n/a | ||
| condition | n/a | ||
| subroutine | 15 | 15 | 100.0 |
| pod | n/a | ||
| total | 59 | 59 | 100.0 |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | # -*- encoding: utf-8; indent-tabs-mode: nil -*- | ||||||
| 2 | |||||||
| 3 | 3 | 3 | 416893 | use 5.38.0; | |||
| 3 | 18 | ||||||
| 4 | 3 | 3 | 647 | use utf8; | |||
| 3 | 367 | ||||||
| 3 | 23 | ||||||
| 5 | 3 | 3 | 95 | use strict; | |||
| 3 | 6 | ||||||
| 3 | 62 | ||||||
| 6 | 3 | 3 | 14 | use warnings; | |||
| 3 | 7 | ||||||
| 3 | 245 | ||||||
| 7 | 3 | 3 | 2095 | use open ':encoding(UTF-8)'; | |||
| 3 | 4857 | ||||||
| 3 | 91 | ||||||
| 8 | 3 | 3 | 74466 | use feature qw/class/; | |||
| 3 | 6 | ||||||
| 3 | 6941 | ||||||
| 9 | 3 | 3 | 1792 | use experimental qw/class/; | |||
| 3 | 14045 | ||||||
| 3 | 24 | ||||||
| 10 | 3 | 3 | 2234 | use Arithmetic::PaperAndPencil::Action; | |||
| 3 | 10 | ||||||
| 3 | 132 | ||||||
| 11 | 3 | 3 | 1656 | use Arithmetic::PaperAndPencil::Char; | |||
| 3 | 10 | ||||||
| 3 | 124 | ||||||
| 12 | 3 | 3 | 1769 | use Arithmetic::PaperAndPencil::Label; | |||
| 3 | 10 | ||||||
| 3 | 298 | ||||||
| 13 | |||||||
| 14 | class Arithmetic::PaperAndPencil 0.01; | ||||||
| 15 | |||||||
| 16 | 3 | 3 | 1870 | use Arithmetic::PaperAndPencil::Number qw/max_unit adjust_sub/; | |||
| 3 | 10 | ||||||
| 3 | 228 | ||||||
| 17 | |||||||
| 18 | 3 | 3 | 20 | use Carp; | |||
| 3 | 6 | ||||||
| 3 | 203 | ||||||
| 19 | 3 | 3 | 37 | use Exporter 'import'; | |||
| 3 | 7 | ||||||
| 3 | 101 | ||||||
| 20 | 3 | 3 | 15 | use POSIX qw/floor ceil/; | |||
| 3 | 7 | ||||||
| 3 | 75 | ||||||
| 21 | 3 | 3 | 265 | use List::Util qw/min max/; | |||
| 3 | 7 | ||||||
| 3 | 109916 | ||||||
| 22 | |||||||
| 23 | our $VERSION = 0.01; | ||||||
| 24 | |||||||
| 25 | field @action; | ||||||
| 26 | |||||||
| 27 | method from_csv { | ||||||
| 28 | my ($csv) = @_; | ||||||
| 29 | @action = (); | ||||||
| 30 | for my $line (split("\n", $csv)) { | ||||||
| 31 | my $action = Arithmetic::PaperAndPencil::Action->new(level => 0, label => 'dummy'); | ||||||
| 32 | $action->from_csv($line); | ||||||
| 33 | push @action, $action; | ||||||
| 34 | } | ||||||
| 35 | } | ||||||
| 36 | |||||||
| 37 | method csv { | ||||||
| 38 | my $result = join "\n", map { $_->csv } @action; | ||||||
| 39 | if (substr($result, -1, 1) ne "\n") { | ||||||
| 40 | $result .= "\n"; | ||||||
| 41 | } | ||||||
| 42 | return $result; | ||||||
| 43 | } | ||||||
| 44 | |||||||
| 45 | method html(%param) { | ||||||
| 46 | my $lang = $param{lang} // 'fr'; | ||||||
| 47 | my $silent = $param{silent} // 0; | ||||||
| 48 | my $level = $param{level} // 3; | ||||||
| 49 | my $css = $param{css}; | ||||||
| 50 | my $talkative = 1 - $silent; # "silent" better for API, "talkative" better for programming | ||||||
| 51 | my $result = ''; | ||||||
| 52 | my @sheet = (); | ||||||
| 53 | my %vertical_lines = (); | ||||||
| 54 | my %cache_l2p_col = (); | ||||||
| 55 | my $c_min = 0; | ||||||
| 56 | my $l_min = 0; | ||||||
| 57 | |||||||
| 58 | # checking the minimum line number | ||||||
| 59 | my sub check_l_min($l) { | ||||||
| 60 | if ($l < $l_min) { | ||||||
| 61 | # inserting new empty lines before the existing ones | ||||||
| 62 | for ($l .. $l_min - 1) { | ||||||
| 63 | unshift @sheet, []; | ||||||
| 64 | } | ||||||
| 65 | # updating the line minimum number | ||||||
| 66 | $l_min = $l; | ||||||
| 67 | } | ||||||
| 68 | } | ||||||
| 69 | # logical to physical line number | ||||||
| 70 | my sub l2p_lin($logl) { | ||||||
| 71 | my $result = $logl - $l_min; | ||||||
| 72 | return $result; | ||||||
| 73 | } | ||||||
| 74 | |||||||
| 75 | # checking the minimum column number | ||||||
| 76 | my sub check_c_min($c) { | ||||||
| 77 | if ($c < $c_min) { | ||||||
| 78 | my $delta_c = $c_min - $c; | ||||||
| 79 | for my $line (@sheet) { | ||||||
| 80 | for (1 .. $delta_c) { | ||||||
| 81 | unshift @$line, Arithmetic::PaperAndPencil::Char->space_char; | ||||||
| 82 | } | ||||||
| 83 | } | ||||||
| 84 | $c_min = $c; | ||||||
| 85 | %cache_l2p_col = (); | ||||||
| 86 | } | ||||||
| 87 | } | ||||||
| 88 | # logical to physical column number | ||||||
| 89 | my sub l2p_col($logc) { | ||||||
| 90 | if ($cache_l2p_col{$logc}) { | ||||||
| 91 | return $cache_l2p_col{$logc}; | ||||||
| 92 | } | ||||||
| 93 | my $result = $logc - $c_min; | ||||||
| 94 | for my $col (keys %vertical_lines) { | ||||||
| 95 | if ($logc > $col) { | ||||||
| 96 | ++$result; | ||||||
| 97 | } | ||||||
| 98 | } | ||||||
| 99 | $cache_l2p_col{$logc} = $result; | ||||||
| 100 | return $result; | ||||||
| 101 | } | ||||||
| 102 | |||||||
| 103 | my sub filling_spaces($l, $c) { | ||||||
| 104 | # putting spaces into all uninitialised boxes | ||||||
| 105 | for my $l1 (0 .. l2p_lin($l)) { | ||||||
| 106 | $sheet[$l1][0] //= Arithmetic::PaperAndPencil::Char->space_char; | ||||||
| 107 | } | ||||||
| 108 | for my $c1 (0 .. l2p_col($c)) { | ||||||
| 109 | $sheet[l2p_lin($l)][$c1] //= Arithmetic::PaperAndPencil::Char->space_char; | ||||||
| 110 | } | ||||||
| 111 | } | ||||||
| 112 | |||||||
| 113 | for my $action (@action) { | ||||||
| 114 | if ($action->label =~ /^TIT/ or $action->label eq 'NXP01') { | ||||||
| 115 | @sheet = (); | ||||||
| 116 | %vertical_lines = (); | ||||||
| 117 | %cache_l2p_col = (); | ||||||
| 118 | $c_min = 0; | ||||||
| 119 | $l_min = 0; | ||||||
| 120 | } | ||||||
| 121 | |||||||
| 122 | # Drawing a vertical line | ||||||
| 123 | if ($action->label eq 'DRA01') { | ||||||
| 124 | if ($action->w1c != $action->w2c) { | ||||||
| 125 | die "The line is not vertical, starting at column ", $action->w1c, " and ending at column ", $action->w2c; | ||||||
| 126 | } | ||||||
| 127 | # checking the line and column minimum numbers | ||||||
| 128 | check_l_min($action->w1l); | ||||||
| 129 | check_l_min($action->w2l); | ||||||
| 130 | check_c_min($action->w1c); | ||||||
| 131 | # making some clear space for the vertical line | ||||||
| 132 | unless ($vertical_lines{$action->w1c}) { | ||||||
| 133 | $vertical_lines{$action->w1c} = 1; | ||||||
| 134 | # clearing the cache | ||||||
| 135 | %cache_l2p_col = (); | ||||||
| 136 | |||||||
| 137 | # shifting characters past the new vertical line's column | ||||||
| 138 | for my $l (0 .. $#sheet) { | ||||||
| 139 | for my $c (0 .. l2p_col($action->w1c)) { | ||||||
| 140 | $sheet[$l][$c] //= Arithmetic::PaperAndPencil::Char->space_char; | ||||||
| 141 | } | ||||||
| 142 | my $line = $sheet[$l]; | ||||||
| 143 | splice(@$line, l2p_col($action->w1c) + 1, 0, Arithmetic::PaperAndPencil::Char->space_char); | ||||||
| 144 | $sheet[$l] = $line; | ||||||
| 145 | } | ||||||
| 146 | } | ||||||
| 147 | # making the vertical line | ||||||
| 148 | for my $l ($action->w1l .. $action->w2l) { | ||||||
| 149 | filling_spaces($l, $action->w1c); | ||||||
| 150 | $sheet[l2p_lin($l)][l2p_col($action->w1c) + 1] = Arithmetic::PaperAndPencil::Char->pipe_char; | ||||||
| 151 | } | ||||||
| 152 | } | ||||||
| 153 | |||||||
| 154 | # drawing an horizontal line or drawing a hook over a dividend | ||||||
| 155 | my sub draw_h($at, $from, $to) { | ||||||
| 156 | # checking the line and column minimum numbers | ||||||
| 157 | check_l_min($at); | ||||||
| 158 | check_c_min($from); | ||||||
| 159 | check_c_min($to); | ||||||
| 160 | # begin and end | ||||||
| 161 | my ($c_beg, $c_end); | ||||||
| 162 | if ($from > $to) { | ||||||
| 163 | $c_beg = l2p_col($to); | ||||||
| 164 | $c_end = l2p_col($from); | ||||||
| 165 | filling_spaces($at, $from); | ||||||
| 166 | } | ||||||
| 167 | else { | ||||||
| 168 | $c_beg = l2p_col($from); | ||||||
| 169 | $c_end = l2p_col($to); | ||||||
| 170 | filling_spaces($at, $to); | ||||||
| 171 | } | ||||||
| 172 | for my $i ($c_beg .. $c_end) { | ||||||
| 173 | $sheet[l2p_lin($at)][$i]->set_underline(1); | ||||||
| 174 | } | ||||||
| 175 | } | ||||||
| 176 | |||||||
| 177 | # Drawing an horizontal line | ||||||
| 178 | if ($action->label eq 'DRA02') { | ||||||
| 179 | if ($action->w1l != $action->w2l) { | ||||||
| 180 | die "The line is not horizontal, starting at line {$action->w1l} and ending at line {$action->w2l}"; | ||||||
| 181 | } | ||||||
| 182 | draw_h($action->w1l, $action->w1c, $action->w2c); | ||||||
| 183 | } | ||||||
| 184 | |||||||
| 185 | # Drawing a hook over a dividend (that is, an horizontal line above) | ||||||
| 186 | if ($action->label eq 'HOO01') { | ||||||
| 187 | if ($action->w1l != $action->w2l) { | ||||||
| 188 | die "The hook is not horizontal, starting at line {$action->w1l} and ending at line {$action->w2l}"; | ||||||
| 189 | } | ||||||
| 190 | draw_h($action->w1l - 1, $action->w1c, $action->w2c); | ||||||
| 191 | } | ||||||
| 192 | |||||||
| 193 | # Drawing an oblique line | ||||||
| 194 | if ($action->label eq 'DRA03') { | ||||||
| 195 | if ($action->w2c - $action->w1c != $action->w2l - $action->w1l) { | ||||||
| 196 | die "The line is not oblique"; | ||||||
| 197 | } | ||||||
| 198 | # checking the line and column minimum numbers | ||||||
| 199 | check_l_min($action->w1l); | ||||||
| 200 | check_l_min($action->w2l); | ||||||
| 201 | check_c_min($action->w1c); | ||||||
| 202 | check_c_min($action->w2c); | ||||||
| 203 | # begin and end | ||||||
| 204 | my ($l_beg, $c_beg); | ||||||
| 205 | if ($action->w2l > $action->w1l) { | ||||||
| 206 | # line is defined top-left to bot-right | ||||||
| 207 | $l_beg = $action->w1l; | ||||||
| 208 | $c_beg = $action->w1c; | ||||||
| 209 | } | ||||||
| 210 | else { | ||||||
| 211 | # line was defined bot-right to top-left | ||||||
| 212 | $l_beg = $action->w2l; | ||||||
| 213 | $c_beg = $action->w2c; | ||||||
| 214 | } | ||||||
| 215 | # drawing the line top-left to bot-right | ||||||
| 216 | for my $i (0 .. abs($action->w2l - $action->w1l)) { | ||||||
| 217 | filling_spaces($l_beg + $i, $c_beg + $i); | ||||||
| 218 | my $l1 = l2p_lin($l_beg + $i); | ||||||
| 219 | my $c1 = l2p_col($c_beg + $i); | ||||||
| 220 | $sheet[$l1][$c1]->set_char('\\'); | ||||||
| 221 | # the line | ||||||
| 222 | # $sheet[$l1; $c1] = backslash_char->char; | ||||||
| 223 | # would be wrong, because in some cases it would clobber the "underline" attribute of an already existing char | ||||||
| 224 | } | ||||||
| 225 | } | ||||||
| 226 | if ($action->label eq 'DRA04') { | ||||||
| 227 | if ($action->w2c - $action->w1c != $action->w1l - $action->w2l) { | ||||||
| 228 | die "The line is not oblique"; | ||||||
| 229 | } | ||||||
| 230 | # checking the line and column minimum numbers | ||||||
| 231 | check_l_min($action->w1l); | ||||||
| 232 | check_l_min($action->w2l); | ||||||
| 233 | check_c_min($action->w1c); | ||||||
| 234 | check_c_min($action->w2c); | ||||||
| 235 | # begin and end | ||||||
| 236 | my ($l_beg, $c_beg); | ||||||
| 237 | if ($action->w2l > $action->w1l) { | ||||||
| 238 | # line is defined top-right to bot-left | ||||||
| 239 | $l_beg = $action->w1l; | ||||||
| 240 | $c_beg = $action->w1c; | ||||||
| 241 | } | ||||||
| 242 | else { | ||||||
| 243 | # line was defined bot-left to top-right | ||||||
| 244 | $l_beg = $action->w2l; | ||||||
| 245 | $c_beg = $action->w2c; | ||||||
| 246 | } | ||||||
| 247 | # drawing the line top-right to bot-left | ||||||
| 248 | for my $i (0 .. abs($action->w2l - $action->w1l)) { | ||||||
| 249 | filling_spaces($l_beg + $i, $c_beg - $i); | ||||||
| 250 | my $l1 = l2p_lin($l_beg + $i); | ||||||
| 251 | my $c1 = l2p_col($c_beg - $i); | ||||||
| 252 | $sheet[$l1][$c1]->set_char('/'); | ||||||
| 253 | # the line | ||||||
| 254 | # $sheet[$l1; $c1] = slash_char(); | ||||||
| 255 | # would be wrong, because in some cases it would clobber the "underline" attribute of an already existing char | ||||||
| 256 | } | ||||||
| 257 | } | ||||||
| 258 | |||||||
| 259 | # Reading some digits (or other characters) and possibly striking them | ||||||
| 260 | if ($action->r1val ne '') { | ||||||
| 261 | |||||||
| 262 | # checking the line and column minimum numbers | ||||||
| 263 | # (should not be necessary: if the digits are being read, they must have been previously written) | ||||||
| 264 | check_l_min($action->r1l); | ||||||
| 265 | check_c_min($action->r1c - length($action->r1val) + 1); | ||||||
| 266 | |||||||
| 267 | # putting spaces into all uninitialised boxes | ||||||
| 268 | # (should not be necessary, for the same reason) | ||||||
| 269 | filling_spaces($action->r1l, $action->r1c); | ||||||
| 270 | |||||||
| 271 | # tagging each char | ||||||
| 272 | for my $i (0 .. length($action->r1val) - 1) { | ||||||
| 273 | my $str = substr($action->r1val, $i, 1); | ||||||
| 274 | for ($sheet[l2p_lin($action->r1l)][l2p_col($action->r1c - length($action->r1val) + $i + 1)]) { | ||||||
| 275 | $_->set_read(1); | ||||||
| 276 | if ($action->r1str) { | ||||||
| 277 | $_->set_strike(1); | ||||||
| 278 | } | ||||||
| 279 | } | ||||||
| 280 | } | ||||||
| 281 | } | ||||||
| 282 | if ($action->r2val ne '') { | ||||||
| 283 | |||||||
| 284 | # checking the line and column minimum numbers | ||||||
| 285 | # (should not be necessary, for the same reason as r1val) | ||||||
| 286 | check_l_min($action->r2l); | ||||||
| 287 | |||||||
| 288 | # putting spaces into all uninitialised boxes | ||||||
| 289 | # (should not be necessary, for the same reason) | ||||||
| 290 | filling_spaces($action->r2l, $action->r2c); | ||||||
| 291 | |||||||
| 292 | # tagging each char | ||||||
| 293 | for my $i (0 .. length($action->r2val) - 1) { | ||||||
| 294 | my $str = substr($action->r2val, $i, 1); | ||||||
| 295 | for ($sheet[l2p_lin($action->r2l)][l2p_col($action->r2c - length($action->r2val) + $i + 1)]) { | ||||||
| 296 | $_->set_read(1); | ||||||
| 297 | if ($action->r2str) { | ||||||
| 298 | $_->set_strike(1); | ||||||
| 299 | } | ||||||
| 300 | } | ||||||
| 301 | } | ||||||
| 302 | } | ||||||
| 303 | |||||||
| 304 | # Writing some digits (or other characters) | ||||||
| 305 | if ($action->w1val ne '') { | ||||||
| 306 | # checking the line and column minimum numbers | ||||||
| 307 | check_l_min($action->w1l); | ||||||
| 308 | check_c_min($action->w1c - length($action->w1val) + 1); | ||||||
| 309 | # putting spaces into all uninitialised boxes | ||||||
| 310 | filling_spaces($action->w1l, $action->w1c); | ||||||
| 311 | # putting each char separately into its designated box | ||||||
| 312 | for my $i (0 .. length($action->w1val) - 1) { | ||||||
| 313 | my $str = substr($action->w1val, $i, 1); | ||||||
| 314 | for ($sheet[l2p_lin($action->w1l)][l2p_col($action->w1c - length($action->w1val) + $i + 1)]) { | ||||||
| 315 | $_->set_char($str); | ||||||
| 316 | $_->set_write(1); | ||||||
| 317 | } | ||||||
| 318 | } | ||||||
| 319 | } | ||||||
| 320 | if ($action->w2val ne '') { | ||||||
| 321 | # checking the line and column minimum numbers | ||||||
| 322 | check_l_min($action->w2l); | ||||||
| 323 | check_c_min($action->w2c - length($action->w2val) + 1); | ||||||
| 324 | # putting spaces into all uninitialised boxes | ||||||
| 325 | filling_spaces($action->w2l, $action->w2c); | ||||||
| 326 | # putting each char separately into its designated box | ||||||
| 327 | for my $i (0 .. length($action->w2val) - 1) { | ||||||
| 328 | my $str = substr($action->w2val, $i, 1); | ||||||
| 329 | for ($sheet[l2p_lin($action->w2l)][l2p_col($action->w2c - length($action->w2val) + $i + 1)]) { | ||||||
| 330 | $_->set_char($str); | ||||||
| 331 | $_->set_write(1); | ||||||
| 332 | } | ||||||
| 333 | } | ||||||
| 334 | } | ||||||
| 335 | |||||||
| 336 | # Erasing characters | ||||||
| 337 | if ($action->label eq 'ERA01') { | ||||||
| 338 | if ($action->w1l != $action->w2l) { | ||||||
| 339 | die "The chars are not horizontally aligned, starting at line {$action->w1l} and ending at line {$action->w2l}"; | ||||||
| 340 | } | ||||||
| 341 | # checking the line and column minimum numbers | ||||||
| 342 | check_l_min($action->w1l); | ||||||
| 343 | check_c_min($action->w1c); | ||||||
| 344 | check_c_min($action->w2c); | ||||||
| 345 | # begin and end | ||||||
| 346 | my ($c_beg, $c_end); | ||||||
| 347 | if ($action->w1c > $action->w2c) { | ||||||
| 348 | $c_beg = l2p_col($action->w2c); | ||||||
| 349 | $c_end = l2p_col($action->w1c); | ||||||
| 350 | filling_spaces($action->w1l, $action->w1c); | ||||||
| 351 | } | ||||||
| 352 | else { | ||||||
| 353 | $c_beg = l2p_col($action->w1c); | ||||||
| 354 | $c_end = l2p_col($action->w2c); | ||||||
| 355 | filling_spaces($action->w1l, $action->w2c); | ||||||
| 356 | } | ||||||
| 357 | for my $i ($c_beg .. $c_end) { | ||||||
| 358 | $sheet[l2p_lin($action->w1l)][$i]->set_char(' '); | ||||||
| 359 | } | ||||||
| 360 | } | ||||||
| 361 | |||||||
| 362 | # Talking | ||||||
| 363 | if ($talkative or substr($action->label, 0, 3) eq 'TIT') { | ||||||
| 364 | my $line = Arithmetic::PaperAndPencil::Label::full_label($action->label, $action->val1, $action->val2, $action->val3, $lang); | ||||||
| 365 | if ($line) { | ||||||
| 366 | if (substr($action->label, 0, 3) eq 'TIT') { | ||||||
| 367 | $line = " |
||||||
| 368 | } | ||||||
| 369 | else { | ||||||
| 370 | $line = " |
||||||
| 371 | } | ||||||
| 372 | $result .= $line; | ||||||
| 373 | } | ||||||
| 374 | } | ||||||
| 375 | |||||||
| 376 | # Showing the operation | ||||||
| 377 | if ($action->level <= $level) { | ||||||
| 378 | my $op = ''; | ||||||
| 379 | for my $l (0 .. $#sheet) { | ||||||
| 380 | my $line = $sheet[$l]; | ||||||
| 381 | my $line1 = join('', map { $_->pseudo_html } @$line); | ||||||
| 382 | $op .= $line1 . "\n"; | ||||||
| 383 | } | ||||||
| 384 | if ($op ne '') { | ||||||
| 385 | $result .= "\n$op\n"; |
||||||
| 386 | } | ||||||
| 387 | # untagging written and read chars | ||||||
| 388 | for my $line (@sheet) { | ||||||
| 389 | for my $char (@$line) { | ||||||
| 390 | $char->set_read (0); | ||||||
| 391 | $char->set_write(0); | ||||||
| 392 | } | ||||||
| 393 | } | ||||||
| 394 | } | ||||||
| 395 | } | ||||||
| 396 | |||||||
| 397 | # simplyfing pseudo-HTML | ||||||
| 398 | $result =~ s{ |
||||||
| 399 | $result =~ s{ |
||||||
| 400 | $result =~ s{(\h*) |
||||||
| 401 | $result =~ s{(\h*) |
||||||
| 402 | |||||||
| 403 | # changing pseudo-HTML into proper HTML | ||||||
| 404 | $result =~ s/operation>/h1>/g; | ||||||
| 405 | if ($css->{talk}) { | ||||||
| 406 | $result =~ s!!!g; | ||||||
| 407 | $result =~ s! !g; |
||||||
| 408 | } | ||||||
| 409 | else { | ||||||
| 410 | $result =~ s/talk>/p>/g; | ||||||
| 411 | } | ||||||
| 412 | if ($css->{underline}) { | ||||||
| 413 | $result =~ s!!!g; | ||||||
| 414 | $result =~ s! |
||||||
| 415 | } | ||||||
| 416 | else { | ||||||
| 417 | $result =~ s/underline>/u>/g; | ||||||
| 418 | } | ||||||
| 419 | # maybe I should replace all "strike" tags by "del"? or by "s"? | ||||||
| 420 | # see https://www.w3schools.com/tags/tag_strike.asp : |
||||||
| 421 | if ($css->{strike}) { | ||||||
| 422 | $result =~ s!!!g; | ||||||
| 423 | $result =~ s! |
||||||
| 424 | } | ||||||
| 425 | if ($css->{read}) { | ||||||
| 426 | $result =~ s!!!g; | ||||||
| 427 | $result =~ s! |
||||||
| 428 | } | ||||||
| 429 | else { | ||||||
| 430 | $result =~ s/read>/em>/g; | ||||||
| 431 | } | ||||||
| 432 | if ($css->{write}) { | ||||||
| 433 | $result =~ s!!!g; | ||||||
| 434 | $result =~ s! |
||||||
| 435 | } | ||||||
| 436 | else { | ||||||
| 437 | $result =~ s/write>/strong>/g; | ||||||
| 438 | } | ||||||
| 439 | $result =~ s/\h+$//gm; | ||||||
| 440 | |||||||
| 441 | return $result; | ||||||
| 442 | } | ||||||
| 443 | |||||||
| 444 | method addition(@numbers) { | ||||||
| 445 | if (@numbers == 0) { | ||||||
| 446 | croak "The addition needs at least one number to add"; | ||||||
| 447 | } | ||||||
| 448 | |||||||
| 449 | my $action; | ||||||
| 450 | my $nb = 0+ @numbers; | ||||||
| 451 | my $radix = $numbers[0]->radix; | ||||||
| 452 | my $max_length = 0; | ||||||
| 453 | my @digits; # storing the numbers' digits | ||||||
| 454 | my @total; # storing the total's digit positions | ||||||
| 455 | |||||||
| 456 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => "TIT01", val1 => "$radix"); | ||||||
| 457 | push @action, $action; | ||||||
| 458 | |||||||
| 459 | for my $i (0 .. $#numbers) { | ||||||
| 460 | my $n = $numbers[$i]; | ||||||
| 461 | # checking the number | ||||||
| 462 | if ($n->radix != $radix) { | ||||||
| 463 | croak "All numbers must have the same radix"; | ||||||
| 464 | } | ||||||
| 465 | # writing the number | ||||||
| 466 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => $i, w1c => 0, w1val => $n->value); | ||||||
| 467 | push(@action, $action); | ||||||
| 468 | # preparing the horizontal line | ||||||
| 469 | if ($max_length < $n->chars) { | ||||||
| 470 | $max_length = $n->chars; | ||||||
| 471 | } | ||||||
| 472 | # feeding the table of digits | ||||||
| 473 | my $val = reverse($n->value); | ||||||
| 474 | for my $j (0 .. length($val) - 1) { | ||||||
| 475 | my $x = substr($val, $j, 1); | ||||||
| 476 | push(@{$digits[$j]}, { lin => $i, col => -$j, val => $x } ); | ||||||
| 477 | } | ||||||
| 478 | } | ||||||
| 479 | $action = Arithmetic::PaperAndPencil::Action->new(level => 2, label => 'DRA02', w1l => $nb - 1, w1c => 1 - $max_length | ||||||
| 480 | , w2l => $nb - 1, w2c => 0); | ||||||
| 481 | push(@action, $action); | ||||||
| 482 | for my $j (0 .. $max_length -1) { | ||||||
| 483 | $total[$j] = { lin => $nb, col => -$j }; | ||||||
| 484 | } | ||||||
| 485 | my $result = $self->_adding(\@digits, \@total, 0, $radix); | ||||||
| 486 | return Arithmetic::PaperAndPencil::Number->new(value => $result, radix => $radix); | ||||||
| 487 | } | ||||||
| 488 | |||||||
| 489 | method subtraction(%param) { | ||||||
| 490 | my $high = $param{high}; | ||||||
| 491 | my $low = $param{low}; | ||||||
| 492 | my $type = $param{type} // 'std'; | ||||||
| 493 | |||||||
| 494 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 495 | my $radix = $high->radix; | ||||||
| 496 | my $leng = $high->chars; | ||||||
| 497 | if ($low->radix != $radix) { | ||||||
| 498 | croak "The two numbers have different bases: $radix != @{[$low->radix]}"; | ||||||
| 499 | } | ||||||
| 500 | if ($type ne 'std' && $type ne 'compl') { | ||||||
| 501 | croak "Subtraction type '$type' unknown"; | ||||||
| 502 | } | ||||||
| 503 | if ($high < $low) { | ||||||
| 504 | croak "The high number @{[$high->value]} must be greater than or equal to the low number @{[$low->value]}"; | ||||||
| 505 | } | ||||||
| 506 | if (@action) { | ||||||
| 507 | $action[-1]->set_level(0); | ||||||
| 508 | } | ||||||
| 509 | if (($type eq 'std')) { | ||||||
| 510 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'TIT02', val1 => $high->value, val2 => $low->value, val3 => $radix); | ||||||
| 511 | push(@action, $action); | ||||||
| 512 | # set-up | ||||||
| 513 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => 0, w1c => $leng, w1val => $high->value); | ||||||
| 514 | push(@action, $action); | ||||||
| 515 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => 1, w1c => $leng, w1val => $low->value); | ||||||
| 516 | push(@action, $action); | ||||||
| 517 | |||||||
| 518 | # computation | ||||||
| 519 | my $result = ''; | ||||||
| 520 | $result = $self->_embedded_sub(basic_level => 0, l_hi => 0, c_hi => $leng, high => $high | ||||||
| 521 | , l_lo => 1, c_lo => $leng, low => $low | ||||||
| 522 | , l_re => 2, c_re => $leng); | ||||||
| 523 | $action[-1]->set_level(0); | ||||||
| 524 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result); | ||||||
| 525 | } | ||||||
| 526 | else { | ||||||
| 527 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'TIT15', val1 => $high->value, val2 => $low->value, val3 => $radix); | ||||||
| 528 | push(@action, $action); | ||||||
| 529 | my Arithmetic::PaperAndPencil::Number $complement = $low->complement($leng); | ||||||
| 530 | # set-up | ||||||
| 531 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 | ||||||
| 532 | , label => 'SUB03', val1 => $radix, val2 => $low->value, val3 => $complement->value | ||||||
| 533 | , w1l => 0 , w1c => $leng , w1val => $high->value | ||||||
| 534 | , w2l => 1 , w2c => $leng , w2val => $complement->value); | ||||||
| 535 | push(@action, $action); | ||||||
| 536 | $action = Arithmetic::PaperAndPencil::Action->new(level => 2, label => 'DRA02', w1l => 1, w1c => 1 | ||||||
| 537 | , w2l => 1, w2c => $leng); | ||||||
| 538 | push(@action, $action); | ||||||
| 539 | |||||||
| 540 | my @digits; # storing the numbers' digits | ||||||
| 541 | my @result; # storing the result's digit positions | ||||||
| 542 | my $compl_val = '0' x ($leng - $complement->chars) . $complement->value; | ||||||
| 543 | for my $i (0 .. $leng - 1) { | ||||||
| 544 | $digits[$i][0] = { lin => 0, col => $leng - $i, val => substr($high->value, $leng - $i - 1, 1) }; | ||||||
| 545 | $digits[$i][1] = { lin => 1, col => $leng - $i, val => substr($compl_val , $leng - $i - 1, 1) }; | ||||||
| 546 | $result[$i] = { lin => 2, col => $leng - $i }; | ||||||
| 547 | } | ||||||
| 548 | my $result = substr($self->_adding(\@digits, \@result, 0, $radix), 1); | ||||||
| 549 | # getting rid of leading zeroes except if the result is zero | ||||||
| 550 | $result =~ s/^0*//; | ||||||
| 551 | if ($result eq '') { | ||||||
| 552 | $result = '0'; | ||||||
| 553 | } | ||||||
| 554 | $action = Arithmetic::PaperAndPencil::Action->new(level => 0, label => 'SUB04', val1 => $result, r1l => 2, r1c => 0, r1val => '1', r1str => 1); | ||||||
| 555 | push(@action, $action); | ||||||
| 556 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result); | ||||||
| 557 | } | ||||||
| 558 | } | ||||||
| 559 | |||||||
| 560 | method multiplication(%param) { | ||||||
| 561 | my $multiplicand = $param{multiplicand}; | ||||||
| 562 | my $multiplier = $param{multiplier}; | ||||||
| 563 | my $type = $param{type} // 'std'; | ||||||
| 564 | my $direction = $param{direction} // 'ltr'; # for the 'boat' type, elementary products are processed left-to-right or right-to-left ('rtl') | ||||||
| 565 | my $mult_and_add = $param{mult_and_add} // 'separate'; # for the 'boat' type, addition is a separate subphase (contrary: 'combined') | ||||||
| 566 | my $product = $param{product} // 'L-shaped'; # for the 'jalousie-?" types, the product is L-shaped along the rectangle (contrary: 'straight' on the bottom line) | ||||||
| 567 | |||||||
| 568 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 569 | if ($multiplicand->radix != $multiplier->radix) { | ||||||
| 570 | die "Multiplicand and multiplier have different bases: @{[$multiplicand->radix]} != @{[$multiplier->radix]}"; | ||||||
| 571 | } | ||||||
| 572 | my $title = ''; | ||||||
| 573 | my $radix = $multiplicand->radix; | ||||||
| 574 | if ($type eq 'std' ) { $title = 'TIT03' ; } | ||||||
| 575 | elsif ($type eq 'shortcut' ) { $title = 'TIT04' ; } | ||||||
| 576 | elsif ($type eq 'prepared' ) { $title = 'TIT05' ; } | ||||||
| 577 | elsif ($type eq 'jalousie-A') { $title = 'TIT06' ; } | ||||||
| 578 | elsif ($type eq 'jalousie-B') { $title = 'TIT07' ; } | ||||||
| 579 | elsif ($type eq 'boat' ) { $title = 'TIT08' ; } | ||||||
| 580 | elsif ($type eq 'russian' ) { $title = 'TIT19' ; } | ||||||
| 581 | if ($title eq '') { | ||||||
| 582 | die "Multiplication type '$type' unknown"; | ||||||
| 583 | } | ||||||
| 584 | if ($type eq 'jalousie-A' || $type eq 'jalousie-B') { | ||||||
| 585 | if ($product ne 'L-shaped' && $product ne 'straight') { | ||||||
| 586 | die "Product shape '$product' should be 'L-shaped' or 'straight'"; | ||||||
| 587 | } | ||||||
| 588 | } | ||||||
| 589 | if ($type eq 'boat') { | ||||||
| 590 | if ($direction ne 'ltr' && $direction ne 'rtl') { | ||||||
| 591 | die "Direction '$direction' should be 'ltr' (left-to-right) or 'rtl' (right-to-left)"; | ||||||
| 592 | } | ||||||
| 593 | if ($mult_and_add ne 'separate' && $mult_and_add ne 'combined') { | ||||||
| 594 | die "Parameter mult_and_add '$mult_and_add' should be 'separate' or 'combined'"; | ||||||
| 595 | } | ||||||
| 596 | } | ||||||
| 597 | |||||||
| 598 | my $len1 = $multiplicand->chars; | ||||||
| 599 | my $len2 = $multiplier->chars; | ||||||
| 600 | if (@action) { | ||||||
| 601 | $action[-1]->set_level(0); | ||||||
| 602 | } | ||||||
| 603 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9 | ||||||
| 604 | , label => $title | ||||||
| 605 | , val1 => $multiplicand->value | ||||||
| 606 | , val2 => $multiplier->value | ||||||
| 607 | , val3 => $multiplier->radix | ||||||
| 608 | ); | ||||||
| 609 | push(@action, $action); | ||||||
| 610 | |||||||
| 611 | # caching the partial products for prepared and shortcut multiplications | ||||||
| 612 | my %mult_cache = (1 => $multiplicand); | ||||||
| 613 | if ($type eq 'prepared') { | ||||||
| 614 | my $limit = max(split('', $multiplier->value)); | ||||||
| 615 | $self->_preparation(factor => $multiplicand, limit => $limit, cache => \%mult_cache); | ||||||
| 616 | } | ||||||
| 617 | |||||||
| 618 | if ($type eq 'std' || $type eq 'shortcut' || $type eq 'prepared') { | ||||||
| 619 | # set-up | ||||||
| 620 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 | ||||||
| 621 | , label => 'WRI00', w1l => 0, w1c => $len1 + $len2, w1val => $multiplicand->value | ||||||
| 622 | , w2l => 1, w2c => $len1 + $len2, w2val => $multiplier->value); | ||||||
| 623 | push(@action, $action); | ||||||
| 624 | $action = Arithmetic::PaperAndPencil::Action->new(level => 2 | ||||||
| 625 | , label => 'DRA02', w1l => 1, w1c => min($len1, $len2) | ||||||
| 626 | , w2l => 1, w2c => $len1 + $len2); | ||||||
| 627 | push(@action, $action); | ||||||
| 628 | |||||||
| 629 | # multiplication of two single-digit numbers | ||||||
| 630 | if ($len1 == 1 && $len2 == 1) { | ||||||
| 631 | my Arithmetic::PaperAndPencil::Number $pdt = $multiplier * $multiplicand; | ||||||
| 632 | $action = Arithmetic::PaperAndPencil::Action->new(level => 0, label => 'MUL02' | ||||||
| 633 | , r1l => 0, r1c => 2, r1val => $multiplier->value , val1 => $multiplier->value | ||||||
| 634 | , r2l => 1, r2c => 2, r2val => $multiplicand->value , val2 => $multiplicand->value | ||||||
| 635 | , w1l => 2, w1c => 2, w1val => $pdt->value , val3 => $pdt->value | ||||||
| 636 | ); | ||||||
| 637 | push(@action, $action); | ||||||
| 638 | return $pdt; | ||||||
| 639 | } | ||||||
| 640 | # multiplication with a single-digit multiplier | ||||||
| 641 | if ($len2 == 1 && $type eq 'prepared') { | ||||||
| 642 | my Arithmetic::PaperAndPencil::Number $pdt; | ||||||
| 643 | $pdt = $mult_cache{$multiplier->value}; | ||||||
| 644 | $action = Arithmetic::PaperAndPencil::Action->new(level => 0, label => 'WRI05', val1 => $pdt->value | ||||||
| 645 | , w1l => 2, w1c => $len1 + 1, w1val => $pdt->value | ||||||
| 646 | ); | ||||||
| 647 | push(@action, $action); | ||||||
| 648 | return $pdt; | ||||||
| 649 | } | ||||||
| 650 | if ($len2 == 1) { | ||||||
| 651 | my Arithmetic::PaperAndPencil::Number $pdt; | ||||||
| 652 | $pdt = $self->_simple_mult(basic_level => 0, l_md => 0, c_md => $len1 + 1, multiplicand => $multiplicand | ||||||
| 653 | , l_mr => 1, c_mr => $len1 + 1, multiplier => $multiplier | ||||||
| 654 | , l_pd => 2, c_pd => $len1 + 1 ); | ||||||
| 655 | $action[-1]->set_level(0); | ||||||
| 656 | return $pdt; | ||||||
| 657 | } | ||||||
| 658 | # multiplication with a multi-digit multiplier | ||||||
| 659 | my Arithmetic::PaperAndPencil::Number $pdt; | ||||||
| 660 | $pdt = $self->_adv_mult(basic_level => 0, l_md => 0, c_md => $len1 + $len2, multiplicand => $multiplicand | ||||||
| 661 | , l_mr => 1, c_mr => $len1 + $len2, multiplier => $multiplier | ||||||
| 662 | , l_pd => 2, c_pd => $len1 + $len2 | ||||||
| 663 | , type => $type, cache => \%mult_cache); | ||||||
| 664 | $action[-1]->set_level(0); | ||||||
| 665 | return $pdt; | ||||||
| 666 | } | ||||||
| 667 | if ($type eq 'jalousie-A' || $type eq 'jalousie-B') { | ||||||
| 668 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 | ||||||
| 669 | , label => 'DRA02', w1l => 0, w1c => 1 | ||||||
| 670 | , w2l => 0, w2c => 2 * $len1); | ||||||
| 671 | push(@action, $action); | ||||||
| 672 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 | ||||||
| 673 | , label => 'DRA01', w1l => 1 , w1c => 0 | ||||||
| 674 | , w2l => 2 * $len2, w2c => 0); | ||||||
| 675 | push(@action, $action); | ||||||
| 676 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 | ||||||
| 677 | , label => 'DRA01', w1l => 1 , w1c => 2 * $len1 | ||||||
| 678 | , w2l => 2 * $len2, w2c => 2 * $len1); | ||||||
| 679 | push(@action, $action); | ||||||
| 680 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 | ||||||
| 681 | , label => 'DRA02', w1l => 2 * $len2, w1c => 1 | ||||||
| 682 | , w2l => 2 * $len2, w2c => 2 * $len1); | ||||||
| 683 | push(@action, $action); | ||||||
| 684 | } | ||||||
| 685 | if ($type eq 'jalousie-A') { | ||||||
| 686 | for my $i (1 .. $len1) { | ||||||
| 687 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => 0, w1c => 2 * $i - 1, w1val => substr($multiplicand->value, $i - 1, 1)); | ||||||
| 688 | push(@action, $action); | ||||||
| 689 | } | ||||||
| 690 | for my $i (1 .. $len2) { | ||||||
| 691 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => 2 * $i, w1c => 2 * $len1 + 1, w1val => substr($multiplier->value, $i - 1, 1)); | ||||||
| 692 | push(@action, $action); | ||||||
| 693 | } | ||||||
| 694 | for my $i (1 .. $len1 + $len2 - 1) { | ||||||
| 695 | my $l1 = 1; | ||||||
| 696 | my $c1 = 2 * $i; | ||||||
| 697 | my $l2 = 2 * $len2; | ||||||
| 698 | my $c2 = 2 * ($i - $len2) + 1; | ||||||
| 699 | if ($c1 >= 2 * $len1) { | ||||||
| 700 | $l1 += $c1 - 2 * $len1; | ||||||
| 701 | $c1 = 2 * $len1; | ||||||
| 702 | } | ||||||
| 703 | if ($c2 <= 0 && $product eq 'L-shaped') { | ||||||
| 704 | $l2 -= 1 - $c2; | ||||||
| 705 | $c2 = 1; | ||||||
| 706 | } | ||||||
| 707 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DRA04', w1l => $l1, w1c => $c1, w2l => $l2, w2c => $c2); | ||||||
| 708 | push(@action, $action); | ||||||
| 709 | } | ||||||
| 710 | # end of set-up phase | ||||||
| 711 | $action[-1]->set_level(2); | ||||||
| 712 | |||||||
| 713 | # multiplication phase | ||||||
| 714 | my @partial; | ||||||
| 715 | for my $l (1 .. $len2) { | ||||||
| 716 | my $x = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($multiplier->value, $l - 1, 1)); | ||||||
| 717 | for my $c (1 .. $len1) { | ||||||
| 718 | my $y = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($multiplicand->value, $c - 1, 1)); | ||||||
| 719 | my Arithmetic::PaperAndPencil::Number $pdt = $x * $y; | ||||||
| 720 | my Arithmetic::PaperAndPencil::Number $unit = $pdt->unit; | ||||||
| 721 | my Arithmetic::PaperAndPencil::Number $carry = $pdt->carry; | ||||||
| 722 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 | ||||||
| 723 | , label => 'MUL01', r1l => 2 * $l , r1c => 2 * $len1 + 1, r1val => $x->value , val1 => $x->value | ||||||
| 724 | , r2l => 0 , r2c => 2 * $c - 1 , r2val => $y->value , val2 => $y->value | ||||||
| 725 | , w1l => 2 * $l - 1, w1c => 2 * $c - 1 , w1val => $carry->value, val3 => $pdt->value | ||||||
| 726 | , w2l => 2 * $l , w2c => 2 * $c , w2val => $unit->value | ||||||
| 727 | ); | ||||||
| 728 | push(@action, $action); | ||||||
| 729 | $partial[$len1 + $len2 - $l - $c ][2 * $l ] = { lin => 2 * $l , col => 2 * $c , val => $unit->value }; | ||||||
| 730 | $partial[$len1 + $len2 - $l - $c + 1][2 * $l - 1] = { lin => 2 * $l - 1, col => 2 * $c - 1, val => $carry->value }; | ||||||
| 731 | } | ||||||
| 732 | # end of line | ||||||
| 733 | $action[-1]->set_level(3); | ||||||
| 734 | } | ||||||
| 735 | # end of multiplication phase | ||||||
| 736 | $action[-1]->set_level(2); | ||||||
| 737 | |||||||
| 738 | # Addition phase | ||||||
| 739 | my @final; | ||||||
| 740 | my $limit; | ||||||
| 741 | if ($product eq 'L-shaped') { $limit = $len1; } | ||||||
| 742 | elsif ($product eq 'straight') { $limit = $len1 + $len2; } | ||||||
| 743 | for my $i (0 .. $limit - 1) { | ||||||
| 744 | $final[$i] = { lin => 2 * $len2 + 1, col => 2 * ($len1 - $i) - 1 }; | ||||||
| 745 | } | ||||||
| 746 | for my $i ($limit .. $len1 + $len2 - 1) { | ||||||
| 747 | $final[$i] = { lin => 2 * ($len1 + $len2 - $i), col => 0 }; | ||||||
| 748 | } | ||||||
| 749 | my $result = $self->_adding(\@partial, \@final, 0, $radix); | ||||||
| 750 | $action[-1]->set_level(0); | ||||||
| 751 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result); | ||||||
| 752 | } | ||||||
| 753 | if ($type eq 'jalousie-B') { | ||||||
| 754 | for my $i (1 .. $len1) { | ||||||
| 755 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => 0, w1c => 2 * $i, w1val => substr($multiplicand->value, $i - 1, 1)); | ||||||
| 756 | push(@action, $action); | ||||||
| 757 | } | ||||||
| 758 | for my $i (1 .. $len2) { | ||||||
| 759 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => 2 * ($len2 - $i + 1), w1c => 0, w1val => substr($multiplier->value, $i - 1, 1)); | ||||||
| 760 | push(@action, $action); | ||||||
| 761 | } | ||||||
| 762 | for my $i (1 - $len2 .. $len1 - 1) { | ||||||
| 763 | my $l1 = 1; | ||||||
| 764 | my $c1 = 1 + 2 * $i; | ||||||
| 765 | my $l2 = 2 * $len2; | ||||||
| 766 | my $c2 = 2 * ($i + $len2); | ||||||
| 767 | if ($c1 <= 0) { | ||||||
| 768 | $l1 += 1 - $c1; | ||||||
| 769 | $c1 = 1; | ||||||
| 770 | } | ||||||
| 771 | if ($c2 >= 2 * $len1 && $product eq 'L-shaped') { | ||||||
| 772 | $l2 -= $c2 - 2 * $len1; | ||||||
| 773 | $c2 = 2 * $len1; | ||||||
| 774 | } | ||||||
| 775 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DRA03', w1l => $l1, w1c => $c1, w2l => $l2, w2c => $c2); | ||||||
| 776 | push(@action, $action); | ||||||
| 777 | } | ||||||
| 778 | # end of set-up phase | ||||||
| 779 | $action[-1]->set_level(2); | ||||||
| 780 | |||||||
| 781 | # multiplication phase | ||||||
| 782 | my @partial; | ||||||
| 783 | for my $l (1 .. $len2) { | ||||||
| 784 | my $x = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($multiplier->value, $len2 - $l, 1)); | ||||||
| 785 | for my $c (1 .. $len1) { | ||||||
| 786 | my $y = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($multiplicand->value, $c - 1, 1)); | ||||||
| 787 | my Arithmetic::PaperAndPencil::Number $pdt = $x * $y; | ||||||
| 788 | my Arithmetic::PaperAndPencil::Number $unit = $pdt->unit; | ||||||
| 789 | my Arithmetic::PaperAndPencil::Number $carry = $pdt->carry; | ||||||
| 790 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 | ||||||
| 791 | , label => 'MUL01', r1l => 2 * $l , r1c => 0 , r1val => $x->value , val1 => $x->value | ||||||
| 792 | , r2l => 0 , r2c => 2 * $c , r2val => $y->value , val2 => $y->value | ||||||
| 793 | , w1l => 2 * $l , w1c => 2 * $c - 1, w1val => $carry->value, val3 => $pdt->value | ||||||
| 794 | , w2l => 2 * $l - 1, w2c => 2 * $c , w2val => $unit->value | ||||||
| 795 | ); | ||||||
| 796 | push(@action, $action); | ||||||
| 797 | $partial[$len1 - $c + $l - 1][2 * $l - 1] = { lin => 2 * $l - 1, col => 2 * $c , val => $unit->value }; | ||||||
| 798 | $partial[$len1 - $c + $l ][2 * $l ] = { lin => 2 * $l , col => 2 * $c - 1, val => $carry->value }; | ||||||
| 799 | } | ||||||
| 800 | # end of line | ||||||
| 801 | $action[-1]->set_level(3); | ||||||
| 802 | } | ||||||
| 803 | # end of multiplication phase | ||||||
| 804 | $action[-1]->set_level(2); | ||||||
| 805 | |||||||
| 806 | # Addition phase | ||||||
| 807 | my @final; | ||||||
| 808 | my $limit; | ||||||
| 809 | if ($product eq 'L-shaped') { $limit = $len2; } | ||||||
| 810 | elsif ($product eq 'straight') { $limit = 0; } | ||||||
| 811 | for my $i (0 .. $limit - 1) { | ||||||
| 812 | $final[$i] = { lin => 2 * $i + 2, col => 2 * $len1 + 1 }; | ||||||
| 813 | } | ||||||
| 814 | for my $i ($limit .. $len1 + $len2 - 1) { | ||||||
| 815 | $final[$i] = { lin => 2 * $len2 + 1, col => 2 * ($len1 + $len2 - $i) }; | ||||||
| 816 | } | ||||||
| 817 | my $result = $self->_adding(\@partial, \@final, 0, $radix); | ||||||
| 818 | $action[-1]->set_level(0); | ||||||
| 819 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result); | ||||||
| 820 | } | ||||||
| 821 | if ($type eq 'boat') { | ||||||
| 822 | # set up phase | ||||||
| 823 | my $tot_len = $len1 + $len2 - 1; | ||||||
| 824 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => 0, w1c => $tot_len, w1val => $multiplicand->value); | ||||||
| 825 | push(@action, $action); | ||||||
| 826 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DRA02', w1l => -1, w1c => 0, w2l => -1, w2c => $tot_len); | ||||||
| 827 | push(@action, $action); | ||||||
| 828 | $action = Arithmetic::PaperAndPencil::Action->new(level => 2, label => 'DRA02', w1l => 0, w1c => 0, w2l => 0, w2c => $tot_len); | ||||||
| 829 | push(@action, $action); | ||||||
| 830 | |||||||
| 831 | # arrays of line numbers per column | ||||||
| 832 | my @lines_below = ( 1 ) x ($len1 + $len2); | ||||||
| 833 | my @lines_above = (-1 ) x ($len1 + $len2); | ||||||
| 834 | my @result = ('0') x ($len1 + $len2); | ||||||
| 835 | |||||||
| 836 | # multiplication phase | ||||||
| 837 | my @partial; | ||||||
| 838 | for my $col ($len2 .. $tot_len) { | ||||||
| 839 | my $x = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($multiplicand->value, $col - $len2, 1)); | ||||||
| 840 | # write the multiplier at the proper column | ||||||
| 841 | $self->_push_below($multiplier, $col, \@lines_below); | ||||||
| 842 | |||||||
| 843 | # partial products | ||||||
| 844 | my @range = (1 .. $len2); | ||||||
| 845 | my $last = $len2; | ||||||
| 846 | if ($direction eq 'rtl') { | ||||||
| 847 | @range = reverse(@range); | ||||||
| 848 | $last = 1; | ||||||
| 849 | } | ||||||
| 850 | for my $c (@range) { | ||||||
| 851 | my $y = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($multiplier->value, $c - 1, 1)); | ||||||
| 852 | my Arithmetic::PaperAndPencil::Number $pdt = $x * $y; | ||||||
| 853 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'MUL01' | ||||||
| 854 | , val1 => $y->value, r1l => $lines_below[$col - $len2 + $c] - 1, r1c => $col - $len2 + $c, r1val => $y->value, r1str => 1 | ||||||
| 855 | , val2 => $x->value, r2l => 0 , r2c => $col , r2val => $x->value, r2str => 0+ ($c == $last) | ||||||
| 856 | , val3 => $pdt->value); | ||||||
| 857 | push(@action, $action); | ||||||
| 858 | if ($mult_and_add eq 'separate') { | ||||||
| 859 | $self->_push_above($pdt, $col - $len2 + $c, \@lines_above, \@partial, $tot_len); | ||||||
| 860 | } | ||||||
| 861 | else { | ||||||
| 862 | $self->_add_above($pdt, $col - $len2 + $c, \@lines_above, \@result); | ||||||
| 863 | } | ||||||
| 864 | $action[-1]->set_level(4); | ||||||
| 865 | } | ||||||
| 866 | $action[-1]->set_level(3); | ||||||
| 867 | } | ||||||
| 868 | |||||||
| 869 | # addition phase | ||||||
| 870 | my @final; | ||||||
| 871 | my $result; | ||||||
| 872 | if ($mult_and_add eq 'separate') { | ||||||
| 873 | for my $col (0 .. -1 + @lines_above) { | ||||||
| 874 | $final[$col] = { lin => $lines_above[$tot_len - $col], col => $tot_len - $col }; | ||||||
| 875 | } | ||||||
| 876 | $result = $self->_adding(\@partial, \@final, 0, $radix, 1); | ||||||
| 877 | } | ||||||
| 878 | else { | ||||||
| 879 | $result = join('', @result); | ||||||
| 880 | } | ||||||
| 881 | $action[-1]->set_level(0); | ||||||
| 882 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result); | ||||||
| 883 | } | ||||||
| 884 | if ($type eq 'russian') { | ||||||
| 885 | # set-up | ||||||
| 886 | my Arithmetic::PaperAndPencil::Number $md = $multiplicand; | ||||||
| 887 | my Arithmetic::PaperAndPencil::Number $mr = $multiplier; | ||||||
| 888 | my $c_md = 2 * $len2 + 1 + $len1; | ||||||
| 889 | my $c_mr = $len2; | ||||||
| 890 | $action = Arithmetic::PaperAndPencil::Action->new(level => 3, label => 'WRI00' | ||||||
| 891 | , w1l => 0, w1c => $c_md, w1val => $md->value | ||||||
| 892 | , w2l => 0, w2c => $c_mr, w2val => $mr->value); | ||||||
| 893 | push(@action, $action); | ||||||
| 894 | |||||||
| 895 | # first phase, doubling the multiplicand and halving the multiplier | ||||||
| 896 | my $l = 0; | ||||||
| 897 | my @lines = (); | ||||||
| 898 | push(@lines, { mr => $mr, md => $md }); | ||||||
| 899 | while ($mr->value ne '1') { | ||||||
| 900 | $mr = $self->_halving( l1 => $l, c1 => $c_mr, l2 => $l + 1, c2 => $c_mr, number => $mr); | ||||||
| 901 | $md = $self->_doubling(l1 => $l, c1 => $c_md, l2 => $l + 1, c2 => $c_md, number => $md); | ||||||
| 902 | push(@lines, { mr => $mr, md => $md }); | ||||||
| 903 | $l++; | ||||||
| 904 | } | ||||||
| 905 | $action[-1]->set_level(2); | ||||||
| 906 | |||||||
| 907 | # second phase, testing even numbers and striking | ||||||
| 908 | my @partial; | ||||||
| 909 | my @final; | ||||||
| 910 | for my $l (0 .. $#lines) { | ||||||
| 911 | my $line = $lines[$l]; | ||||||
| 912 | $mr = $line->{mr}; | ||||||
| 913 | $md = $line->{md}; | ||||||
| 914 | if ($mr->is_odd) { | ||||||
| 915 | my @digit_list = split('', reverse($md->value)); | ||||||
| 916 | for my $i (0 .. $#digit_list) { | ||||||
| 917 | push @{$partial[$i]}, { lin => $l, col => $c_md - $i, val => $digit_list[$i] }; | ||||||
| 918 | } | ||||||
| 919 | } | ||||||
| 920 | else { | ||||||
| 921 | $action = Arithmetic::PaperAndPencil::Action->new(level => 4, label => 'MUL03' | ||||||
| 922 | , val1 => $mr->value, r1l => $l, r1c => $c_mr, r1val => $mr->value | ||||||
| 923 | , val2 => $md->value, r2l => $l, r2c => $c_md, r2val => $md->value, r2str => 1); | ||||||
| 924 | push(@action, $action); | ||||||
| 925 | } | ||||||
| 926 | if ($mr->value eq '1') { | ||||||
| 927 | my @digit_list = split('', reverse($md->value)); | ||||||
| 928 | for my $i(0 .. $#digit_list) { | ||||||
| 929 | $final[$i] = { lin => 0+ @lines, col => $c_md - $i }; | ||||||
| 930 | } | ||||||
| 931 | $action = Arithmetic::PaperAndPencil::Action->new(level => 2, label => 'DRA02' | ||||||
| 932 | , w1l => $l, w1c => $c_md + 1 - $md->chars | ||||||
| 933 | , w2l => $l, w2c => $c_md); | ||||||
| 934 | push(@action, $action); | ||||||
| 935 | } | ||||||
| 936 | } | ||||||
| 937 | $action[-1]->set_level(2); | ||||||
| 938 | |||||||
| 939 | # third phase, adding | ||||||
| 940 | my $result = $self->_adding(\@partial, \@final, 0, $radix); | ||||||
| 941 | $action[-1]->set_level(0); | ||||||
| 942 | |||||||
| 943 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result); | ||||||
| 944 | } | ||||||
| 945 | } | ||||||
| 946 | |||||||
| 947 | method division(%param) { | ||||||
| 948 | my $dividend = $param{dividend}; | ||||||
| 949 | my $divisor = $param{divisor}; | ||||||
| 950 | my $type = $param{type} // 'std'; | ||||||
| 951 | my $result = $param{result} // 'quotient'; | ||||||
| 952 | my $mult_and_sub = $param{mult_and_sub} // 'combined'; | ||||||
| 953 | |||||||
| 954 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 955 | my $radix = $dividend->radix; | ||||||
| 956 | if ($radix != $divisor->radix) { | ||||||
| 957 | die "Dividend and divisor have different bases: {$radix} != @{[$divisor->radix]}"; | ||||||
| 958 | } | ||||||
| 959 | if ($divisor->value eq '0') { | ||||||
| 960 | die "Division by zero is impossible"; | ||||||
| 961 | } | ||||||
| 962 | |||||||
| 963 | if (@action) { | ||||||
| 964 | $action[-1]->set_level(0); | ||||||
| 965 | } | ||||||
| 966 | my $len1 = $dividend->chars; | ||||||
| 967 | my $len2 = $divisor ->chars; | ||||||
| 968 | my $bot = 2; | ||||||
| 969 | my $title = ''; | ||||||
| 970 | if ($type eq 'std' ) { $title = 'TIT09' ; } | ||||||
| 971 | elsif ($type eq 'cheating') { $title = 'TIT10' ; } | ||||||
| 972 | elsif ($type eq 'prepared') { $title = 'TIT11' ; $mult_and_sub = 'separate' } | ||||||
| 973 | elsif ($type eq 'boat' ) { $title = 'TIT12' ; } | ||||||
| 974 | if ($title eq '') { | ||||||
| 975 | die "Division type '$type' unknown"; | ||||||
| 976 | } | ||||||
| 977 | if ($result ne 'quotient' && $result ne 'remainder' && $result ne 'both') { | ||||||
| 978 | die "Result type '$result' unknown"; | ||||||
| 979 | } | ||||||
| 980 | if ($mult_and_sub ne 'combined' && $mult_and_sub ne 'separate') { | ||||||
| 981 | die "Mult and sub type '$mult_and_sub' unknown"; | ||||||
| 982 | } | ||||||
| 983 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9 | ||||||
| 984 | , label => $title | ||||||
| 985 | , val1 => $dividend->value | ||||||
| 986 | , val2 => $divisor->value | ||||||
| 987 | , val3 => $radix | ||||||
| 988 | ); | ||||||
| 989 | push(@action, $action); | ||||||
| 990 | |||||||
| 991 | # Divisions with obvious results | ||||||
| 992 | my $zero = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '0'); | ||||||
| 993 | my $one = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '1'); | ||||||
| 994 | if ($divisor->value eq '1') { | ||||||
| 995 | $action = Arithmetic::PaperAndPencil::Action->new(level => 0, label => 'DIV05' | ||||||
| 996 | , val1 => $dividend->value, w1l => 1, w1c => 0, w1val => $dividend->value); | ||||||
| 997 | push(@action, $action); | ||||||
| 998 | if ($result eq 'quotient' ) { return $dividend; } | ||||||
| 999 | elsif ($result eq 'remainder') { return $zero; } | ||||||
| 1000 | elsif ($result eq 'both' ) { return ($dividend, $zero); } | ||||||
| 1001 | } | ||||||
| 1002 | if ($dividend < $divisor) { | ||||||
| 1003 | $action = Arithmetic::PaperAndPencil::Action->new(level => 0, label => 'DIV06', val1 => $dividend->value, val2 => $divisor->value | ||||||
| 1004 | , w1l => 1, w1c => 0, w1val => '0'); | ||||||
| 1005 | push(@action, $action); | ||||||
| 1006 | if ($result eq 'quotient' ) { return $zero; } | ||||||
| 1007 | elsif ($result eq 'remainder') { return $dividend; } | ||||||
| 1008 | elsif ($result eq 'both' ) { return ($zero, $dividend); } | ||||||
| 1009 | } | ||||||
| 1010 | |||||||
| 1011 | # caching the partial products for prepared, cheating and boat divisions | ||||||
| 1012 | my %div_cache = (0 => $zero, 1 => $divisor); | ||||||
| 1013 | if ($type eq 'prepared') { | ||||||
| 1014 | $self->_preparation(factor => $divisor, limit => 'Z', cache => \%div_cache); | ||||||
| 1015 | # the actual limit will be '9' for radix 10, 'F' for radix 16, etc. But 'Z' will give the same result | ||||||
| 1016 | } | ||||||
| 1017 | if ($type eq 'cheating' || $type eq 'boat') { | ||||||
| 1018 | my Arithmetic::PaperAndPencil $dummy = Arithmetic::PaperAndPencil->new; | ||||||
| 1019 | $dummy->_preparation(factor => $divisor, limit => 'Z', cache => \%div_cache); | ||||||
| 1020 | } | ||||||
| 1021 | |||||||
| 1022 | # setup | ||||||
| 1023 | my $delta = $len2 - 1; # how long we must shorten the divisor and the partial dividend to compute the quotient first candidate | ||||||
| 1024 | my $lin_d = 0; # line for the successive partial dividends | ||||||
| 1025 | my $col_q = $len1 + 1; # column for the successive single-digit partial quotients | ||||||
| 1026 | my $col_r = $len2; # column for the successive partial dividends and remainders | ||||||
| 1027 | my $len_dvd1 = 1; # length of the part of the dividend used to compute the first candidate digit | ||||||
| 1028 | # yes, string comparison or left-aligned comparison, to know if we need a short hook or a long hook | ||||||
| 1029 | if ($dividend lt $divisor) { | ||||||
| 1030 | $col_r++; | ||||||
| 1031 | $len_dvd1++; | ||||||
| 1032 | } | ||||||
| 1033 | |||||||
| 1034 | # computation | ||||||
| 1035 | if ($type eq 'std' || $type eq 'cheating' || $type eq 'prepared') { | ||||||
| 1036 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI00', w1l => 0, w1c => $len1, w1val => $dividend->value); | ||||||
| 1037 | push(@action, $action); | ||||||
| 1038 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DRA02', w1l => 0, w1c => $len1 + 1 | ||||||
| 1039 | , w2l => 0, w2c => $len1 + $len2); | ||||||
| 1040 | push(@action, $action); | ||||||
| 1041 | my Arithmetic::PaperAndPencil::Number $quotient; | ||||||
| 1042 | my Arithmetic::PaperAndPencil::Number $rem; | ||||||
| 1043 | ($quotient, $rem) = $self->_embedded_div(l_dd => 0, c_dd => $len1 , dividend => $dividend | ||||||
| 1044 | , l_dr => 0, c_dr => $len1 + $len2, divisor => $divisor | ||||||
| 1045 | , l_qu => 1, c_qu => $len1 + 1 | ||||||
| 1046 | , basic_level => 0, type => $type, mult_and_sub => $mult_and_sub, mult_cache => \%div_cache | ||||||
| 1047 | , stand_alone => 1 | ||||||
| 1048 | ); | ||||||
| 1049 | $action[-1]->set_level(0); | ||||||
| 1050 | if ($result eq 'quotient' ) { return $quotient; } | ||||||
| 1051 | elsif ($result eq 'remainder') { return $rem; } | ||||||
| 1052 | elsif ($result eq 'both' ) { return ( $quotient, $rem); } | ||||||
| 1053 | } | ||||||
| 1054 | if ($type eq 'boat') { | ||||||
| 1055 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'WRI00', w1val => $dividend->value . '{' | ||||||
| 1056 | , w1l => 0, w1c => $len1 + 1); | ||||||
| 1057 | push(@action, $action); | ||||||
| 1058 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'DRA02', w1l => 0, w1c => 1 | ||||||
| 1059 | , w2l => 0, w2c => $len1); | ||||||
| 1060 | |||||||
| 1061 | push(@action, $action); | ||||||
| 1062 | |||||||
| 1063 | # arrays of line numbers per column | ||||||
| 1064 | my @lines_below = ( 1) x ($len1 + 1); | ||||||
| 1065 | my @lines_above = (-1) x ($len1 + 1); | ||||||
| 1066 | $self->_push_below($divisor, $col_r, \@lines_below); | ||||||
| 1067 | |||||||
| 1068 | $col_q++; | ||||||
| 1069 | my $quotient = ''; | ||||||
| 1070 | my $rem = ''; | ||||||
| 1071 | my Arithmetic::PaperAndPencil::Number $part_dvr1 = $divisor->carry($delta); # single-digit divisor to compute the quotient first candidate | ||||||
| 1072 | my $part_dvd = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($dividend->value, 0, $col_r)); | ||||||
| 1073 | |||||||
| 1074 | while ($col_r <= $len1) { | ||||||
| 1075 | my Arithmetic::PaperAndPencil::Number $part_dvd1 = $part_dvd->carry($delta); # single-digit dividend or 2-digit dividend to compute the quotient first candidate | ||||||
| 1076 | my Arithmetic::PaperAndPencil::Number $theo_quo = $part_dvd1 / $part_dvr1; # theoretical quotient first candidate | ||||||
| 1077 | my Arithmetic::PaperAndPencil::Number $act_quo; # actual quotient first candidate | ||||||
| 1078 | $rem = ''; | ||||||
| 1079 | my $label; | ||||||
| 1080 | if ($part_dvd < $divisor) { | ||||||
| 1081 | $theo_quo = $zero; | ||||||
| 1082 | $act_quo = $zero; | ||||||
| 1083 | } | ||||||
| 1084 | else { | ||||||
| 1085 | my $dig = max( grep { $div_cache{$_} <= $part_dvd } keys(%div_cache)); | ||||||
| 1086 | $act_quo = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $dig); | ||||||
| 1087 | $label = 'DIV03'; | ||||||
| 1088 | } | ||||||
| 1089 | if ($theo_quo->value eq '0') { | ||||||
| 1090 | # cannot flag $part_dvd and $divisor as read, because there are not on a single line. | ||||||
| 1091 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DIV01', val1 => $part_dvd->value | ||||||
| 1092 | , val2 => $divisor ->value | ||||||
| 1093 | , val3 => '0', w1l => 0, w1c => $col_q, w1val => '0'); | ||||||
| 1094 | push(@action, $action); | ||||||
| 1095 | # striking the useless divisor | ||||||
| 1096 | for my $i (0 .. $len2 - 1) { | ||||||
| 1097 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'WRI00' | ||||||
| 1098 | , r1l => $lines_below[$col_r - $i] - 1, r1c => $col_r - $i, r1val => substr($divisor->value, -$i - 1, 1), r1str => 1); | ||||||
| 1099 | push(@action, $action); | ||||||
| 1100 | } | ||||||
| 1101 | $rem = $part_dvd->value; | ||||||
| 1102 | $quotient .= '0'; | ||||||
| 1103 | ++$col_q; | ||||||
| 1104 | ++$col_r; | ||||||
| 1105 | if ($col_r <= $len1) { | ||||||
| 1106 | $self->_push_below($divisor, $col_r, \@lines_below); | ||||||
| 1107 | } | ||||||
| 1108 | $part_dvd = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $rem . substr($dividend->value, $col_r - 1, 1)); | ||||||
| 1109 | next; | ||||||
| 1110 | } | ||||||
| 1111 | elsif ($theo_quo->value eq $act_quo->value) { | ||||||
| 1112 | # cannot flag $part_dvd and $divisor as read, because there are not on a single line. | ||||||
| 1113 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DIV01', val1 => $part_dvd1->value | ||||||
| 1114 | , val2 => $part_dvr1->value | ||||||
| 1115 | , val3 => $theo_quo ->value | ||||||
| 1116 | , w1l => 0, w1c => $col_q, w1val => $act_quo ->value); | ||||||
| 1117 | push(@action, $action); | ||||||
| 1118 | } | ||||||
| 1119 | else { | ||||||
| 1120 | # cannot flag $part_dvd and $divisor as read, because there are not on a single line. | ||||||
| 1121 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'DIV01', val1 => $part_dvd1->value | ||||||
| 1122 | , val2 => $part_dvr1->value | ||||||
| 1123 | , val3 => $theo_quo ->value); | ||||||
| 1124 | push(@action, $action); | ||||||
| 1125 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => $label | ||||||
| 1126 | , val1 => $act_quo->value, w1l => 0, w1c => $col_q, w1val => $act_quo->value); | ||||||
| 1127 | push(@action, $action); | ||||||
| 1128 | } | ||||||
| 1129 | my $carry = '0'; | ||||||
| 1130 | for my $i (0 .. $divisor->chars - 1) { | ||||||
| 1131 | my $divisor_digit = substr($divisor->value, - $i - 1, 1); | ||||||
| 1132 | my $temp = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $divisor_digit); | ||||||
| 1133 | $temp *= $act_quo; | ||||||
| 1134 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'MUL01' , val3 => $temp->value | ||||||
| 1135 | , r1l => 1 , r1c => $col_q , r1val => $act_quo->value , val1 => $act_quo->value | ||||||
| 1136 | , r2l => $lines_below[$col_r - $i] - 1, r2c => $col_r - $i, r2val => $divisor_digit, r2str => 1, val2 => $divisor_digit | ||||||
| 1137 | ); | ||||||
| 1138 | push(@action, $action); | ||||||
| 1139 | if ($carry ne '0') { | ||||||
| 1140 | $temp += Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $carry); | ||||||
| 1141 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'ADD02', val1 => $carry, val2 => $temp->value); | ||||||
| 1142 | push(@action, $action); | ||||||
| 1143 | } | ||||||
| 1144 | my $dividend_digit = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($part_dvd->value, - $i - 1, 1)); | ||||||
| 1145 | my Arithmetic::PaperAndPencil::Number $adjusted_dividend; | ||||||
| 1146 | my Arithmetic::PaperAndPencil::Number $rem_digit; | ||||||
| 1147 | ($adjusted_dividend, $rem_digit) = adjust_sub($dividend_digit, $temp); | ||||||
| 1148 | if ($i == $divisor->chars - 1) { | ||||||
| 1149 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'SUB02' | ||||||
| 1150 | , val1 => $rem_digit->value, val2 => $adjusted_dividend->value | ||||||
| 1151 | , r1l => $lines_above[$col_r - $i] + 1, r1c => $col_r - $i, r1val => $adjusted_dividend->value, r1str => 1 | ||||||
| 1152 | ); | ||||||
| 1153 | push(@action, $action); | ||||||
| 1154 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'WRI04', val1 => $rem_digit->value | ||||||
| 1155 | , w1l => $lines_above[$col_r - $i]--, w1c => $col_r - $i, w1val => $rem_digit->value | ||||||
| 1156 | ); | ||||||
| 1157 | push(@action, $action); | ||||||
| 1158 | $rem = $rem_digit->value . $rem; | ||||||
| 1159 | } | ||||||
| 1160 | else { | ||||||
| 1161 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'SUB02' | ||||||
| 1162 | , val1 => $rem_digit->value , val2 => $adjusted_dividend->value | ||||||
| 1163 | , r1l => $lines_above[$col_r - $i] + 1, r1c => $col_r - $i, r1val => $adjusted_dividend->value, r1str => 1 | ||||||
| 1164 | ); | ||||||
| 1165 | push(@action, $action); | ||||||
| 1166 | my $label = 'WRI02'; | ||||||
| 1167 | if ($adjusted_dividend->carry->value eq '0') { | ||||||
| 1168 | $label = 'WRI03'; | ||||||
| 1169 | } | ||||||
| 1170 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => $label, val1 => $rem_digit->value, val2 => $adjusted_dividend->carry->value | ||||||
| 1171 | , w1l => $lines_above[$col_r - $i]--, w1c => $col_r - $i, w1val => $rem_digit->value | ||||||
| 1172 | ); | ||||||
| 1173 | push(@action, $action); | ||||||
| 1174 | $rem = $rem_digit->value . $rem; | ||||||
| 1175 | $carry = $adjusted_dividend->carry->value; | ||||||
| 1176 | } | ||||||
| 1177 | } | ||||||
| 1178 | $action[-1]->set_level(4); | ||||||
| 1179 | $quotient .= $act_quo->value; | ||||||
| 1180 | ++$col_q; | ||||||
| 1181 | ++$col_r; | ||||||
| 1182 | if ( $col_r <= $len1) { | ||||||
| 1183 | $self->_push_below($divisor, $col_r, \@lines_below); | ||||||
| 1184 | } | ||||||
| 1185 | $part_dvd = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $rem . substr($dividend->value, $col_r - 1, 1)); | ||||||
| 1186 | } | ||||||
| 1187 | |||||||
| 1188 | $action[-1]->set_level(0); | ||||||
| 1189 | if ($result eq 'quotient' ) { return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $quotient); } | ||||||
| 1190 | elsif ($result eq 'remainder') { return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $rem); } | ||||||
| 1191 | elsif ($result eq 'both' ) { return ( Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $quotient) | ||||||
| 1192 | , Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $rem)); } | ||||||
| 1193 | } | ||||||
| 1194 | |||||||
| 1195 | } | ||||||
| 1196 | |||||||
| 1197 | method square_root($number, %param) { | ||||||
| 1198 | my $mult_and_sub = $param{mult_and_sub} // 'combined'; | ||||||
| 1199 | |||||||
| 1200 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 1201 | my $radix = $number->radix; | ||||||
| 1202 | |||||||
| 1203 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => "TIT13", val1 => $number->value, val2 => $radix); | ||||||
| 1204 | push(@action, $action); | ||||||
| 1205 | |||||||
| 1206 | # set-up | ||||||
| 1207 | my $nb_dig = ceil($number->chars / 2); # number of digits of the square root | ||||||
| 1208 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'WRI00', w1l => 0, w1c => 0, w1val => $number->value); | ||||||
| 1209 | push(@action, $action); | ||||||
| 1210 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'DRA01', w1l => 0, w1c => 0, w2l => 2, w2c => 0); | ||||||
| 1211 | push(@action, $action); | ||||||
| 1212 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'DRA02', w1l => 0, w1c => 1, w2l => 0, w2c => $nb_dig); | ||||||
| 1213 | push(@action, $action); | ||||||
| 1214 | $action = Arithmetic::PaperAndPencil::Action->new(level => 2, label => 'WRI00', w1l => 0, w1c => $nb_dig, w1val => '.' x $nb_dig); | ||||||
| 1215 | push(@action, $action); | ||||||
| 1216 | |||||||
| 1217 | # first phase, square root proper | ||||||
| 1218 | my $col_first; | ||||||
| 1219 | my $remainder = ''; | ||||||
| 1220 | my Arithmetic::PaperAndPencil::Number $partial_number = $number->carry(2 * ($nb_dig - 1)); | ||||||
| 1221 | my Arithmetic::PaperAndPencil::Number $partial_root = $partial_number->square_root; | ||||||
| 1222 | my $root = $partial_root->value; | ||||||
| 1223 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'SQR01', val1 => $partial_number->value, val2 => $root | ||||||
| 1224 | , r1l => 0, r1c => -2 * ($nb_dig - 1), r1val => $partial_number->value | ||||||
| 1225 | , w1l => 0, w1c => 1 , w1val => $root | ||||||
| 1226 | ); | ||||||
| 1227 | push(@action, $action); | ||||||
| 1228 | my Arithmetic::PaperAndPencil::Number $partial_square = $partial_root * $partial_root; | ||||||
| 1229 | if ($mult_and_sub eq 'combined') { | ||||||
| 1230 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'MUL01', val1 => $root, val2 => $root, val3 => $partial_square->value); | ||||||
| 1231 | push(@action, $action); | ||||||
| 1232 | my ($x, $y) = adjust_sub($partial_number->unit, $partial_square); | ||||||
| 1233 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'SUB02', val1 => $y->value | ||||||
| 1234 | , val2 => $x->value); | ||||||
| 1235 | push(@action, $action); | ||||||
| 1236 | if ($x->carry->value eq '0') { | ||||||
| 1237 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI03', val1 => $y->value | ||||||
| 1238 | , w1l => 1, w1c => -2 * ($nb_dig - 1) , w1val => $y->value | ||||||
| 1239 | ); | ||||||
| 1240 | push(@action, $action); | ||||||
| 1241 | $remainder = $y->value; | ||||||
| 1242 | } | ||||||
| 1243 | else { | ||||||
| 1244 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI02', val1 => $y->value, val2 => $x->carry->value | ||||||
| 1245 | , w1l => 1, w1c => -2 * ($nb_dig - 1) , w1val => $y->value | ||||||
| 1246 | ); | ||||||
| 1247 | push(@action, $action); | ||||||
| 1248 | my ($z, $t) = adjust_sub($partial_number->carry, $x->carry); | ||||||
| 1249 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'SUB01' | ||||||
| 1250 | , val1 => $x->carry->value , val2 => $t->value, val3 => $z->value | ||||||
| 1251 | , w1l => 1, w1c => -2 * $nb_dig + 1, w1val => $t->value); | ||||||
| 1252 | push(@action, $action); | ||||||
| 1253 | $remainder = $t->value . $y->value; | ||||||
| 1254 | } | ||||||
| 1255 | } | ||||||
| 1256 | else { | ||||||
| 1257 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'MUL01' | ||||||
| 1258 | , val1 => $root, val2 => $root , val3 => $partial_square->value | ||||||
| 1259 | , w1l => 1, w1c => -2 * ($nb_dig - 1), w1val => $partial_square->value); | ||||||
| 1260 | push(@action, $action); | ||||||
| 1261 | $remainder = $self->_embedded_sub(basic_level => 0, l_hi => 0, c_hi => -2 * ($nb_dig - 1), high => $partial_number | ||||||
| 1262 | , l_lo => 1, c_lo => -2 * ($nb_dig - 1), low => $partial_square | ||||||
| 1263 | , l_re => 2, c_re => -2 * ($nb_dig - 1)); | ||||||
| 1264 | } | ||||||
| 1265 | my Arithmetic::PaperAndPencil::Number $divisor = $partial_root + $partial_root; | ||||||
| 1266 | $col_first = $divisor->chars; | ||||||
| 1267 | $action = Arithmetic::PaperAndPencil::Action->new(level => 3, label => 'ADD01' | ||||||
| 1268 | , val1 => $partial_root->value , val2 => $partial_root->value, val3 => $divisor->value | ||||||
| 1269 | , r1l => 0, r1c => 1 , r1val => $partial_root->value | ||||||
| 1270 | , w1l => 1, w1c => $col_first, w1val => $divisor->value | ||||||
| 1271 | ); | ||||||
| 1272 | push(@action, $action); | ||||||
| 1273 | |||||||
| 1274 | my $zero = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => 0); | ||||||
| 1275 | my $one = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => 1); | ||||||
| 1276 | my Arithmetic::PaperAndPencil::Number $divisor1; | ||||||
| 1277 | |||||||
| 1278 | # next phase, division | ||||||
| 1279 | my $bot = 2; # bottom line number of the vertical line | ||||||
| 1280 | my $line_rem = 1; # line number of the partial remainder or partial dividend | ||||||
| 1281 | my $line_div = 1; # line number of the divisor | ||||||
| 1282 | if ($mult_and_sub eq 'separate') { | ||||||
| 1283 | $line_rem = 2; | ||||||
| 1284 | } | ||||||
| 1285 | for my $i (1 .. $nb_dig - 1) { | ||||||
| 1286 | my $pos = 2 * ($nb_dig - $i); | ||||||
| 1287 | my $two_digits = substr($number->value, - $pos, 2); | ||||||
| 1288 | $action = Arithmetic::PaperAndPencil::Action->new(level => 3 , label => 'DIV04' , val1 => $two_digits | ||||||
| 1289 | , r1l => 0 , r1c => 2 - $pos , r1val => $two_digits | ||||||
| 1290 | , w1l => $line_rem, w1c => 2 - $pos , w1val => $two_digits | ||||||
| 1291 | ); | ||||||
| 1292 | push(@action, $action); | ||||||
| 1293 | $remainder .= $two_digits; | ||||||
| 1294 | |||||||
| 1295 | $partial_number = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $remainder); | ||||||
| 1296 | my Arithmetic::PaperAndPencil::Number $part_dvr1 = $divisor->carry($divisor->chars - 1); # single-digit divisor to compute the quotient first candidate | ||||||
| 1297 | my Arithmetic::PaperAndPencil::Number $part_dvd1 = $partial_number->carry($i + $col_first - 1); # single-digit dividend or 2-digit dividend to compute the quotient first candidate | ||||||
| 1298 | my Arithmetic::PaperAndPencil::Number $theo_quo = $part_dvd1 / $part_dvr1; # theoretical quotient first candidate | ||||||
| 1299 | my Arithmetic::PaperAndPencil::Number $act_quo; # actual quotient first candidate and then all successive candidates | ||||||
| 1300 | my $label; | ||||||
| 1301 | if ($partial_number <= $divisor) { | ||||||
| 1302 | $theo_quo = $zero; | ||||||
| 1303 | $act_quo = $zero; | ||||||
| 1304 | $divisor1 = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $divisor->value . '0'); | ||||||
| 1305 | } | ||||||
| 1306 | elsif ($theo_quo->chars == 2) { | ||||||
| 1307 | $act_quo = max_unit($radix); | ||||||
| 1308 | $label = 'DIV02'; | ||||||
| 1309 | } | ||||||
| 1310 | else { | ||||||
| 1311 | $act_quo = $theo_quo; | ||||||
| 1312 | } | ||||||
| 1313 | my $too_much = 1; # we must loop with the next lower candidate | ||||||
| 1314 | if ($theo_quo->value eq '0') { | ||||||
| 1315 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DIV01' | ||||||
| 1316 | , val1 => $part_dvd1->value, r1l => $line_rem, r1c => - $pos , r1val => $part_dvd1->value | ||||||
| 1317 | , val2 => $part_dvr1->value, r2l => $line_div, r2c => 0 , r2val => $part_dvr1->value | ||||||
| 1318 | , val3 => '0' , w1l => $line_div, w1c => $i + $col_first, w1val => '0'); | ||||||
| 1319 | push(@action, $action); | ||||||
| 1320 | $too_much = 0; # no need to loop on candidate values, no need to execute the mult_and_sub routine | ||||||
| 1321 | $remainder = $partial_number->value; | ||||||
| 1322 | } | ||||||
| 1323 | elsif ($theo_quo->value eq $act_quo->value) { | ||||||
| 1324 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DIV01' | ||||||
| 1325 | , val1 => $part_dvd1->value, r1l => $line_rem , r1c => - $pos , r1val => $part_dvd1->value | ||||||
| 1326 | , val2 => $part_dvr1->value, r2l => $line_div , r2c => 0 , r2val => $part_dvr1->value | ||||||
| 1327 | , val3 => $theo_quo->value , w1l => $line_div , w1c => $i + $col_first, w1val => $act_quo ->value | ||||||
| 1328 | , w2l => $line_div + 1, w2c => $i + $col_first, w2val => $act_quo ->value); | ||||||
| 1329 | push(@action, $action); | ||||||
| 1330 | } | ||||||
| 1331 | else { | ||||||
| 1332 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'DIV01' | ||||||
| 1333 | , val1 => $part_dvd1->value, val2 => $part_dvr1->value, val3 => $theo_quo ->value | ||||||
| 1334 | , r1l => $line_rem , r1c => - $pos , r1val => $part_dvd1->value | ||||||
| 1335 | , r2l => $line_div , r2c => 0 , r2val => $part_dvr1->value); | ||||||
| 1336 | push(@action, $action); | ||||||
| 1337 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => $label | ||||||
| 1338 | , val1 => $act_quo->value, w1l => $line_div, w1c => $i + $col_first, w1val => $act_quo->value | ||||||
| 1339 | , w2l => $line_div + 1 , w2c => $i + $col_first , w2val => $act_quo->value); | ||||||
| 1340 | push(@action, $action); | ||||||
| 1341 | } | ||||||
| 1342 | my $rem; | ||||||
| 1343 | my $l_re; | ||||||
| 1344 | while ($too_much) { | ||||||
| 1345 | if ($mult_and_sub eq 'separate') { | ||||||
| 1346 | $l_re = $line_rem + 2; | ||||||
| 1347 | } | ||||||
| 1348 | else { | ||||||
| 1349 | $l_re = $line_rem + 1; | ||||||
| 1350 | } | ||||||
| 1351 | if ($bot < $l_re) { | ||||||
| 1352 | $bot = $l_re; | ||||||
| 1353 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DRA01', w1l => 0, w1c => 0, w2l => $bot, w2c => 0); | ||||||
| 1354 | push(@action, $action); | ||||||
| 1355 | } | ||||||
| 1356 | $divisor1 = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $divisor->value . $act_quo->value); | ||||||
| 1357 | ($too_much, $rem) = $self->_mult_and_sub(l_dd => $line_rem , c_dd => 2 - 2 * ($nb_dig - $i), dividend => $partial_number | ||||||
| 1358 | , l_dr => $line_div , c_dr => $i + $col_first , divisor => $divisor1 | ||||||
| 1359 | , l_qu => $line_div + 1, c_qu => $i + $col_first , quotient => $act_quo | ||||||
| 1360 | , l_re => $l_re , c_re => 2 - 2 * ($nb_dig - $i), basic_level => 0 | ||||||
| 1361 | , l_pr => $line_rem + 1, c_pr => 2 - 2 * ($nb_dig - $i), mult_and_sub => $mult_and_sub); | ||||||
| 1362 | if ($too_much) { | ||||||
| 1363 | $action[-1]->set_level(4); | ||||||
| 1364 | $act_quo -= $one; | ||||||
| 1365 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'ERA01' | ||||||
| 1366 | , w1l => $line_rem + 1, w1c => 0 | ||||||
| 1367 | , w2l => $line_rem + 1, w2c => 1 - $number->chars); | ||||||
| 1368 | push(@action, $action); | ||||||
| 1369 | $action = Arithmetic::PaperAndPencil::Action->new(level => 4, label => 'DIV02', val1 => $act_quo->value | ||||||
| 1370 | , w1l => $line_div , w1c => $i + $col_first, w1val => $act_quo->value | ||||||
| 1371 | , w2l => $line_div + 1, w2c => $i + $col_first, w2val => $act_quo->value); | ||||||
| 1372 | push(@action, $action); | ||||||
| 1373 | } | ||||||
| 1374 | } | ||||||
| 1375 | $action[-1]->set_level(4); | ||||||
| 1376 | |||||||
| 1377 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'WRI04', val1 => $act_quo->value | ||||||
| 1378 | , w1l => 0, w1c => $i + 1 , w1val => $act_quo->value); | ||||||
| 1379 | push(@action, $action); | ||||||
| 1380 | $root .= $act_quo->value; | ||||||
| 1381 | |||||||
| 1382 | $divisor = $divisor1 + $act_quo; | ||||||
| 1383 | if ($act_quo->value eq '0') { | ||||||
| 1384 | $action = Arithmetic::PaperAndPencil::Action->new(level => 3, label => 'ERA01' | ||||||
| 1385 | , w1l => $line_div + 1, w1c => $i + $col_first | ||||||
| 1386 | , w2l => $line_div + 1, w2c => $i + $col_first); | ||||||
| 1387 | push(@action, $action); | ||||||
| 1388 | } | ||||||
| 1389 | elsif ($i < $nb_dig - 1) { | ||||||
| 1390 | $remainder = $rem; | ||||||
| 1391 | $line_rem = $l_re; | ||||||
| 1392 | if ($bot < $line_div + 3) { | ||||||
| 1393 | $bot = $line_div + 3; | ||||||
| 1394 | } | ||||||
| 1395 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'DRA01', w1l => 0, w1c => 0, w2l => $bot, w2c => 0); | ||||||
| 1396 | push(@action, $action); | ||||||
| 1397 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'DRA02' | ||||||
| 1398 | , w1l => $line_div + 1, w1c => 1 | ||||||
| 1399 | , w2l => $line_div + 1, w2c => $divisor->chars); | ||||||
| 1400 | push(@action, $action); | ||||||
| 1401 | $action = Arithmetic::PaperAndPencil::Action->new(level => 3, label => 'ADD01' | ||||||
| 1402 | , r1l => $line_div , r1c => $i + $col_first, r1val => $divisor1->value, val1 => $divisor1->value | ||||||
| 1403 | , r2l => $line_div + 1, r2c => $i + $col_first, r2val => $act_quo ->value, val2 => $act_quo ->value | ||||||
| 1404 | , w1l => $line_div + 2, w1c => $i + $col_first, w1val => $divisor ->value, val3 => $divisor ->value); | ||||||
| 1405 | push(@action, $action); | ||||||
| 1406 | $line_div += 2; | ||||||
| 1407 | } | ||||||
| 1408 | } | ||||||
| 1409 | |||||||
| 1410 | $action[-1]->set_level(0); | ||||||
| 1411 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $root); | ||||||
| 1412 | } | ||||||
| 1413 | |||||||
| 1414 | method conversion(%param) { | ||||||
| 1415 | my $number = $param{number}; | ||||||
| 1416 | my $radix = $param{radix}; | ||||||
| 1417 | my $nb_op = $param{nb_op} // 0; | ||||||
| 1418 | my $type = $param{type} // 'mult'; | ||||||
| 1419 | my $div_type = $param{div_type} // 'std'; | ||||||
| 1420 | my $mult_and_sub = $param{mult_and_sub} // 'combined'; | ||||||
| 1421 | if ($radix < 2 or $radix > 36) { | ||||||
| 1422 | die "Radix should be between 2 and 36, instead of $radix"; | ||||||
| 1423 | } | ||||||
| 1424 | my $title = ''; | ||||||
| 1425 | if ($type eq 'mult' ) { $title = 'TIT14' ; } | ||||||
| 1426 | elsif ($type eq 'Horner') { $title = 'TIT14' ; } | ||||||
| 1427 | elsif ($type eq 'div' ) { $title = 'TIT16' ; } | ||||||
| 1428 | else { die "Conversion type '$type' unknown, should be 'mult', 'Horner' or 'div'"; } | ||||||
| 1429 | if ($type eq 'div' and $div_type ne 'std' | ||||||
| 1430 | and $div_type ne 'cheating' | ||||||
| 1431 | and $div_type ne 'prepared') { | ||||||
| 1432 | die "Division type '$div_type' unknown, should be 'std', 'cheating' or 'prepared'"; | ||||||
| 1433 | } | ||||||
| 1434 | if ($type eq 'div' and $mult_and_sub ne 'combined' | ||||||
| 1435 | and $mult_and_sub ne 'separate') { | ||||||
| 1436 | die "Mult and sub type '$mult_and_sub' unknown, should be 'combined' or 'separate'"; | ||||||
| 1437 | } | ||||||
| 1438 | if ($type eq 'div' and $div_type eq 'std') { | ||||||
| 1439 | $mult_and_sub = 'combined'; | ||||||
| 1440 | } | ||||||
| 1441 | if ($type eq 'div' and $div_type eq 'prepared') { | ||||||
| 1442 | $mult_and_sub = 'separate'; | ||||||
| 1443 | } | ||||||
| 1444 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 1445 | my $old_radix = $number->radix; | ||||||
| 1446 | |||||||
| 1447 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => $title, val1 => $number->value, val2 => $old_radix, val3 => $radix); | ||||||
| 1448 | push(@action, $action); | ||||||
| 1449 | |||||||
| 1450 | if ($radix == $old_radix or ($number->chars == 1 && $old_radix <= $radix)) { | ||||||
| 1451 | $action = Arithmetic::PaperAndPencil::Action->new(level => 0, label => "CNV01", val1 => $number->value, val2 => $old_radix, val3 => $radix); | ||||||
| 1452 | push(@action, $action); | ||||||
| 1453 | return $number; | ||||||
| 1454 | } | ||||||
| 1455 | my %conv_cache; | ||||||
| 1456 | my Arithmetic::PaperAndPencil::Number $new_radix; | ||||||
| 1457 | my $zero = Arithmetic::PaperAndPencil::Number->new(radix => $old_radix, value => '0'); | ||||||
| 1458 | my %mult_cache; | ||||||
| 1459 | if ($type eq 'mult' || $type eq 'Horner') { | ||||||
| 1460 | $self->_prep_conv($old_radix, $radix, \%conv_cache, basic_level => 2); | ||||||
| 1461 | } | ||||||
| 1462 | else { | ||||||
| 1463 | %mult_cache = (0 => $zero, 1 => $new_radix); | ||||||
| 1464 | my %tmp_cache; | ||||||
| 1465 | $self->_prep_conv($radix, $old_radix, \%tmp_cache, basic_level => 2); | ||||||
| 1466 | $new_radix = $tmp_cache{10}; | ||||||
| 1467 | for my $new (keys %tmp_cache) { | ||||||
| 1468 | my $old = $tmp_cache{$new}; | ||||||
| 1469 | $conv_cache{$old->value} = $new; | ||||||
| 1470 | } | ||||||
| 1471 | if ($div_type eq 'prepared') { | ||||||
| 1472 | my %tmp_cache; | ||||||
| 1473 | $self->_preparation(factor => $new_radix, limit => 'Z', cache => \%mult_cache, basic_level => 2); | ||||||
| 1474 | $action[-2]->set_level(1); # * - 2 to update the action **before** action NXP01 | ||||||
| 1475 | # the actual limit will be '9' for radix 10, 'F' for radix 16, etc. But 'Z' will give the same result | ||||||
| 1476 | } | ||||||
| 1477 | if ($div_type eq 'cheating') { | ||||||
| 1478 | my $dummy = Arithmetic::PaperAndPencil->new; | ||||||
| 1479 | $dummy->_preparation(factor => $new_radix, limit => 'Z', cache => \%mult_cache); | ||||||
| 1480 | } | ||||||
| 1481 | } | ||||||
| 1482 | |||||||
| 1483 | my Arithmetic::PaperAndPencil::Number $result; | ||||||
| 1484 | if ($type eq 'mult' || $type eq 'Horner') { | ||||||
| 1485 | my $old_digit = substr($number->value, 0,1); | ||||||
| 1486 | $result = $conv_cache{$old_digit}; | ||||||
| 1487 | my $line = 1; | ||||||
| 1488 | my $op = 0; | ||||||
| 1489 | my $width = $conv_cache{10}->chars; | ||||||
| 1490 | $action = Arithmetic::PaperAndPencil::Action->new(level => 3, label => "CNV02", val1 => $old_digit, val2 => $result->value | ||||||
| 1491 | , w1l => $line , w1c => 0 , w1val => $result->value); | ||||||
| 1492 | push(@action, $action); | ||||||
| 1493 | for my $op1 (1 .. $number->chars - 1) { | ||||||
| 1494 | my $old_digit = substr($number->value, $op1, 1); | ||||||
| 1495 | # multiplication | ||||||
| 1496 | my $pos_sign = max($conv_cache{10}->chars, $result->chars); | ||||||
| 1497 | ++$line; | ||||||
| 1498 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'WRI00' | ||||||
| 1499 | , w1l => $line, w1c => 0 , w1val => $conv_cache{10}->value | ||||||
| 1500 | , w2l => $line, w2c => - $pos_sign - 1, w2val => '×'); | ||||||
| 1501 | push(@action, $action); | ||||||
| 1502 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => 'DRA02', w1l => $line, w1c => 0 | ||||||
| 1503 | , w2l => $line, w2c => - $width); | ||||||
| 1504 | push(@action, $action); | ||||||
| 1505 | if ($conv_cache{10}->chars == 1) { | ||||||
| 1506 | $result = $self->_simple_mult(basic_level => 2 | ||||||
| 1507 | , l_md => $line - 1, c_md => 0, multiplicand => $result | ||||||
| 1508 | , l_mr => $line , c_mr => 0, multiplier => $conv_cache{10} | ||||||
| 1509 | , l_pd => $line + 1, c_pd => 0); | ||||||
| 1510 | $line++; | ||||||
| 1511 | } | ||||||
| 1512 | else { | ||||||
| 1513 | my %dummy_cache; | ||||||
| 1514 | $result = $self->_adv_mult(basic_level => 2 | ||||||
| 1515 | , l_md => $line - 1, c_md => 0, multiplicand => $result | ||||||
| 1516 | , l_mr => $line , c_mr => 0, multiplier => $conv_cache{10} | ||||||
| 1517 | , l_pd => $line + 1, c_pd => 0, cache => \%dummy_cache); | ||||||
| 1518 | $line += $conv_cache{10}->chars + 1; | ||||||
| 1519 | } | ||||||
| 1520 | if ($width <= $result->chars) { | ||||||
| 1521 | $width = $result->chars; | ||||||
| 1522 | } | ||||||
| 1523 | # addition | ||||||
| 1524 | my $added = $conv_cache{$old_digit}; | ||||||
| 1525 | if ($added->value eq '0') { | ||||||
| 1526 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => "CNV02", val1 => '0', val2 => '0'); | ||||||
| 1527 | push(@action, $action); | ||||||
| 1528 | } | ||||||
| 1529 | else { | ||||||
| 1530 | $pos_sign = max( $conv_cache{10}->chars, $width); | ||||||
| 1531 | ++$line; | ||||||
| 1532 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => "CNV02" | ||||||
| 1533 | , val1 => $old_digit , val2 => $added->value | ||||||
| 1534 | , w1l => $line, w1c => 0 , w1val => $added->value | ||||||
| 1535 | , w2l => $line, w2c => - $pos_sign - 1, w2val => '+'); | ||||||
| 1536 | push(@action, $action); | ||||||
| 1537 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5 , label => 'DRA02' | ||||||
| 1538 | , w1l => $line, w1c => 0, w2l => $line, w2c => - $width); | ||||||
| 1539 | push(@action, $action); | ||||||
| 1540 | my @added; | ||||||
| 1541 | my @total; | ||||||
| 1542 | my @digit_list = reverse(split('', $result->value)); | ||||||
| 1543 | for my $i (0 .. $#digit_list) { | ||||||
| 1544 | my $digit = $digit_list[$i]; | ||||||
| 1545 | $added[$i][0] = { lin => $line - 1, col => - $i, val => $digit}; | ||||||
| 1546 | $total[$i] = { lin => $line + 1, col => - $i}; | ||||||
| 1547 | } | ||||||
| 1548 | @digit_list = reverse(split('', $added->value)); | ||||||
| 1549 | for my $i (0 .. $#digit_list) { | ||||||
| 1550 | my $digit = $digit_list[$i]; | ||||||
| 1551 | $added[$i][1] = { lin => $line , col => - $i, val => $digit}; | ||||||
| 1552 | $total[$i] = { lin => $line + 1, col => - $i}; | ||||||
| 1553 | } | ||||||
| 1554 | $result = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $self->_adding(\@added, \@total, 2, $radix)); | ||||||
| 1555 | $line++; | ||||||
| 1556 | } | ||||||
| 1557 | $action[-1]->set_level(3); | ||||||
| 1558 | # next step | ||||||
| 1559 | $op++; | ||||||
| 1560 | if ($op == $nb_op && $op1 != $number->chars - 1) { | ||||||
| 1561 | $action[-1]->set_level(1); | ||||||
| 1562 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'NXP01'); | ||||||
| 1563 | push(@action, $action); | ||||||
| 1564 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'CNV03' | ||||||
| 1565 | , val1 => $result->value, val2 => substr($number->value, $op1 + 1) | ||||||
| 1566 | , w1l => 1, w1c => 0 , w1val => $result->value); | ||||||
| 1567 | push(@action, $action); | ||||||
| 1568 | $op = 0; | ||||||
| 1569 | $line = 1; | ||||||
| 1570 | } | ||||||
| 1571 | if ($width <= $result->chars) { | ||||||
| 1572 | $width = $result->chars; | ||||||
| 1573 | } | ||||||
| 1574 | } | ||||||
| 1575 | } | ||||||
| 1576 | else { | ||||||
| 1577 | my $op = 0; | ||||||
| 1578 | my $l_dd = 1; | ||||||
| 1579 | my $c_dd = 0; | ||||||
| 1580 | my $res = ''; | ||||||
| 1581 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'WRI00', w1l => $l_dd, w1c => $c_dd, w1val => $number->value); | ||||||
| 1582 | push(@action, $action); | ||||||
| 1583 | my Arithmetic::PaperAndPencil::Number $x; | ||||||
| 1584 | my Arithmetic::PaperAndPencil::Number $y; | ||||||
| 1585 | while ($new_radix <= $number) { | ||||||
| 1586 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'DRA02' | ||||||
| 1587 | , w1l => $l_dd, w1c => $c_dd + 1 | ||||||
| 1588 | , w2l => $l_dd, w2c => $c_dd + $new_radix->chars); | ||||||
| 1589 | push(@action, $action); | ||||||
| 1590 | ($x, $y) = $self->_embedded_div(l_dd => $l_dd , c_dd => $c_dd , dividend => $number | ||||||
| 1591 | , l_dr => $l_dd , c_dr => $c_dd + $new_radix->chars, divisor => $new_radix | ||||||
| 1592 | , l_qu => $l_dd + 1, c_qu => $c_dd + 1 | ||||||
| 1593 | , basic_level => 3, type => $div_type, mult_and_sub => $mult_and_sub | ||||||
| 1594 | , mult_cache => \%mult_cache); | ||||||
| 1595 | $action[-1]->set_level(3); | ||||||
| 1596 | $res = $conv_cache{$y->value} . $res; | ||||||
| 1597 | $number = $x; | ||||||
| 1598 | $op++; | ||||||
| 1599 | $l_dd++; | ||||||
| 1600 | $c_dd += $number->chars; | ||||||
| 1601 | my $rewrite_dd = ''; | ||||||
| 1602 | if ($op == $nb_op && $new_radix <= $number) { | ||||||
| 1603 | $action[-1]->set_level(1); | ||||||
| 1604 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'NXP01'); | ||||||
| 1605 | push(@action, $action); | ||||||
| 1606 | $op = 0; | ||||||
| 1607 | $l_dd = 1; | ||||||
| 1608 | $c_dd = 0; | ||||||
| 1609 | $rewrite_dd = $number->value; | ||||||
| 1610 | } | ||||||
| 1611 | if ($new_radix <= $number) { | ||||||
| 1612 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9 , label => 'CNV03' | ||||||
| 1613 | , val1 => $res , val2 => $number->value | ||||||
| 1614 | , w1l => $l_dd, w1c => $c_dd, w1val => $rewrite_dd); | ||||||
| 1615 | push(@action, $action); | ||||||
| 1616 | } | ||||||
| 1617 | } | ||||||
| 1618 | $res = $conv_cache{$number->value} . $res; | ||||||
| 1619 | $action = Arithmetic::PaperAndPencil::Action->new(level => 0, label => 'CNV03', val1 => $res, val2 => '0'); | ||||||
| 1620 | push(@action, $action); | ||||||
| 1621 | $result = Arithmetic::PaperAndPencil::Number->new(value => $res, radix => $radix); | ||||||
| 1622 | } | ||||||
| 1623 | |||||||
| 1624 | $action[-1]->set_level(0); | ||||||
| 1625 | return $result; | ||||||
| 1626 | } | ||||||
| 1627 | |||||||
| 1628 | method gcd(%param) { | ||||||
| 1629 | my $first = $param{first}; | ||||||
| 1630 | my $second = $param{second}; | ||||||
| 1631 | my $div_type = $param{div_type} // 'std'; | ||||||
| 1632 | |||||||
| 1633 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 1634 | my $radix = $first->radix; | ||||||
| 1635 | if ($second->radix != $radix) { | ||||||
| 1636 | die "The two numbers have different bases: $radix != {$second->radix}"; | ||||||
| 1637 | } | ||||||
| 1638 | if (@action) { | ||||||
| 1639 | $action[-1]->set_level(0); | ||||||
| 1640 | } | ||||||
| 1641 | if ($first < $second) { | ||||||
| 1642 | ($first, $second) = ($second, $first); | ||||||
| 1643 | } | ||||||
| 1644 | my $title = ''; | ||||||
| 1645 | if ($div_type eq 'std' ) { $title = 'TIT17' ; } | ||||||
| 1646 | elsif ($div_type eq 'cheating') { $title = 'TIT18' ; } | ||||||
| 1647 | else { | ||||||
| 1648 | die "Division type '$div_type' unknown"; | ||||||
| 1649 | } | ||||||
| 1650 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9 | ||||||
| 1651 | , label => $title | ||||||
| 1652 | , val1 => $first->value | ||||||
| 1653 | , val2 => $second->value | ||||||
| 1654 | , val3 => $radix | ||||||
| 1655 | ); | ||||||
| 1656 | push(@action, $action); | ||||||
| 1657 | my Arithmetic::PaperAndPencil::Number $quo; | ||||||
| 1658 | my Arithmetic::PaperAndPencil::Number $rem; | ||||||
| 1659 | my %mult_cache; | ||||||
| 1660 | |||||||
| 1661 | # set-up | ||||||
| 1662 | my $len2 = $second->chars; | ||||||
| 1663 | my $l_dd = 0; | ||||||
| 1664 | my $c_dd = 0; | ||||||
| 1665 | my $l_dr = 0; | ||||||
| 1666 | my $c_dr = $len2; | ||||||
| 1667 | my $l_qu = -1; | ||||||
| 1668 | my $c_qu = 1; | ||||||
| 1669 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'WRI00', w1l => $l_dd, w1c => $c_dd, w1val => $first->value); | ||||||
| 1670 | push(@action, $action); | ||||||
| 1671 | |||||||
| 1672 | # computation | ||||||
| 1673 | while ($second->value ne '0') { | ||||||
| 1674 | if ($div_type eq 'cheating') { | ||||||
| 1675 | my Arithmetic::PaperAndPencil $dummy = Arithmetic::PaperAndPencil->new; | ||||||
| 1676 | $dummy->_preparation(factor => $second, limit => 'Z', cache => \%mult_cache); | ||||||
| 1677 | } | ||||||
| 1678 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'DRA02', w1l => $l_qu, w1c => $c_dr - $len2 + 1 | ||||||
| 1679 | , w2l => $l_qu, w2c => $c_dr); | ||||||
| 1680 | push(@action, $action); | ||||||
| 1681 | ($quo, $rem) = $self->_embedded_div(l_dd => $l_dd, c_dd => $c_dd, dividend => $first | ||||||
| 1682 | , l_dr => $l_dr, c_dr => $c_dr, divisor => $second | ||||||
| 1683 | , l_qu => $l_qu, c_qu => $c_qu | ||||||
| 1684 | , basic_level => 3, type => $div_type, mult_and_sub => 'combined' | ||||||
| 1685 | , mult_cache => \%mult_cache); | ||||||
| 1686 | $action[-1]->set_level(3); | ||||||
| 1687 | $first = $second; | ||||||
| 1688 | $second = $rem; | ||||||
| 1689 | $len2 = $rem->chars; | ||||||
| 1690 | $c_dd = $c_dr; | ||||||
| 1691 | $c_qu += max($quo->chars, $first->chars); | ||||||
| 1692 | $c_dr = $c_qu + $len2 - 1; | ||||||
| 1693 | } | ||||||
| 1694 | $action[-1]->set_level(0); | ||||||
| 1695 | return $first; | ||||||
| 1696 | } | ||||||
| 1697 | |||||||
| 1698 | method _adding($digits, $pos, $basic_level, $radix, $striking = 0) { | ||||||
| 1699 | my @digits = @$digits; | ||||||
| 1700 | my @pos = @$pos; | ||||||
| 1701 | my $action; | ||||||
| 1702 | my $sum; | ||||||
| 1703 | my $result = ''; | ||||||
| 1704 | my $carry = 0; | ||||||
| 1705 | |||||||
| 1706 | for my $i (0 .. $#digits) { | ||||||
| 1707 | my $l = $digits[$i]; | ||||||
| 1708 | my @l = grep { $_ } @$l; # removing empty entries | ||||||
| 1709 | if (0+ @l == 0) { | ||||||
| 1710 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3, label => 'WRI04' , val1 => $carry | ||||||
| 1711 | , w1l => $pos[$i]{lin}, w1c => $pos[$i]{col}, w1val => $carry | ||||||
| 1712 | ); | ||||||
| 1713 | push(@action, $action); | ||||||
| 1714 | $result = $carry . $result; | ||||||
| 1715 | } | ||||||
| 1716 | elsif (0+ @l == 1 && $carry eq '0') { | ||||||
| 1717 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3 | ||||||
| 1718 | , label => 'WRI04' , val1 => $l[0]{val} | ||||||
| 1719 | , r1l => $l[ 0 ]{lin}, r1c => $l[ 0 ]{col}, r1val => $l[0]{val}, r1str => $striking | ||||||
| 1720 | , w1l => $pos[$i]{lin}, w1c => $pos[$i]{col}, w1val => $l[0]{val} | ||||||
| 1721 | ); | ||||||
| 1722 | push(@action, $action); | ||||||
| 1723 | $result = $l[0]{val} . $result; | ||||||
| 1724 | } | ||||||
| 1725 | else { | ||||||
| 1726 | my $first; | ||||||
| 1727 | $sum = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $l[0]{val}); | ||||||
| 1728 | if ($carry eq '0') { | ||||||
| 1729 | $sum += Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $l[1]{val}); | ||||||
| 1730 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6 | ||||||
| 1731 | , label => 'ADD01' , val1 => $l[0]{val}, val2 => $l[1]{val}, val3 => $sum->value | ||||||
| 1732 | , r1l => $l[0]{lin}, r1c => $l[0]{col}, r1val => $l[0]{val}, r1str => $striking | ||||||
| 1733 | , r2l => $l[1]{lin}, r2c => $l[1]{col}, r2val => $l[1]{val}, r2str => $striking | ||||||
| 1734 | ); | ||||||
| 1735 | $first = 2; | ||||||
| 1736 | } | ||||||
| 1737 | else { | ||||||
| 1738 | $sum += Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $carry); | ||||||
| 1739 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6 | ||||||
| 1740 | , label => 'ADD01' , val1 => $l[0]{val}, val2 => $carry , val3 => $sum->value | ||||||
| 1741 | , r1l => $l[0]{lin}, r1c => $l[0]{col}, r1val => $l[0]{val}, r1str => $striking | ||||||
| 1742 | ); | ||||||
| 1743 | $first = 1; | ||||||
| 1744 | } | ||||||
| 1745 | push(@action, $action); | ||||||
| 1746 | for my $j ($first .. $#l) { | ||||||
| 1747 | $sum += Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $l[$j]{val}); | ||||||
| 1748 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6 | ||||||
| 1749 | , label => 'ADD02' , val1 => $l[$j]{val}, val2 => $sum->value | ||||||
| 1750 | , r1l => $l[$j]{lin}, r1c => $l[$j]{col}, r1val => $l[$j]{val}, r1str => $striking | ||||||
| 1751 | ); | ||||||
| 1752 | push(@action, $action); | ||||||
| 1753 | } | ||||||
| 1754 | if ($i == @digits - 1) { | ||||||
| 1755 | my $last_action = pop(@action); | ||||||
| 1756 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 2 | ||||||
| 1757 | , label => $last_action->label, val1 => $last_action->val1, val2 => $last_action->val2 , val3 => $last_action->val3 | ||||||
| 1758 | , r1l => $last_action->r1l , r1c => $last_action->r1c , r1val => $last_action->r1val, r1str => $striking | ||||||
| 1759 | , r2l => $last_action->r2l , r2c => $last_action->r2c , r2val => $last_action->r2val, r2str => $striking | ||||||
| 1760 | , w1l => $pos[$i]{lin} , w1c => $pos[$i]{col} , w1val => $sum->value | ||||||
| 1761 | ); | ||||||
| 1762 | push(@action, $action); | ||||||
| 1763 | $result = $sum->value . $result; | ||||||
| 1764 | } | ||||||
| 1765 | else { | ||||||
| 1766 | my $digit = $sum->unit->value; | ||||||
| 1767 | $carry = $sum->carry->value; | ||||||
| 1768 | my $lin; | ||||||
| 1769 | my $col; | ||||||
| 1770 | my $code = 'WRI02'; | ||||||
| 1771 | if ($carry eq '0') { | ||||||
| 1772 | $code = 'WRI03'; | ||||||
| 1773 | } | ||||||
| 1774 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3 | ||||||
| 1775 | , label => $code , val1 => $digit , val2 => $carry | ||||||
| 1776 | , w1l => $pos[$i]{lin}, w1c => $pos[$i]{col}, w1val => $digit | ||||||
| 1777 | ); | ||||||
| 1778 | push(@action, $action); | ||||||
| 1779 | $result = $digit . $result; | ||||||
| 1780 | } | ||||||
| 1781 | } | ||||||
| 1782 | } | ||||||
| 1783 | return $result; | ||||||
| 1784 | } | ||||||
| 1785 | |||||||
| 1786 | method _embedded_sub(%param) { | ||||||
| 1787 | my $basic_level = $param{basic_level}; | ||||||
| 1788 | my $l_hi = $param{l_hi}; | ||||||
| 1789 | my $c_hi = $param{c_hi}; | ||||||
| 1790 | my $high = $param{high}; | ||||||
| 1791 | my $l_lo = $param{l_lo}; | ||||||
| 1792 | my $c_lo = $param{c_lo}; | ||||||
| 1793 | my $low = $param{low}; | ||||||
| 1794 | my $l_re = $param{l_re}; | ||||||
| 1795 | my $c_re = $param{c_re}; | ||||||
| 1796 | |||||||
| 1797 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 1798 | my $radix = $high->radix; | ||||||
| 1799 | my $leng = $high->chars; | ||||||
| 1800 | # set-up | ||||||
| 1801 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 2, label => 'DRA02', w1l => $l_lo, w1c => $c_lo - $leng + 1 | ||||||
| 1802 | , w2l => $l_lo, w2c => $c_lo); | ||||||
| 1803 | push(@action, $action); | ||||||
| 1804 | |||||||
| 1805 | my $carry = '0'; | ||||||
| 1806 | my $result = ''; | ||||||
| 1807 | my $label; | ||||||
| 1808 | |||||||
| 1809 | # First subphase, looping over the low number's digits | ||||||
| 1810 | for my $i (0 .. $low->chars - 1) { | ||||||
| 1811 | my $high1 = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($high->value, $leng - $i - 1, 1)); | ||||||
| 1812 | my $low1 = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($low->value, $low->chars - $i - 1, 1)); | ||||||
| 1813 | my $adj1; | ||||||
| 1814 | my $res1; | ||||||
| 1815 | my $low2; | ||||||
| 1816 | if ($carry eq '0') { | ||||||
| 1817 | ($adj1, $res1) = adjust_sub($high1, $low1); | ||||||
| 1818 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'SUB01', val1 => $low1->value, val2 => $res1->value, val3 => $adj1->value | ||||||
| 1819 | , r1l => $l_hi, r1c => $c_hi - $i, r1val => $high1->value | ||||||
| 1820 | , r2l => $l_lo, r2c => $c_lo - $i, r2val => $low1->value | ||||||
| 1821 | ); | ||||||
| 1822 | } | ||||||
| 1823 | else { | ||||||
| 1824 | $low2 = $low1 + Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $carry); | ||||||
| 1825 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'ADD01' , val1 => $low1->value, val2 => $carry, val3 => $low2->value | ||||||
| 1826 | , r1l => $l_lo, r1c => $c_lo - $i, r1val => $low1->value | ||||||
| 1827 | ); | ||||||
| 1828 | push(@action, $action); | ||||||
| 1829 | ($adj1, $res1) = adjust_sub($high1, $low2); | ||||||
| 1830 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'SUB02' , val1 => $res1->value, val2 => $adj1->value | ||||||
| 1831 | , r1l => $l_hi, r1c => $c_hi - $i, r1val => $high1->value | ||||||
| 1832 | ); | ||||||
| 1833 | } | ||||||
| 1834 | push(@action, $action); | ||||||
| 1835 | $result = $res1->unit->value . $result; | ||||||
| 1836 | $carry = $adj1->carry->value; | ||||||
| 1837 | if ($carry eq '0') { | ||||||
| 1838 | $label = 'WRI03'; | ||||||
| 1839 | } | ||||||
| 1840 | else { | ||||||
| 1841 | $label = 'WRI02'; | ||||||
| 1842 | } | ||||||
| 1843 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3, label => $label , val1 => $res1->unit->value, val2 => $carry | ||||||
| 1844 | , w1l => $l_re , w1c => $c_re - $i, w1val => $res1->unit->value | ||||||
| 1845 | ); | ||||||
| 1846 | push(@action, $action); | ||||||
| 1847 | } | ||||||
| 1848 | # Second subphase, dealing with the carry | ||||||
| 1849 | my $pos = $low->chars; | ||||||
| 1850 | while ($carry ne '0') { | ||||||
| 1851 | my $high1 = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($high->value, $leng - $pos - 1, 1)); | ||||||
| 1852 | my $carry1 = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $carry); | ||||||
| 1853 | my $adj1; | ||||||
| 1854 | my $res1; | ||||||
| 1855 | ($adj1, $res1) = adjust_sub($high1, $carry1); | ||||||
| 1856 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'SUB01', val1 => $carry, val2 => $res1->value, val3 => $adj1->value | ||||||
| 1857 | , r1l => $l_hi, r1c => $c_hi - $pos, r1val => $high1->value | ||||||
| 1858 | ); | ||||||
| 1859 | push(@action, $action); | ||||||
| 1860 | $result = $res1->unit->value . $result; | ||||||
| 1861 | $carry = $adj1->carry->value; | ||||||
| 1862 | if ($carry eq '0') { | ||||||
| 1863 | $label = 'WRI03'; | ||||||
| 1864 | } | ||||||
| 1865 | else { | ||||||
| 1866 | $label = 'WRI02'; | ||||||
| 1867 | } | ||||||
| 1868 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3, label => $label , val1 => $res1->unit->value, val2 => $carry | ||||||
| 1869 | , w1l => $l_re , w1c => $c_re - $pos, w1val => $res1->unit->value | ||||||
| 1870 | ); | ||||||
| 1871 | # no need to write the final zero if there is no carry | ||||||
| 1872 | if ($res1->unit->value ne '0' or $carry ne '0' or $pos < $leng - 1) { | ||||||
| 1873 | push(@action, $action); | ||||||
| 1874 | } | ||||||
| 1875 | $pos++; | ||||||
| 1876 | } | ||||||
| 1877 | # Third subphase, a single copy | ||||||
| 1878 | if ($pos < $leng) { | ||||||
| 1879 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level, label => 'WRI05' , val1 => substr($high->value, 0, $leng - $pos) | ||||||
| 1880 | , w1l => $l_re , w1c => $c_re - $pos, w1val => substr($high->value, 0, $leng - $pos) | ||||||
| 1881 | ); | ||||||
| 1882 | push(@action, $action); | ||||||
| 1883 | $result = substr($high->value, 0, $leng - $pos) . $result; | ||||||
| 1884 | } | ||||||
| 1885 | |||||||
| 1886 | return $result; | ||||||
| 1887 | } | ||||||
| 1888 | |||||||
| 1889 | method _preparation(%param) { | ||||||
| 1890 | my $factor = $param{factor}; | ||||||
| 1891 | my $limit = $param{limit}; | ||||||
| 1892 | my $cache = $param{cache}; | ||||||
| 1893 | my $basic_level = $param{basic_level} // 0; | ||||||
| 1894 | |||||||
| 1895 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 1896 | my $one = Arithmetic::PaperAndPencil::Number->new(radix => $factor->radix, value => '1'); | ||||||
| 1897 | my $radix = $factor->radix; | ||||||
| 1898 | my $col = $factor->chars + 3; | ||||||
| 1899 | |||||||
| 1900 | # cache first entry | ||||||
| 1901 | $cache->{1} = $factor; | ||||||
| 1902 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3, label => 'WRI00' | ||||||
| 1903 | , w1l => 0, w1c => 0 , w1val => '1' | ||||||
| 1904 | , w2l => 0, w2c => $col, w2val => $factor->value); | ||||||
| 1905 | push(@action, $action); | ||||||
| 1906 | |||||||
| 1907 | my @digits; # storing the numbers' digits | ||||||
| 1908 | my @total; # storing the total's digit positions | ||||||
| 1909 | my @digit_list = reverse(split('', $factor->value)); | ||||||
| 1910 | for my $i (0 .. $#digit_list) { | ||||||
| 1911 | my $ch = $digit_list[$i]; | ||||||
| 1912 | $digits[$i][0] = { lin => 0, col => $col - $i, val => $ch }; | ||||||
| 1913 | $total[ $i] = { lin => 1, col => $col - $i }; | ||||||
| 1914 | } | ||||||
| 1915 | # in case the last partial products are longer than the factor | ||||||
| 1916 | $total[$factor->chars] = { lin => 1, col => $col - $factor->chars }; | ||||||
| 1917 | |||||||
| 1918 | my $result = $factor->value; | ||||||
| 1919 | my $lin = 1; | ||||||
| 1920 | my Arithmetic::PaperAndPencil::Number $mul = $one + $one; # starting from 2; yet stopping immediately with a 2-digit $mul if $radix == 2 | ||||||
| 1921 | while ($mul->value le $limit && $mul->chars == 1) { | ||||||
| 1922 | # displaying the line number | ||||||
| 1923 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 9, label => 'WRI00' | ||||||
| 1924 | , w1l => $lin, w1c => 0, w1val => $mul->value); | ||||||
| 1925 | push(@action, $action); | ||||||
| 1926 | |||||||
| 1927 | # computation | ||||||
| 1928 | my @digit_list = reverse(split('', $result)); | ||||||
| 1929 | for my $i (0 .. $#digit_list) { | ||||||
| 1930 | my $ch = $digit_list[$i]; | ||||||
| 1931 | $digits[$i][1] = { lin => $lin - 1, col => $col - $i, val => $ch }; | ||||||
| 1932 | $total[$i]{lin} = $lin; | ||||||
| 1933 | } | ||||||
| 1934 | $result = $self->_adding(\@digits, \@total, $basic_level + 1, $radix); | ||||||
| 1935 | $action[-1]->set_level($basic_level + 3); | ||||||
| 1936 | |||||||
| 1937 | # storing into cache | ||||||
| 1938 | $cache->{$mul->value} = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result); | ||||||
| 1939 | |||||||
| 1940 | # loop iteration | ||||||
| 1941 | $lin++; | ||||||
| 1942 | $mul += $one; | ||||||
| 1943 | } | ||||||
| 1944 | |||||||
| 1945 | $action = Arithmetic::PaperAndPencil::Action->new(level => 1, label => 'NXP01'); | ||||||
| 1946 | push(@action, $action); | ||||||
| 1947 | } | ||||||
| 1948 | |||||||
| 1949 | method _prep_conv($old_radix, $new_radix, $cache, %param) { | ||||||
| 1950 | my $basic_level = $param{basic_level} // 0; | ||||||
| 1951 | |||||||
| 1952 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 1953 | my $old_number = Arithmetic::PaperAndPencil::Number->new(value => '0', radix => $old_radix); | ||||||
| 1954 | my $new_number = Arithmetic::PaperAndPencil::Number->new(value => '0', radix => $new_radix); | ||||||
| 1955 | my $old_one = Arithmetic::PaperAndPencil::Number->new(value => '1', radix => $old_radix); | ||||||
| 1956 | my $new_one = Arithmetic::PaperAndPencil::Number->new(value => '1', radix => $new_radix); | ||||||
| 1957 | my $line = 1; | ||||||
| 1958 | while ($old_number->value ne '11') { | ||||||
| 1959 | $cache->{$old_number->value} = $new_number; | ||||||
| 1960 | if ($new_number->chars > 1) { | ||||||
| 1961 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'WRI00' | ||||||
| 1962 | , w1l => $line, w1c => 2, w1val => $old_number->value | ||||||
| 1963 | , w2l => $line, w2c => 10, w2val => $new_number->value); | ||||||
| 1964 | push(@action, $action); | ||||||
| 1965 | $line++; | ||||||
| 1966 | } | ||||||
| 1967 | $old_number += $old_one; | ||||||
| 1968 | $new_number += $new_one; | ||||||
| 1969 | } | ||||||
| 1970 | if ($line != 1) { | ||||||
| 1971 | $action[-1]->set_level(1); | ||||||
| 1972 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 9, label => 'NXP01'); | ||||||
| 1973 | push(@action, $action); | ||||||
| 1974 | } | ||||||
| 1975 | } | ||||||
| 1976 | |||||||
| 1977 | method _adv_mult(%param) { | ||||||
| 1978 | my $basic_level = $param{basic_level}; | ||||||
| 1979 | my $type = $param{type} // 'std'; | ||||||
| 1980 | my $l_md = $param{l_md}; # coordinates of the multiplicand | ||||||
| 1981 | my $c_md = $param{c_md}; | ||||||
| 1982 | my $l_mr = $param{l_mr}; # coordinates of the multiplier | ||||||
| 1983 | my $c_mr = $param{c_mr}; | ||||||
| 1984 | my $l_pd = $param{l_pd}; # coordinates of the product | ||||||
| 1985 | my $c_pd = $param{c_pd}; | ||||||
| 1986 | my %cache = %{$param{cache}}; | ||||||
| 1987 | my $multiplicand = $param{multiplicand}; | ||||||
| 1988 | my $multiplier = $param{multiplier}; | ||||||
| 1989 | |||||||
| 1990 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 1991 | my $result = ''; | ||||||
| 1992 | my $radix = $multiplier->radix; | ||||||
| 1993 | my $line = $l_pd; | ||||||
| 1994 | my $pos = $multiplier->chars - 1; | ||||||
| 1995 | my $shift = 0; | ||||||
| 1996 | my $shift_char = '0'; | ||||||
| 1997 | my @partial; # storing the partial products' digits | ||||||
| 1998 | my @final ; # storing the final product's digit positions | ||||||
| 1999 | |||||||
| 2000 | while ($pos >= 0) { | ||||||
| 2001 | # shifting the current simple multiplication because of embedded zeroes | ||||||
| 2002 | if (substr($multiplier->value, 0, $pos + 1) =~ /(0+)$/) { | ||||||
| 2003 | $shift += length($1); | ||||||
| 2004 | $pos -= length($1); | ||||||
| 2005 | } | ||||||
| 2006 | if ($shift != 0) { | ||||||
| 2007 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5 , label => 'WRI00' | ||||||
| 2008 | , w1l => $line, w1c => $c_pd, w1val => $shift_char x $shift); | ||||||
| 2009 | push(@action, $action); | ||||||
| 2010 | if ($shift_char eq '0') { | ||||||
| 2011 | for my $i (0 .. $shift - 1) { | ||||||
| 2012 | push @{$partial[$i]}, { lin => $line, col => $c_pd - $i, val => '0'}; | ||||||
| 2013 | } | ||||||
| 2014 | } | ||||||
| 2015 | } | ||||||
| 2016 | # computing the simple multiplication | ||||||
| 2017 | my $mul = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($multiplier->value, $pos, 1)); | ||||||
| 2018 | my Arithmetic::PaperAndPencil::Number $pdt; | ||||||
| 2019 | if ($type ne 'std' && defined $cache{$mul->value}) { | ||||||
| 2020 | $pdt = $cache{$mul->value}; | ||||||
| 2021 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3, label => 'WRI05', val1 => $pdt->value | ||||||
| 2022 | , w1l => $line, w1c => $c_pd - $shift, w1val => $pdt->value | ||||||
| 2023 | ); | ||||||
| 2024 | push(@action, $action); | ||||||
| 2025 | |||||||
| 2026 | } | ||||||
| 2027 | else { | ||||||
| 2028 | $pdt = $self->_simple_mult(basic_level => $basic_level | ||||||
| 2029 | , l_md => $l_md, c_md => $c_md , multiplicand => $multiplicand | ||||||
| 2030 | , l_mr => $l_mr, c_mr => $c_mr - $shift, multiplier => $mul | ||||||
| 2031 | , l_pd => $line, c_pd => $c_pd - $shift); | ||||||
| 2032 | # filling the cache | ||||||
| 2033 | $cache{$mul->value} = $pdt; | ||||||
| 2034 | } | ||||||
| 2035 | # storing the digits of $pdt | ||||||
| 2036 | my @digit_list = reverse(split('', $pdt->value)); | ||||||
| 2037 | for my $i (0 .. $#digit_list) { | ||||||
| 2038 | my $x = $digit_list[$i]; | ||||||
| 2039 | push @{$partial[$i + $shift]}, { lin => $line, col => $c_pd - $shift - $i, val => $x }; | ||||||
| 2040 | } | ||||||
| 2041 | # shifting the next simple multiplication | ||||||
| 2042 | $pos--; | ||||||
| 2043 | $shift++; | ||||||
| 2044 | $shift_char = '.'; | ||||||
| 2045 | $line++; | ||||||
| 2046 | } | ||||||
| 2047 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 2, label => 'DRA02' | ||||||
| 2048 | , w1l => $line - 1, w1c => $c_pd + 1 - $multiplicand->chars - $multiplier->chars | ||||||
| 2049 | , w2l => $line - 1, w2c => $c_pd); | ||||||
| 2050 | push(@action, $action); | ||||||
| 2051 | for my $i (0 .. $multiplicand->chars + $multiplier->chars) { | ||||||
| 2052 | $final[$i] = { lin => $line, col => $c_pd - $i }; | ||||||
| 2053 | } | ||||||
| 2054 | $result = $self->_adding(\@partial, \@final, $basic_level, $radix); | ||||||
| 2055 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result); | ||||||
| 2056 | } | ||||||
| 2057 | |||||||
| 2058 | method _simple_mult(%param) { | ||||||
| 2059 | my $basic_level = $param{basic_level}; | ||||||
| 2060 | my $l_md = $param{l_md}; # coordinates of the multiplicand | ||||||
| 2061 | my $c_md = $param{c_md}; | ||||||
| 2062 | my $l_mr = $param{l_mr}; # coordinates of the multiplier (single digit) | ||||||
| 2063 | my $c_mr = $param{c_mr}; | ||||||
| 2064 | my $l_pd = $param{l_pd}; # coordinates of the product | ||||||
| 2065 | my $c_pd = $param{c_pd}; | ||||||
| 2066 | my $multiplicand = $param{multiplicand}; | ||||||
| 2067 | my $multiplier = $param{multiplier}; | ||||||
| 2068 | my $result = ''; | ||||||
| 2069 | my $radix = $multiplier->radix; | ||||||
| 2070 | my $carry = '0'; | ||||||
| 2071 | my $len1 = $multiplicand->chars; | ||||||
| 2072 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 2073 | my Arithmetic::PaperAndPencil::Number $pdt; | ||||||
| 2074 | for my $i (0 .. $len1 - 1) { | ||||||
| 2075 | my $mul = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($multiplicand->value, $len1 - $i - 1, 1)); | ||||||
| 2076 | $pdt = $multiplier * $mul; | ||||||
| 2077 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'MUL01' , val3 => $pdt->value | ||||||
| 2078 | , r1l => $l_mr, r1c => $c_mr , r1val => $multiplier->value, val1 => $multiplier->value | ||||||
| 2079 | , r2l => $l_md, r2c => $c_md - $i, r2val => $mul->value , val2 => $mul->value | ||||||
| 2080 | ); | ||||||
| 2081 | push(@action, $action); | ||||||
| 2082 | if ($carry ne '0') { | ||||||
| 2083 | $pdt += Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $carry); | ||||||
| 2084 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'ADD02', val1 => $carry, val2 => $pdt->value); | ||||||
| 2085 | push(@action, $action); | ||||||
| 2086 | } | ||||||
| 2087 | my $unit = $pdt->unit->value; | ||||||
| 2088 | $carry = $pdt->carry->value; | ||||||
| 2089 | my $code = 'WRI02'; | ||||||
| 2090 | if ($carry eq '0') { | ||||||
| 2091 | $code = 'WRI03'; | ||||||
| 2092 | } | ||||||
| 2093 | if ($i < $len1 - 1) { | ||||||
| 2094 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => $code, val1 => $unit, val2 => $carry | ||||||
| 2095 | , w1l => $l_pd, w1c => $c_pd - $i, w1val => $unit | ||||||
| 2096 | ); | ||||||
| 2097 | push(@action, $action); | ||||||
| 2098 | $result = $unit . $result; | ||||||
| 2099 | } | ||||||
| 2100 | } | ||||||
| 2101 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3, label => 'WRI00' | ||||||
| 2102 | , w1l => $l_pd, w1c => $c_pd + 1 - $len1, w1val => $pdt->value | ||||||
| 2103 | ); | ||||||
| 2104 | push(@action, $action); | ||||||
| 2105 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $pdt->value . $result); | ||||||
| 2106 | } | ||||||
| 2107 | |||||||
| 2108 | method _push_below($number, $col, $lines_below) { | ||||||
| 2109 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 2110 | for my $digit (split('', reverse($number->value))) { | ||||||
| 2111 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'WRI00', w1l => $lines_below->[$col]++, w1c => $col, w1val => $digit); | ||||||
| 2112 | push(@action, $action); | ||||||
| 2113 | $col--; | ||||||
| 2114 | } | ||||||
| 2115 | $action[- 1]->set_level(4); | ||||||
| 2116 | } | ||||||
| 2117 | |||||||
| 2118 | method _push_above($number, $col, $lines_above, $addition, $bias) { | ||||||
| 2119 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 2120 | for my $digit (split('', reverse($number->value))) { | ||||||
| 2121 | $addition->[$bias - $col][- $lines_above->[$col] ] = { lin => $lines_above->[$col], col => $col, val => $digit }; | ||||||
| 2122 | $action = Arithmetic::PaperAndPencil::Action->new(level => 9, label => 'WRI00', w1l => $lines_above->[$col]--, w1c => $col, w1val => $digit); | ||||||
| 2123 | push(@action, $action); | ||||||
| 2124 | $col--; | ||||||
| 2125 | } | ||||||
| 2126 | } | ||||||
| 2127 | |||||||
| 2128 | method _add_above($number, $col, $lines_above, $result) { | ||||||
| 2129 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 2130 | my $radix = $number->radix; | ||||||
| 2131 | while ($number->value ne '0') { | ||||||
| 2132 | if ($lines_above->[$col] == -1) { | ||||||
| 2133 | my $code = 'WRI02'; | ||||||
| 2134 | if ($number->chars == 1) { | ||||||
| 2135 | $code = 'WRI04'; | ||||||
| 2136 | } | ||||||
| 2137 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => $code, val1 => $number->unit->value, val2 => $number->carry->value | ||||||
| 2138 | , w1l => $lines_above->[$col]--, w1c => $col , w1val => $number->unit->value); | ||||||
| 2139 | push(@action, $action); | ||||||
| 2140 | $result->[$col] = $number->unit->value; | ||||||
| 2141 | $number = $number->carry; | ||||||
| 2142 | } | ||||||
| 2143 | else { | ||||||
| 2144 | my $already_there = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $result->[$col]); | ||||||
| 2145 | my Arithmetic::PaperAndPencil::Number $sum = $number + $already_there; | ||||||
| 2146 | $action = Arithmetic::PaperAndPencil::Action->new(level => 6, label => 'ADD01', val1 => $number->value, val2 => $already_there->value, val3 => $sum->value | ||||||
| 2147 | , r2l => $lines_above->[$col] + 1, r2c => $col , r2val => $already_there->value, r2str => 1 | ||||||
| 2148 | ); | ||||||
| 2149 | push(@action, $action); | ||||||
| 2150 | my $code = 'WRI02'; | ||||||
| 2151 | if ($sum->chars == 1) { | ||||||
| 2152 | $code = 'WRI03'; | ||||||
| 2153 | } | ||||||
| 2154 | $action = Arithmetic::PaperAndPencil::Action->new(level => 5, label => $code, val1 => $sum->unit->value, val2 => $sum->carry->value | ||||||
| 2155 | , w1l => $lines_above->[$col]--, w1c => $col , w1val => $sum->unit->value | ||||||
| 2156 | ); | ||||||
| 2157 | push(@action, $action); | ||||||
| 2158 | $result->[$col] = $sum->unit->value; | ||||||
| 2159 | $number = $sum->carry; | ||||||
| 2160 | } | ||||||
| 2161 | --$col; | ||||||
| 2162 | } | ||||||
| 2163 | } | ||||||
| 2164 | |||||||
| 2165 | method _halving(%param) { | ||||||
| 2166 | my $l1 = $param{l1}; | ||||||
| 2167 | my $c1 = $param{c1}; | ||||||
| 2168 | my $l2 = $param{l2}; | ||||||
| 2169 | my $c2 = $param{c2}; | ||||||
| 2170 | my $number = $param{number}; | ||||||
| 2171 | my $basic_level = $param{basic_level} // 0; | ||||||
| 2172 | |||||||
| 2173 | my $radix = $number->radix; | ||||||
| 2174 | my $res = ''; | ||||||
| 2175 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 2176 | if ($radix == 2) { | ||||||
| 2177 | if ($number->chars > 1) { | ||||||
| 2178 | $res = substr($number->value, 0, $number->chars - 1); | ||||||
| 2179 | } | ||||||
| 2180 | else { | ||||||
| 2181 | $res = '0'; | ||||||
| 2182 | } | ||||||
| 2183 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 4, label => 'SHF01' | ||||||
| 2184 | , r1l => $l1, r1c => $c1, r1val => $number->value , val1 => $number->value | ||||||
| 2185 | , w1l => $l2, w1c => $c2, w1val => $res , val2 => $res | ||||||
| 2186 | ); | ||||||
| 2187 | push(@action, $action); | ||||||
| 2188 | } | ||||||
| 2189 | else { | ||||||
| 2190 | my $one = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '1'); | ||||||
| 2191 | my $two = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '2'); | ||||||
| 2192 | my $len = $number->chars; | ||||||
| 2193 | my $carry = 0; | ||||||
| 2194 | my @digit_list = split('', $number->value); | ||||||
| 2195 | for my $n (0 .. $#digit_list) { | ||||||
| 2196 | my $digit = $digit_list[$n]; | ||||||
| 2197 | my Arithmetic::PaperAndPencil::Number $dividend; | ||||||
| 2198 | if ($carry == 0) { | ||||||
| 2199 | $dividend = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $digit); | ||||||
| 2200 | } | ||||||
| 2201 | else { | ||||||
| 2202 | $dividend = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '1' . $digit); | ||||||
| 2203 | } | ||||||
| 2204 | my Arithmetic::PaperAndPencil::Number $quotient = $dividend / $two; | ||||||
| 2205 | if ($dividend->is_odd) { | ||||||
| 2206 | $carry = 1; | ||||||
| 2207 | } | ||||||
| 2208 | else { | ||||||
| 2209 | $carry = 0; | ||||||
| 2210 | } | ||||||
| 2211 | $action = Arithmetic::PaperAndPencil::Action->new( level => $basic_level + 5, label => 'DIV07' | ||||||
| 2212 | , val1 => $dividend->value , val2 => $quotient->value, val3 => $carry | ||||||
| 2213 | , r1l => $l1, r1c => $c1 -$len + $n + 1, r1val => $digit | ||||||
| 2214 | , w1l => $l2, w1c => $c2 -$len + $n + 1, w1val => $quotient->value | ||||||
| 2215 | ); | ||||||
| 2216 | push(@action, $action); | ||||||
| 2217 | $res .= $quotient->value; | ||||||
| 2218 | } | ||||||
| 2219 | } | ||||||
| 2220 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $res); | ||||||
| 2221 | } | ||||||
| 2222 | |||||||
| 2223 | method _doubling(%param) { | ||||||
| 2224 | my $l1 = $param{l1}; | ||||||
| 2225 | my $c1 = $param{c1}; | ||||||
| 2226 | my $l2 = $param{l2}; | ||||||
| 2227 | my $c2 = $param{c2}; | ||||||
| 2228 | my $number = $param{number}; | ||||||
| 2229 | my $basic_level = $param{basic_level} // 0; | ||||||
| 2230 | |||||||
| 2231 | my $radix = $number->radix; | ||||||
| 2232 | my $res = ''; | ||||||
| 2233 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 2234 | if ($radix == 2) { | ||||||
| 2235 | $res = $number->value . '0'; | ||||||
| 2236 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 4, label => 'SHF01' | ||||||
| 2237 | , r1l => $l1, r1c => $c1, r1val => $number->value , val1 => $number->value | ||||||
| 2238 | , w1l => $l2, w1c => $c2, w1val => $res , val2 => $res | ||||||
| 2239 | ); | ||||||
| 2240 | push(@action, $action); | ||||||
| 2241 | } | ||||||
| 2242 | else { | ||||||
| 2243 | my $carry = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '0'); | ||||||
| 2244 | my $one = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '1'); | ||||||
| 2245 | my $two = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '2'); | ||||||
| 2246 | my @digit_list = split('', reverse($number->value)); | ||||||
| 2247 | for my $n (0 .. $#digit_list) { | ||||||
| 2248 | my $digit = $digit_list[$n]; | ||||||
| 2249 | my $product = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $digit); | ||||||
| 2250 | $product *= $two; | ||||||
| 2251 | if ($carry->value eq '0') { | ||||||
| 2252 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'MUL01' | ||||||
| 2253 | , val1 => '2', val2 => $digit , val3 => $product->value | ||||||
| 2254 | , r1l => $l1, r1c => $c1 - $n, r1val => $digit | ||||||
| 2255 | , w1l => $l2, w1c => $c2 - $n, w1val => $product->value | ||||||
| 2256 | ); | ||||||
| 2257 | push(@action, $action); | ||||||
| 2258 | } | ||||||
| 2259 | else { | ||||||
| 2260 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'MUL01' | ||||||
| 2261 | , val1 => '2', val2 => $digit , val3 => $product->value | ||||||
| 2262 | , r1l => $l1, r1c => $c1 - $n, r1val => $digit | ||||||
| 2263 | ); | ||||||
| 2264 | push(@action, $action); | ||||||
| 2265 | $product += $one; | ||||||
| 2266 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'ADD02' | ||||||
| 2267 | , val1 => '1' , val2 => $product->value | ||||||
| 2268 | , w1l => $l2, w1c => $c2 - $n, w1val => $product->value | ||||||
| 2269 | ); | ||||||
| 2270 | push(@action, $action); | ||||||
| 2271 | } | ||||||
| 2272 | $res = $product->unit->value . $res; | ||||||
| 2273 | $carry = $product->carry; | ||||||
| 2274 | } | ||||||
| 2275 | if ($carry->value eq '1') { | ||||||
| 2276 | $res = '1' . $res; | ||||||
| 2277 | } | ||||||
| 2278 | } | ||||||
| 2279 | return Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $res); | ||||||
| 2280 | } | ||||||
| 2281 | |||||||
| 2282 | method _mult_and_sub(%param) { | ||||||
| 2283 | my $l_dd = $param{l_dd}; | ||||||
| 2284 | my $c_dd = $param{c_dd}; | ||||||
| 2285 | my $dividend = $param{dividend}; | ||||||
| 2286 | my $l_dr = $param{l_dr}; | ||||||
| 2287 | my $c_dr = $param{c_dr}; | ||||||
| 2288 | my $divisor = $param{divisor}; | ||||||
| 2289 | my $l_qu = $param{l_qu}; | ||||||
| 2290 | my $c_qu = $param{c_qu}; | ||||||
| 2291 | my $quotient = $param{quotient}; | ||||||
| 2292 | my $l_re = $param{l_re}; | ||||||
| 2293 | my $c_re = $param{c_re}; | ||||||
| 2294 | my $basic_level = $param{basic_level}; | ||||||
| 2295 | my $l_pr = $param{l_pr}; | ||||||
| 2296 | my $c_pr = $param{c_pr}; | ||||||
| 2297 | my $mult_and_sub = $param{mult_and_sub} // 'combined'; | ||||||
| 2298 | |||||||
| 2299 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 2300 | my $radix = $dividend->radix; | ||||||
| 2301 | my $carry = '0'; | ||||||
| 2302 | my $rem = ''; | ||||||
| 2303 | my $too_much = 0; | ||||||
| 2304 | |||||||
| 2305 | if ($mult_and_sub eq 'separate') { | ||||||
| 2306 | my Arithmetic::PaperAndPencil::Number $pdt; | ||||||
| 2307 | $pdt = $self->_simple_mult(basic_level => $basic_level + 1 | ||||||
| 2308 | , l_md => $l_dr, c_md => $c_dr, multiplicand => $divisor | ||||||
| 2309 | , l_mr => $l_qu, c_mr => $c_qu, multiplier => $quotient | ||||||
| 2310 | , l_pd => $l_pr, c_pd => $c_pr); | ||||||
| 2311 | if ($dividend < $pdt) { | ||||||
| 2312 | return (1, ''); | ||||||
| 2313 | } | ||||||
| 2314 | $rem = $self->_embedded_sub(basic_level => $basic_level + 3 | ||||||
| 2315 | , l_hi => $l_dd, c_hi => $c_dd, high => $dividend | ||||||
| 2316 | , l_lo => $l_pr, c_lo => $c_pr, low => $pdt | ||||||
| 2317 | , l_re => $l_re, c_re => $c_re); | ||||||
| 2318 | return (0, $rem); | ||||||
| 2319 | } | ||||||
| 2320 | for my $i (0 .. $divisor->chars - 1) { | ||||||
| 2321 | my $divisor_digit = substr($divisor->value, -$i - 1, 1); | ||||||
| 2322 | my $temp = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $divisor_digit); | ||||||
| 2323 | $temp *= $quotient; | ||||||
| 2324 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'MUL01', val3 => $temp->value | ||||||
| 2325 | , r1l => $l_qu, r1c => $c_qu , r1val => $quotient->value, val1 => $quotient->value | ||||||
| 2326 | , r2l => $l_dr, r2c => $c_dr - $i, r2val => $divisor_digit , val2 => $divisor_digit | ||||||
| 2327 | ); | ||||||
| 2328 | push(@action, $action); | ||||||
| 2329 | if ($carry ne '0') { | ||||||
| 2330 | $temp += Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $carry); | ||||||
| 2331 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'ADD02', val1 => $carry, val2 => $temp->value); | ||||||
| 2332 | push(@action, $action); | ||||||
| 2333 | } | ||||||
| 2334 | my $dividend_digit = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($dividend->value, - $i - 1, 1)); | ||||||
| 2335 | my Arithmetic::PaperAndPencil::Number $adjusted_dividend; | ||||||
| 2336 | my Arithmetic::PaperAndPencil::Number $rem_digit; | ||||||
| 2337 | ($adjusted_dividend, $rem_digit) = adjust_sub($dividend_digit, $temp); | ||||||
| 2338 | if ($i == $divisor->chars - 1) { | ||||||
| 2339 | if ($dividend->carry($i) < $adjusted_dividend) { | ||||||
| 2340 | $too_much = 1; | ||||||
| 2341 | } | ||||||
| 2342 | else { | ||||||
| 2343 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6 , label => 'SUB02' | ||||||
| 2344 | , val1 => $rem_digit->value , val2 => $adjusted_dividend->value | ||||||
| 2345 | , r1l => $l_dd, r1c => $c_dd - $i, r1val => $adjusted_dividend->value | ||||||
| 2346 | ); | ||||||
| 2347 | push(@action, $action); | ||||||
| 2348 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'WRI04' , val1 => $rem_digit->value | ||||||
| 2349 | , w1l => $l_re , w1c => $c_re - $i, w1val => $rem_digit->value | ||||||
| 2350 | ); | ||||||
| 2351 | push(@action, $action); | ||||||
| 2352 | $rem = $rem_digit->value . $rem; | ||||||
| 2353 | } | ||||||
| 2354 | } | ||||||
| 2355 | else { | ||||||
| 2356 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6 , label => 'SUB02' | ||||||
| 2357 | , val1 => $rem_digit->value , val2 => $adjusted_dividend->value | ||||||
| 2358 | , r1l => $l_dd, r1c => $c_dd - $i, r1val => $adjusted_dividend->value); | ||||||
| 2359 | push(@action, $action); | ||||||
| 2360 | my $label = 'WRI02'; | ||||||
| 2361 | if ($adjusted_dividend->carry->value eq '0') { | ||||||
| 2362 | $label = 'WRI03'; | ||||||
| 2363 | } | ||||||
| 2364 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => $label | ||||||
| 2365 | , val2 => $adjusted_dividend->carry->value, val1 => $rem_digit->value | ||||||
| 2366 | , w1l => $l_re, w1c => $c_re - $i, w1val => $rem_digit->value ); | ||||||
| 2367 | push(@action, $action); | ||||||
| 2368 | $rem = $rem_digit->value . $rem; | ||||||
| 2369 | $carry = $adjusted_dividend->carry->value; | ||||||
| 2370 | } | ||||||
| 2371 | } | ||||||
| 2372 | return ($too_much, $rem); | ||||||
| 2373 | } | ||||||
| 2374 | |||||||
| 2375 | method _embedded_div(%param) { | ||||||
| 2376 | my $l_dd = $param{l_dd}; | ||||||
| 2377 | my $c_dd = $param{c_dd}; | ||||||
| 2378 | my $dividend = $param{dividend}; | ||||||
| 2379 | my $l_dr = $param{l_dr}; | ||||||
| 2380 | my $c_dr = $param{c_dr}; | ||||||
| 2381 | my $divisor = $param{divisor}; | ||||||
| 2382 | my $l_qu = $param{l_qu}; | ||||||
| 2383 | my $c_qu = $param{c_qu}; | ||||||
| 2384 | my $basic_level = $param{basic_level}; | ||||||
| 2385 | my $type = $param{type}; | ||||||
| 2386 | my $mult_and_sub = $param{mult_and_sub} // 'combined'; | ||||||
| 2387 | my $mult_cache = $param{mult_cache}; | ||||||
| 2388 | my $stand_alone = $param{stand_alone}; | ||||||
| 2389 | |||||||
| 2390 | my Arithmetic::PaperAndPencil::Action $action; | ||||||
| 2391 | my $radix = $dividend->radix; | ||||||
| 2392 | my $zero = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '0'); | ||||||
| 2393 | my $one = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => '1'); | ||||||
| 2394 | my $len1 = $dividend->chars; | ||||||
| 2395 | my $len2 = $divisor ->chars; | ||||||
| 2396 | my $col_r = $len2; # column for the successive partial dividends and remainders | ||||||
| 2397 | my $len_dvd1 = 1; # length of the part of the dividend used to compute the first candidate digit | ||||||
| 2398 | # yes, string comparison or left-aligned comparison, to know if we need a short hook or a long hook | ||||||
| 2399 | if ($dividend lt $divisor) { | ||||||
| 2400 | $len_dvd1++; | ||||||
| 2401 | $col_r++; | ||||||
| 2402 | } | ||||||
| 2403 | my $bot = $l_dd + 2; | ||||||
| 2404 | my $quotient = ''; | ||||||
| 2405 | my $rem = ''; | ||||||
| 2406 | my $nb_dots = $len1 - $col_r + 1; | ||||||
| 2407 | my $dots = '.' x $nb_dots; | ||||||
| 2408 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'DRA01' | ||||||
| 2409 | , w1l => $l_dr, w1c => $c_dr - $len2 | ||||||
| 2410 | , w2l => $bot , w2c => $c_dr - $len2); | ||||||
| 2411 | push(@action, $action); | ||||||
| 2412 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'WRI00' | ||||||
| 2413 | , w1l => $l_dr, w1c => $c_dr , w1val => $divisor->value | ||||||
| 2414 | , w2l => $l_qu, w2c => $c_qu + $nb_dots - 1, w2val => $dots); | ||||||
| 2415 | push(@action, $action); | ||||||
| 2416 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 1, label => 'HOO01' | ||||||
| 2417 | , w1l => $l_dd, w1c => $c_dd - $len1 + 1 | ||||||
| 2418 | , w2l => $l_dd, w2c => $c_dd - $len1 + $col_r); | ||||||
| 2419 | push(@action, $action); | ||||||
| 2420 | |||||||
| 2421 | # computation | ||||||
| 2422 | if ($type eq 'std' || $type eq 'cheating') { | ||||||
| 2423 | my $lin_d = $l_dd; # line of the partial dividend | ||||||
| 2424 | my $delta = $len2 - 1; # how long we must shorten the divisor and the partial dividend to compute the quotient first candidate | ||||||
| 2425 | my $part_dvr1 = $divisor->carry($delta); # single-digit divisor to compute the quotient first candidate | ||||||
| 2426 | my $part_dvd = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($dividend->value, 0, $col_r)); | ||||||
| 2427 | while ($col_r <= $len1) { | ||||||
| 2428 | # single-digit dividend or 2-digit dividend to compute the quotient first candidate | ||||||
| 2429 | my Arithmetic::PaperAndPencil::Number $part_dvd1 = $part_dvd->carry($delta); | ||||||
| 2430 | my Arithmetic::PaperAndPencil::Number $theo_quo = $part_dvd1 / $part_dvr1; # theoretical quotient first candidate | ||||||
| 2431 | my Arithmetic::PaperAndPencil::Number $act_quo; # actual quotient first candidate | ||||||
| 2432 | my $label; | ||||||
| 2433 | if ($part_dvd < $divisor) { | ||||||
| 2434 | $theo_quo = $zero; | ||||||
| 2435 | $act_quo = $zero; | ||||||
| 2436 | } | ||||||
| 2437 | elsif ($type eq 'cheating') { | ||||||
| 2438 | my $dig = max( grep { $mult_cache->{$_} <= $part_dvd } keys(%{$mult_cache})); | ||||||
| 2439 | $act_quo = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $dig); | ||||||
| 2440 | $label = 'DIV03'; | ||||||
| 2441 | } | ||||||
| 2442 | elsif ($theo_quo->chars == 2) { | ||||||
| 2443 | $act_quo = max_unit($radix); | ||||||
| 2444 | $label = 'DIV02'; | ||||||
| 2445 | } | ||||||
| 2446 | else { | ||||||
| 2447 | $act_quo = $theo_quo; | ||||||
| 2448 | } | ||||||
| 2449 | my $too_much = 1; # we must loop with the next lower candidate | ||||||
| 2450 | if ($theo_quo->value eq '0') { | ||||||
| 2451 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'DIV01' | ||||||
| 2452 | , val1 => $part_dvd->value , r1l => $lin_d, r1c => $c_dd + $col_r , r1val => $part_dvd->value | ||||||
| 2453 | , val2 => $divisor ->value , r2l => $l_dr , r2c => $c_dr + $len2 - 1, r2val => $divisor->value | ||||||
| 2454 | , val3 => '0' , w1l => $l_qu , w1c => $c_qu , w1val => '0'); | ||||||
| 2455 | push(@action, $action); | ||||||
| 2456 | $too_much = 0; # no need to loop on candidate values, no need to execute the mult_and_sub routine | ||||||
| 2457 | $rem = $part_dvd->value; | ||||||
| 2458 | } | ||||||
| 2459 | elsif ($theo_quo->value eq $act_quo->value) { | ||||||
| 2460 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'DIV01' | ||||||
| 2461 | , val1 => $part_dvd1->value, r1l => $lin_d, r1c => $c_dd - $len1 + $col_r - $delta, r1val => $part_dvd1->value | ||||||
| 2462 | , val2 => $part_dvr1->value, r2l => $l_dr , r2c => $c_dr - $len2 + 1 - $delta, r2val => $part_dvr1->value | ||||||
| 2463 | , val3 => $theo_quo ->value, w1l => $l_qu , w1c => $c_qu , w1val => $act_quo->value); | ||||||
| 2464 | push(@action, $action); | ||||||
| 2465 | } | ||||||
| 2466 | else { | ||||||
| 2467 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 6, label => 'DIV01' | ||||||
| 2468 | , val1 => $part_dvd1->value, r1l => $lin_d, r1c => $c_dd - $len1 + $col_r - $delta, r1val => $part_dvd1->value | ||||||
| 2469 | , val2 => $part_dvr1->value, r2l => $l_dr , r2c => $c_dr - $len2 + 1 , r2val => $part_dvr1->value | ||||||
| 2470 | , val3 => $theo_quo ->value); | ||||||
| 2471 | push(@action, $action); | ||||||
| 2472 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => $label | ||||||
| 2473 | , val1 => $act_quo->value, w1l => $l_qu, w1c => $c_qu, w1val => $act_quo->value); | ||||||
| 2474 | push(@action, $action); | ||||||
| 2475 | } | ||||||
| 2476 | my $l_re; | ||||||
| 2477 | while ($too_much) { | ||||||
| 2478 | if ($mult_and_sub eq 'separate') { | ||||||
| 2479 | $l_re = $lin_d + 2; | ||||||
| 2480 | } | ||||||
| 2481 | else { | ||||||
| 2482 | $l_re = $lin_d + 1; | ||||||
| 2483 | } | ||||||
| 2484 | if ($bot < $l_re) { | ||||||
| 2485 | $bot = $l_re; | ||||||
| 2486 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'DRA01' | ||||||
| 2487 | , w1l => $l_dd, w1c => $c_dr - $len2 | ||||||
| 2488 | , w2l => $bot , w2c => $c_dr - $len2); | ||||||
| 2489 | push(@action, $action); | ||||||
| 2490 | } | ||||||
| 2491 | |||||||
| 2492 | ($too_much, $rem) = $self->_mult_and_sub(l_dd => $lin_d , c_dd => $c_dd - $len1 + $col_r, dividend => $part_dvd | ||||||
| 2493 | , l_dr => $l_dr , c_dr => $c_dr , divisor => $divisor | ||||||
| 2494 | , l_qu => $l_qu , c_qu => $c_qu , quotient => $act_quo | ||||||
| 2495 | , l_re => $l_re , c_re => $c_dd - $len1 + $col_r, basic_level => $basic_level | ||||||
| 2496 | , l_pr => $lin_d + 1, c_pr => $c_dd - $len1 + $col_r, mult_and_sub => $mult_and_sub); | ||||||
| 2497 | if ($too_much) { | ||||||
| 2498 | $action[-1]->set_level($basic_level + 4); | ||||||
| 2499 | $act_quo -= $one; | ||||||
| 2500 | my $erased_column; | ||||||
| 2501 | if ($stand_alone) { | ||||||
| 2502 | $erased_column = $c_dd - $len1; | ||||||
| 2503 | } | ||||||
| 2504 | else { | ||||||
| 2505 | $erased_column = $c_dd - $len1 + 1; | ||||||
| 2506 | } | ||||||
| 2507 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'ERA01' | ||||||
| 2508 | , w1l => $lin_d + 1, w1c => $c_dd, w2l => $lin_d + 1, w2c => $erased_column); | ||||||
| 2509 | push(@action, $action); | ||||||
| 2510 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 4, label => 'DIV02' | ||||||
| 2511 | , val1 => $act_quo->value, w1l => $l_qu, w1c => $c_qu, w1val => $act_quo->value); | ||||||
| 2512 | push(@action, $action); | ||||||
| 2513 | } | ||||||
| 2514 | } | ||||||
| 2515 | |||||||
| 2516 | $quotient .= $act_quo->value; | ||||||
| 2517 | if ($act_quo->value ne '0') { | ||||||
| 2518 | $lin_d = $l_re; | ||||||
| 2519 | } | ||||||
| 2520 | $action[-1]->set_level($basic_level + 3); | ||||||
| 2521 | if ($col_r < $len1) { | ||||||
| 2522 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'DRA01' | ||||||
| 2523 | , w1l => $l_dr, w1c => $c_dr - $len2 | ||||||
| 2524 | , w2l => $bot , w2c => $c_dr - $len2); | ||||||
| 2525 | push(@action, $action); | ||||||
| 2526 | my $new_digit = substr($dividend->value, $col_r, 1); | ||||||
| 2527 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3 , label => 'DIV04' , val1 => $new_digit | ||||||
| 2528 | , r1l => $l_dd , r1c => $c_dd - $len1 + $col_r + 1, r1val => $new_digit | ||||||
| 2529 | , w1l => $lin_d, w1c => $c_dd - $len1 + $col_r + 1, w1val => $new_digit); | ||||||
| 2530 | push(@action, $action); | ||||||
| 2531 | $part_dvd = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $rem . $new_digit); | ||||||
| 2532 | } | ||||||
| 2533 | $col_r++; | ||||||
| 2534 | $c_qu++; | ||||||
| 2535 | } | ||||||
| 2536 | $action[-1]->set_level($basic_level); | ||||||
| 2537 | } | ||||||
| 2538 | if ($type eq 'prepared') { | ||||||
| 2539 | my $part_div = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => substr($dividend->value, 0, $col_r)); | ||||||
| 2540 | my $n = 0; | ||||||
| 2541 | my $lin_d = $l_dd; | ||||||
| 2542 | while ($col_r <= $len1) { | ||||||
| 2543 | my $part_quo = max( grep { $mult_cache->{$_} <= $part_div } keys(%{$mult_cache})); | ||||||
| 2544 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'DIV01' | ||||||
| 2545 | , val1 => $part_div->value, r1l => $lin_d, r1c => $col_r , r1val => $part_div->value | ||||||
| 2546 | , val2 => $divisor->value , r2l => $l_dr , r2c => $c_dr , r2val => $divisor->value | ||||||
| 2547 | , val3 => $part_quo , w1l => $l_qu , w1c => $c_qu + $n , w1val => $part_quo); | ||||||
| 2548 | push(@action, $action); | ||||||
| 2549 | $quotient .= $part_quo; | ||||||
| 2550 | if ($part_quo eq '0') { | ||||||
| 2551 | $rem = $part_div->value; | ||||||
| 2552 | } | ||||||
| 2553 | else { | ||||||
| 2554 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'WRI05', val1 => $mult_cache->{$part_quo}->value); | ||||||
| 2555 | push(@action, $action); | ||||||
| 2556 | $bot += 2; | ||||||
| 2557 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 8, label => 'WRI00' | ||||||
| 2558 | , w1l => $lin_d + 1, w1c => $c_dd - $len1 + $col_r, w1val => $mult_cache->{$part_quo}->value); | ||||||
| 2559 | push(@action, $action); | ||||||
| 2560 | $rem = $self->_embedded_sub(basic_level => $basic_level + 3 | ||||||
| 2561 | , l_hi => $lin_d , c_hi => $c_dd - $len1 + $col_r, high => $part_div | ||||||
| 2562 | , l_lo => $lin_d + 1, c_lo => $c_dd - $len1 + $col_r, low => $mult_cache->{$part_quo} | ||||||
| 2563 | , l_re => $lin_d + 2, c_re => $c_dd - $len1 + $col_r); | ||||||
| 2564 | $action[-1]->set_level($basic_level + 3); | ||||||
| 2565 | $lin_d += 2; | ||||||
| 2566 | } | ||||||
| 2567 | |||||||
| 2568 | if ($col_r < $len1) { | ||||||
| 2569 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 5, label => 'DRA01' | ||||||
| 2570 | , w1l => $l_dd, w1c => $c_dd | ||||||
| 2571 | , w2l => $bot , w2c => $c_dd); | ||||||
| 2572 | push(@action, $action); | ||||||
| 2573 | my $new_digit = substr($dividend->value, $col_r, 1); | ||||||
| 2574 | $action = Arithmetic::PaperAndPencil::Action->new(level => $basic_level + 3, label => 'DIV04', val1 => $new_digit | ||||||
| 2575 | , r1l => $l_dd , r1c => $c_dd - $len1 + $col_r + 1, r1val => $new_digit | ||||||
| 2576 | , w1l => $lin_d, w1c => $c_dd - $len1 + $col_r + 1, w1val => $new_digit); | ||||||
| 2577 | push(@action, $action); | ||||||
| 2578 | $part_div = Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $rem . $new_digit); | ||||||
| 2579 | } | ||||||
| 2580 | ++$col_r; | ||||||
| 2581 | ++$n; | ||||||
| 2582 | } | ||||||
| 2583 | } | ||||||
| 2584 | return ( Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $quotient) | ||||||
| 2585 | , Arithmetic::PaperAndPencil::Number->new(radix => $radix, value => $rem)); | ||||||
| 2586 | } | ||||||
| 2587 | |||||||
| 2588 | |||||||
| 2589 | '0 + 0 = (:-|)'; # End of Arithmetic::PaperAndPencil | ||||||
| 2590 | |||||||
| 2591 | =encoding utf8 | ||||||
| 2592 | |||||||
| 2593 | =head1 NAME | ||||||
| 2594 | |||||||
| 2595 | Arithmetic::PaperAndPencil - simulating paper and pencil techniques for basic arithmetic operations | ||||||
| 2596 | |||||||
| 2597 | =head1 VERSION | ||||||
| 2598 | |||||||
| 2599 | Version 0.01 | ||||||
| 2600 | |||||||
| 2601 | =head1 SYNOPSIS | ||||||
| 2602 | |||||||
| 2603 | use Arithmetic::PaperAndPencil; | ||||||
| 2604 | |||||||
| 2605 | my $operation = Arithmetic::PaperAndPencil->new; | ||||||
| 2606 | my $x = Arithmetic::PaperAndPencil::Number->new(value => '355000000'); | ||||||
| 2607 | my $y = Arithmetic::PaperAndPencil::Number->new(value => '113'); | ||||||
| 2608 | |||||||
| 2609 | $operation->division(dividend => $x, divisor => $y); | ||||||
| 2610 | my $html = $operation->html(lang => 'fr', silent => 0, level => 3); | ||||||
| 2611 | open my $fh, '>', 'division.html' or die "opening file $!"; | ||||||
| 2612 | print $fh $html; | ||||||
| 2613 | close $fh or die "closing file $!"; | ||||||
| 2614 | |||||||
| 2615 | $operation = Arithmetic::PaperAndPencil->new; # emptying previous content | ||||||
| 2616 | my $dead = Arithmetic::PaperAndPencil::Number->new(value => 'DEAD', radix => 16); | ||||||
| 2617 | my $beef = Arithmetic::PaperAndPencil::Number->new(value => 'BEEF', radix => 16); | ||||||
| 2618 | |||||||
| 2619 | $operation.addition($dead, $beef); | ||||||
| 2620 | $html = $operation.html(lang => 'fr', silent => 0, level => 3); | ||||||
| 2621 | open $fh, '>', 'addition.html' or die "opening file $!"; | ||||||
| 2622 | print $fh $html; | ||||||
| 2623 | close $fh or die "closing file $!"; | ||||||
| 2624 | |||||||
| 2625 | The first HTML file ends with | ||||||
| 2626 | |||||||
| 2627 | 355000000|113 | ||||||
| 2628 | 0160 |--- | ||||||
| 2629 | 0470 |3141592 | ||||||
| 2630 | 0180 | | ||||||
| 2631 | 0670 | | ||||||
| 2632 | 1050 | | ||||||
| 2633 | 0330| | ||||||
| 2634 | 104| | ||||||
| 2635 | |||||||
| 2636 | and the second one with | ||||||
| 2637 | |||||||
| 2638 | DEAD | ||||||
| 2639 | BEEF | ||||||
| 2640 | ----- | ||||||
| 2641 | 19D9C | ||||||
| 2642 | |||||||
| 2643 | |||||||
| 2644 | =head1 DESCRIPTION | ||||||
| 2645 | |||||||
| 2646 | Arithmetic::PaperAndPencil is a module which allows simulating the | ||||||
| 2647 | paper and pencil techniques for basic arithmetic operations on | ||||||
| 2648 | integers: addition, subtraction, multiplication and division, but also | ||||||
| 2649 | square root extraction and conversion from a radix to another. | ||||||
| 2650 | |||||||
| 2651 | An object from the C |
||||||
| 2652 | "paper sheet", because it represents a paper sheet on which the | ||||||
| 2653 | simulated human scribbles his computations. In some cases, the human | ||||||
| 2654 | would use a wad of sheets instead of a single sheet. This is simulated | ||||||
| 2655 | in the module, but we still call the object a "paper sheet". | ||||||
| 2656 | |||||||
| 2657 | =head2 Problems, known bugs and acceptable breaks from reality | ||||||
| 2658 | |||||||
| 2659 | Most humans can only compute in radix 10. Some persons have a | ||||||
| 2660 | theoretical knowledge of numeric bases other than 10, and a limited | ||||||
| 2661 | practical skill of using radix 2, radix 8 and radix 16. The module | ||||||
| 2662 | uses any radix from 2 to 36, without difference. | ||||||
| 2663 | |||||||
| 2664 | The module can use numbers of any length. Human beings will not be | ||||||
| 2665 | able to multiply two 100-digit numbers. Or if they try, they will | ||||||
| 2666 | spend much effort and the result may be wrong. The module can easily | ||||||
| 2667 | multiply two 100-digit numbers. The output may be lengthy and boring, | ||||||
| 2668 | but it will be correct. | ||||||
| 2669 | |||||||
| 2670 | Humans can detect situations where the computation procedure can be | ||||||
| 2671 | amended, such as a multiplication where the multiplicand and the | ||||||
| 2672 | multiplier contain many "0" digits. The module does not detect these | ||||||
| 2673 | cases and still uses the unaltered computation procedure. | ||||||
| 2674 | |||||||
| 2675 | Human beings write their calculations on A4 paper (21 cm × 29,7 cm) or | ||||||
| 2676 | letter paper (21,6 cm × 27,9 cm). The module writes its calculations | ||||||
| 2677 | on unlimited sheets of paper. If you want to compute the product of | ||||||
| 2678 | two 1000-digit numbers, the multiplication will have a 2000-char width | ||||||
| 2679 | and a 1000-line height and still be on a single sheet of paper. | ||||||
| 2680 | |||||||
| 2681 | If you ask for the operations with the "talking" formulas, most of | ||||||
| 2682 | these formulas are the traditional sentences which accompanies the | ||||||
| 2683 | writing of the computation. But in some cases, the module displays a | ||||||
| 2684 | non-standard sentence, to explain better what is happening. | ||||||
| 2685 | |||||||
| 2686 | =head1 EXPORT | ||||||
| 2687 | |||||||
| 2688 | None. | ||||||
| 2689 | |||||||
| 2690 | =head1 UTILITY METHODS | ||||||
| 2691 | |||||||
| 2692 | =head2 new | ||||||
| 2693 | |||||||
| 2694 | Creates an empty paper sheet. Or removes the content of an already | ||||||
| 2695 | existing paper sheet. | ||||||
| 2696 | |||||||
| 2697 | =head2 from_csv | ||||||
| 2698 | |||||||
| 2699 | Creates a paper sheet containing the operations listed in the | ||||||
| 2700 | parameter CSV string. | ||||||
| 2701 | |||||||
| 2702 | =head2 csv | ||||||
| 2703 | |||||||
| 2704 | Generates a string with a CSV format and listing all operations stored | ||||||
| 2705 | in the sheet object. The opposite of C |
||||||
| 2706 | printed into a CSV file for later retrieval. | ||||||
| 2707 | |||||||
| 2708 | =head2 html | ||||||
| 2709 | |||||||
| 2710 | Generates a string using the HTML format. | ||||||
| 2711 | |||||||
| 2712 | For a properly formatted HTML file, the module user should provide the | ||||||
| 2713 | beginning of the file, from the C<< >> tag until the C<< | ||||||
| 2714 | >> tag, and then the end of the file, with the C<< >> | ||||||
| 2715 | tags. | ||||||
| 2716 | |||||||
| 2717 | The parameters are the following: | ||||||
| 2718 | |||||||
| 2719 | =over 4 | ||||||
| 2720 | |||||||
| 2721 | =item * C |
||||||
| 2722 | |||||||
| 2723 | The language for the titles and messages. The C<"fr"> language is | ||||||
| 2724 | fully specified, and the C<"en"> language is still incomplete. For the | ||||||
| 2725 | moment, there are no other languages. | ||||||
| 2726 | |||||||
| 2727 | =item * C |
||||||
| 2728 | |||||||
| 2729 | Boolean parameter controlling the display of the "spoken" messages. If | ||||||
| 2730 | C<1>, only the titles are displayed. It C<0>, all messages are | ||||||
| 2731 | displayed. | ||||||
| 2732 | |||||||
| 2733 | =item * C |
||||||
| 2734 | |||||||
| 2735 | Integer parameter controlling the display of partial operations. If | ||||||
| 2736 | C<0>, only the final complete operation is shown. If C<1>, each sheet | ||||||
| 2737 | is displayed upon switching to another sheet (when using a wad of | ||||||
| 2738 | sheets). If C<2> or more, partial operations are displayed. The higher | ||||||
| 2739 | the parameter, the more often the partial operations are displayed. | ||||||
| 2740 | |||||||
| 2741 | =item * C |
||||||
| 2742 | |||||||
| 2743 | Overrides the default HTML formatting. This is a hash table, with | ||||||
| 2744 | entries among C |
||||||
| 2745 | If an entry exists, the default format is replaced by C<< | ||||||
| 2746 | style='xxx'> >>. Exception: if the C |
||||||
| 2747 | messages are formatted with C<< >>. |
||||||
| 2748 | |||||||
| 2749 | =back | ||||||
| 2750 | |||||||
| 2751 | =head1 ARITHMETIC METHODS | ||||||
| 2752 | |||||||
| 2753 | All these methods return a C |
||||||
| 2754 | instance, equal to the result of the operation. Unless specified | ||||||
| 2755 | otherwise, all input C |
||||||
| 2756 | must have the same numeric radix. | ||||||
| 2757 | |||||||
| 2758 | =head2 addition | ||||||
| 2759 | |||||||
| 2760 | Simulates the addition of two or more numbers. The numbers are given | ||||||
| 2761 | as a list variable C<@list> or a list of scalar variables C<$nb1, | ||||||
| 2762 | $nb2, $nb3>. This is a positional parameter. Each number is an | ||||||
| 2763 | instance of the C |
||||||
| 2764 | |||||||
| 2765 | =head2 subtraction | ||||||
| 2766 | |||||||
| 2767 | Simulates the subtraction of two numbers, instances of the | ||||||
| 2768 | C |
||||||
| 2769 | and C |
||||||
| 2770 | C |
||||||
| 2771 | |||||||
| 2772 | A third keyword parameter is C |
||||||
| 2773 | choose between a standard subtraction (parameter value C<"std">, | ||||||
| 2774 | default value) and a subtraction using the radix-complement of the low | ||||||
| 2775 | number (parameter value C<"compl">). | ||||||
| 2776 | |||||||
| 2777 | Acceptable break from reality. When using the C<"compl"> variant, the | ||||||
| 2778 | module will write the extra digit and then strike it, while the human | ||||||
| 2779 | computer will stop before writing this extra digit, especially in the | ||||||
| 2780 | context of assembly programming, where for example the registers hold | ||||||
| 2781 | 32 bits, not 33. | ||||||
| 2782 | |||||||
| 2783 | =head2 multiplication | ||||||
| 2784 | |||||||
| 2785 | Simulates the multiplication of two numbers. The keyword parameters | ||||||
| 2786 | are: | ||||||
| 2787 | |||||||
| 2788 | =over 4 | ||||||
| 2789 | |||||||
| 2790 | =item * C |
||||||
| 2791 | |||||||
| 2792 | The two numbers to be multiplied, instances of C |
||||||
| 2793 | |||||||
| 2794 | =item * C |
||||||
| 2795 | |||||||
| 2796 | Specifies the variant technique. This parameter is a string value. The | ||||||
| 2797 | default variant is C<'std'>. Other values are C<'jalousie-A'>, | ||||||
| 2798 | C<'jalousie-B'>, C<'boat'> or C<'russian'> (see below). | ||||||
| 2799 | |||||||
| 2800 | =item * C |
||||||
| 2801 | |||||||
| 2802 | This parameter is used with the C<'boat'> type. Value C<'ltr'> | ||||||
| 2803 | (default value) specifies that the elementary products are processed | ||||||
| 2804 | left-to-right, value C<'rtl'> specifies that these products are | ||||||
| 2805 | processed right-to-left. This applies only to processing the | ||||||
| 2806 | multiplier's digits. Whatever the value, the digits of the | ||||||
| 2807 | multiplicand are processed left-to-right. | ||||||
| 2808 | |||||||
| 2809 | This parameter has no use with C<'std'>, C<'jalousie-A'>, | ||||||
| 2810 | C<'jalousie-B'> and C<'russian'> types. | ||||||
| 2811 | |||||||
| 2812 | =item * C |
||||||
| 2813 | |||||||
| 2814 | This parameter is used with the C<'boat'> type. Value C<'separate'> | ||||||
| 2815 | (default value) means that in a first phase, the digits resulting from | ||||||
| 2816 | the elementary multiplications are written and that in a second phase | ||||||
| 2817 | these digits are added together to obtain the final result. Value | ||||||
| 2818 | C<'combined'> means that as soon as a elementary product is computed, | ||||||
| 2819 | its digits are added to the running sum which will become the final | ||||||
| 2820 | full product at the end. | ||||||
| 2821 | |||||||
| 2822 | This parameter has no use with C<'std'>, C<'jalousie-A'>, | ||||||
| 2823 | C<'jalousie-B'> and C<'russian'> types. | ||||||
| 2824 | |||||||
| 2825 | =item * C |
||||||
| 2826 | |||||||
| 2827 | This parameter is used with the C<"jalousie-*"> types. Value | ||||||
| 2828 | C<"L-shaped"> (default value) means that the product is written in two | ||||||
| 2829 | parts, an horizontal one at the bottom of the operation and an | ||||||
| 2830 | vertical one, on the left side of the operation for C<"jalousie-A"> or | ||||||
| 2831 | on the right side for C<"jalousie-B">. Value C<"straight"> means than | ||||||
| 2832 | the product is written horizontaly on the bottom line, even if the | ||||||
| 2833 | bottom line is wider than the rectangle of the operation. | ||||||
| 2834 | |||||||
| 2835 | This parameter has no use with C<'std'>, C<'boat'> and C<'russian'> | ||||||
| 2836 | types. | ||||||
| 2837 | |||||||
| 2838 | =back | ||||||
| 2839 | |||||||
| 2840 | The various types are | ||||||
| 2841 | |||||||
| 2842 | =over 4 | ||||||
| 2843 | |||||||
| 2844 | =item * C |
||||||
| 2845 | |||||||
| 2846 | The standard multiplication. | ||||||
| 2847 | |||||||
| 2848 | Acceptable break from reality: remember that the successive partial | ||||||
| 2849 | products shifts by one column. These shifts are materialised with | ||||||
| 2850 | dots. When the multiplier contains a digit C<0>, the line with all | ||||||
| 2851 | zeroes is not printed and the shift is more than one column, with the | ||||||
| 2852 | corresponding number of dots. Example: | ||||||
| 2853 | |||||||
| 2854 | . 628 | ||||||
| 2855 | . 203 | ||||||
| 2856 | . --- | ||||||
| 2857 | . 1884 | ||||||
| 2858 | . 1256.. | ||||||
| 2859 | . ------ | ||||||
| 2860 | . 127484 | ||||||
| 2861 | |||||||
| 2862 | The actual acceptable break from reality happens when the multiplier | ||||||
| 2863 | contains zeroes on the right. In this case, are there dots in the very | ||||||
| 2864 | first line? Or do we write zeroes? See below both cases. | ||||||
| 2865 | |||||||
| 2866 | . 628 628 | ||||||
| 2867 | . 230 230 | ||||||
| 2868 | . --- --- | ||||||
| 2869 | . 1884. 18840 | ||||||
| 2870 | . 1256.. 1256.. | ||||||
| 2871 | . ------ ------ | ||||||
| 2872 | . 144440 144440 | ||||||
| 2873 | |||||||
| 2874 | The module uses the second possibility, writing zeroes on the first line. | ||||||
| 2875 | |||||||
| 2876 | =item * C |
||||||
| 2877 | |||||||
| 2878 | The standard multiplication, but if the multiplier contains repeated | ||||||
| 2879 | digits, the partial products are computed only once. When the same | ||||||
| 2880 | digit appears a second time in the multiplier, the partial product is | ||||||
| 2881 | copied from the first occurrence instead of being recomputed. | ||||||
| 2882 | |||||||
| 2883 | =item * C |
||||||
| 2884 | |||||||
| 2885 | This variant is inspired from the C |
||||||
| 2886 | division. Before starting the multiplication proper, all partial | ||||||
| 2887 | products are preemptively computed. Then, when the multiplication is | ||||||
| 2888 | computed, all partial products are simply copied from the preparation | ||||||
| 2889 | step. | ||||||
| 2890 | |||||||
| 2891 | Acceptable break from reality: there is no evidence that this | ||||||
| 2892 | technique is taught or used. It is just an possible extension to | ||||||
| 2893 | multiplication of the prepared division technique. | ||||||
| 2894 | |||||||
| 2895 | =item * C |
||||||
| 2896 | |||||||
| 2897 | The partial products are written in rectangular form. The multiplicand | ||||||
| 2898 | is written left-to-right on the top side of the rectangle, the | ||||||
| 2899 | multiplier is written top-to-bottom on the right side of the | ||||||
| 2900 | rectangle, the final product is written first, top-to-bottom on the | ||||||
| 2901 | left side of the rectangle and second, left-to-right on the bottom | ||||||
| 2902 | side of the rectangle. For example, the multiplication C<15 × 823 = | ||||||
| 2903 | 12345> gives the following result (omitting the interior of the | ||||||
| 2904 | rectangle): | ||||||
| 2905 | |||||||
| 2906 | . 823 | ||||||
| 2907 | . 1 1 | ||||||
| 2908 | . 2 5 | ||||||
| 2909 | . 345 | ||||||
| 2910 | |||||||
| 2911 | If the C |
||||||
| 2912 | aspect is: | ||||||
| 2913 | |||||||
| 2914 | . 823 | ||||||
| 2915 | . 1 | ||||||
| 2916 | . 5 | ||||||
| 2917 | . 12345 | ||||||
| 2918 | |||||||
| 2919 | Acceptable break from reality: the outlying digits should be centered | ||||||
| 2920 | with respect to the inner grid. The module writes them in a skewed | ||||||
| 2921 | fashion. In addition, the inner vertical and horizontal lines are not | ||||||
| 2922 | drawn. Below left, the theoretical output, below right the simplified | ||||||
| 2923 | output: | ||||||
| 2924 | |||||||
| 2925 | . 8 2 3 8 2 3 | ||||||
| 2926 | . ------------- -------- | ||||||
| 2927 | . |0 /|0 /|0 /| |0/0/0/| | ||||||
| 2928 | . 1| / | / | / |1 1|/8/2/3|1 | ||||||
| 2929 | . |/ 8|/ 2|/ 3| |4/1/1/| | ||||||
| 2930 | . ------------- 2|/0/0/5|5 | ||||||
| 2931 | . |4 /|1 /|1 /| -------- | ||||||
| 2932 | . 2| / | / | / |5 3 4 5 | ||||||
| 2933 | . |/ 0|/ 0|/ 5| | ||||||
| 2934 | . ------------- | ||||||
| 2935 | . 3 4 5 | ||||||
| 2936 | |||||||
| 2937 | |||||||
| 2938 | =item * C |
||||||
| 2939 | |||||||
| 2940 | The partial products are written in rectangular form. The multiplicand | ||||||
| 2941 | is written left-to-right on the top side of the rectangle, the | ||||||
| 2942 | multiplier is written bottom-to-top on the left side of the rectangle, | ||||||
| 2943 | the final product is written first, left-to-right on the bottom side | ||||||
| 2944 | of the rectangle and second, bottom-to-top on the right side of the | ||||||
| 2945 | rectangle. For example, the multiplication C<15 × 823 = 12345> gives | ||||||
| 2946 | the following result (omitting the interior of the rectangle): | ||||||
| 2947 | |||||||
| 2948 | . 823 | ||||||
| 2949 | . 5 5 | ||||||
| 2950 | . 1 4 | ||||||
| 2951 | . 123 | ||||||
| 2952 | |||||||
| 2953 | If the C |
||||||
| 2954 | aspect is: | ||||||
| 2955 | |||||||
| 2956 | . 823 | ||||||
| 2957 | . 5 | ||||||
| 2958 | . 1 | ||||||
| 2959 | . 12345 | ||||||
| 2960 | |||||||
| 2961 | Acceptable break from reality: same as for C<'jalousie-A'>. | ||||||
| 2962 | |||||||
| 2963 | =item * C |
||||||
| 2964 | |||||||
| 2965 | The multiplicand is written between two horizontal lines. The | ||||||
| 2966 | multiplier is written below the bottom line and stricken and rewritten | ||||||
| 2967 | as the multiplication progresses. The partial products are written | ||||||
| 2968 | above the top line. When the partial products are added, they are | ||||||
| 2969 | stricken and the final product is written above the partial products. | ||||||
| 2970 | |||||||
| 2971 | Acceptable break from reality: I am not sure the explanation from | ||||||
| 2972 | I |
||||||
| 2973 | two parameters, C |
||||||
| 2974 | user to choose which subvariant he prefers. | ||||||
| 2975 | |||||||
| 2976 | =item * C |
||||||
| 2977 | |||||||
| 2978 | Better known as the "Russian peasant multiplication". The multiplier | ||||||
| 2979 | and the multiplicand are written side-by-side. Then, on each line | ||||||
| 2980 | below, the multiplier is halved and the multiplicand is doubled, until | ||||||
| 2981 | the multiplier reaches C<1>. On some lines, the multiplicand is | ||||||
| 2982 | stricken and then the unstricken lines are added together, which gives | ||||||
| 2983 | the final product. | ||||||
| 2984 | |||||||
| 2985 | =back | ||||||
| 2986 | |||||||
| 2987 | =head2 division | ||||||
| 2988 | |||||||
| 2989 | Simulates the division of two numbers. The keyword parameters are: | ||||||
| 2990 | |||||||
| 2991 | =over 4 | ||||||
| 2992 | |||||||
| 2993 | =item * C |
||||||
| 2994 | |||||||
| 2995 | The two numbers to be divided, instances of C |
||||||
| 2996 | |||||||
| 2997 | =item * C |
||||||
| 2998 | |||||||
| 2999 | Specifies the variant technique. This parameter is a string value. The | ||||||
| 3000 | default variant is C<"std">. | ||||||
| 3001 | |||||||
| 3002 | =item * C |
||||||
| 3003 | |||||||
| 3004 | This string parameter can be either C<"quotient"> (default value) or | ||||||
| 3005 | C<"remainder">, or C<"both">. It controls which value is (are) | ||||||
| 3006 | returned by the method to the main programme. | ||||||
| 3007 | |||||||
| 3008 | =item * C |
||||||
| 3009 | |||||||
| 3010 | This string parameter can be either C<"combined"> (default value) or | ||||||
| 3011 | C<"separate">. It controls the computation of the successive partial | ||||||
| 3012 | remainders with a multiplication (quotient digit times full divisor) | ||||||
| 3013 | and a subtraction (from the partial dividend). If C<"combined">, the | ||||||
| 3014 | multiplication and the subtraction are done at the same time, digit | ||||||
| 3015 | per digit. If C<"separate">, the multiplication is done first in full, | ||||||
| 3016 | then the subtraction is done. | ||||||
| 3017 | |||||||
| 3018 | =back | ||||||
| 3019 | |||||||
| 3020 | The various types are | ||||||
| 3021 | |||||||
| 3022 | =over 4 | ||||||
| 3023 | |||||||
| 3024 | =item * C |
||||||
| 3025 | |||||||
| 3026 | The standard division. | ||||||
| 3027 | |||||||
| 3028 | =item * C |
||||||
| 3029 | |||||||
| 3030 | This is the standard division with a twist. The standard division is | ||||||
| 3031 | usually a trial-and-error process in which several candidate digits | ||||||
| 3032 | are tried for each quotient digit. With this technique, the | ||||||
| 3033 | trial-and-error process is cut short and only the successful digit is | ||||||
| 3034 | tried. | ||||||
| 3035 | |||||||
| 3036 | Acceptable break from reality: This is not a real method, this is a | ||||||
| 3037 | convenience method which gives shorter HTML files than what the | ||||||
| 3038 | C<"std"> type generates. | ||||||
| 3039 | |||||||
| 3040 | =item * C |
||||||
| 3041 | |||||||
| 3042 | Before starting the division, the module computes the partial products | ||||||
| 3043 | of the divisor with any single-digit number. These when computing the | ||||||
| 3044 | intermediate remainders, instead of doing a multiplication - | ||||||
| 3045 | subtraction combination, the already known partial product is simply | ||||||
| 3046 | copied from the preparation list then subtracted from the previous | ||||||
| 3047 | intermediate remainder. The C |
||||||
| 3048 | C<"separate"> for this division type. | ||||||
| 3049 | |||||||
| 3050 | =item * C |
||||||
| 3051 | |||||||
| 3052 | The dividend is written above an horizontal line. The divisor is | ||||||
| 3053 | written below this line. As the first partial remainder is computed, | ||||||
| 3054 | the used digits of the dividend and divisor are stricken and the | ||||||
| 3055 | digits of the partial remainder are written above the digits of the | ||||||
| 3056 | dividend. When computing the next digits, the divisor is rewritten and | ||||||
| 3057 | the computation of the next partial remainder again strikes the digits | ||||||
| 3058 | of the first partial remainder and of the second occurrence of the | ||||||
| 3059 | divider. | ||||||
| 3060 | |||||||
| 3061 | Acceptable break from reality: I have not found anywhere an | ||||||
| 3062 | explanation for this technique. The way it is implemented is just some | ||||||
| 3063 | guesswork after some reverse engineering attempt on a few examples. A | ||||||
| 3064 | special point is that it seems to require something similar to the | ||||||
| 3065 | C |
||||||
| 3066 | "unstrike" the digits that were stricken with the previous digit | ||||||
| 3067 | candidate. | ||||||
| 3068 | |||||||
| 3069 | =back | ||||||
| 3070 | |||||||
| 3071 | =head2 square_root | ||||||
| 3072 | |||||||
| 3073 | Simulates the extraction of the square root of a number. There is a | ||||||
| 3074 | single positional parameter, an instance of the | ||||||
| 3075 | C |
||||||
| 3076 | |||||||
| 3077 | There is an optional keyword parameter, C |
||||||
| 3078 | is the same as for division. If set to C<'combined'> (default value), | ||||||
| 3079 | the computing of the product (candidate digit times divisor) is | ||||||
| 3080 | combined with the subtraction from the partial dividend. If set to | ||||||
| 3081 | C<'separate'>, the multiplication and the subtraction are executed in | ||||||
| 3082 | separate and successive phases. | ||||||
| 3083 | |||||||
| 3084 | =head2 conversion | ||||||
| 3085 | |||||||
| 3086 | Simulates the conversion of a number from its current radix to a new | ||||||
| 3087 | radix. | ||||||
| 3088 | |||||||
| 3089 | The parameters are: | ||||||
| 3090 | |||||||
| 3091 | =over 4 | ||||||
| 3092 | |||||||
| 3093 | =item * C |
||||||
| 3094 | |||||||
| 3095 | The number to convert, instance of C |
||||||
| 3096 | |||||||
| 3097 | =item * C |
||||||
| 3098 | |||||||
| 3099 | The destination radix for the conversion. This is a native integer, | ||||||
| 3100 | not an instance of C |
||||||
| 3101 | |||||||
| 3102 | =item * C |
||||||
| 3103 | |||||||
| 3104 | The number of operations on a single page. After this number is | ||||||
| 3105 | reached, a new page is generated. This allows keeping the complete | ||||||
| 3106 | operation sufficiently short. This parameter is a native integer. If | ||||||
| 3107 | zero (default value), no new pages are generated. | ||||||
| 3108 | |||||||
| 3109 | =item * C |
||||||
| 3110 | |||||||
| 3111 | A string parameter specifying which algorithm is used to convert a | ||||||
| 3112 | number. Values C<'mult'> and C<'Horner'> are synonymous and use the | ||||||
| 3113 | cascading multiplication algorithm (or Horner scheme). Value C<'div'> | ||||||
| 3114 | uses the cascading division algorithm. | ||||||
| 3115 | |||||||
| 3116 | =item * C |
||||||
| 3117 | |||||||
| 3118 | A string parameter specifying which kind of division is used: C<'std'> | ||||||
| 3119 | (default value) uses a standard division with a full trial-and-error | ||||||
| 3120 | processing for candidate quotient digits, C<'cheating'> uses a | ||||||
| 3121 | standard division in which the trial-and-error of candidate quotient | ||||||
| 3122 | digits is artificially reduced to a single iteration, C<'prepared'> | ||||||
| 3123 | first computes the list of multiples for the target radix and uses it | ||||||
| 3124 | to openly and accountably reduce the trial-and-error processing to a | ||||||
| 3125 | single iteration. | ||||||
| 3126 | |||||||
| 3127 | This parameter is ignored if the conversion parameter C |
||||||
| 3128 | C<'div'>. | ||||||
| 3129 | |||||||
| 3130 | See the C |
||||||
| 3131 | C<'boat'> value available for the C |
||||||
| 3132 | method is not allowed for the C |
||||||
| 3133 | C |
||||||
| 3134 | |||||||
| 3135 | =item * C |
||||||
| 3136 | |||||||
| 3137 | This parameter is similar to the C |
||||||
| 3138 | C |
||||||
| 3139 | C |
||||||
| 3140 | |||||||
| 3141 | The parameter controls the computation of the successive partial | ||||||
| 3142 | remainders with a multiplication (quotient digit times full divisor) | ||||||
| 3143 | and a subtraction (from the partial dividend). Possible values are | ||||||
| 3144 | C<'combined'> or C<'separate'>. If C<'combined'>, the multiplication | ||||||
| 3145 | and the subtraction are done at the same time, digit per digit. If | ||||||
| 3146 | C<'separate'>, the multiplication is done first in full, then the | ||||||
| 3147 | subtraction is done. | ||||||
| 3148 | |||||||
| 3149 | If the C |
||||||
| 3150 | ignored and the multiplication and the subtraction are done | ||||||
| 3151 | separately. | ||||||
| 3152 | |||||||
| 3153 | If the C |
||||||
| 3154 | parameter is ignored and the multiplication and the subtraction are | ||||||
| 3155 | combined. The reason for this behaviour is to by-pass a bug which | ||||||
| 3156 | would appear in cramped situations where several divisions are crammed | ||||||
| 3157 | side by side. | ||||||
| 3158 | |||||||
| 3159 | =back | ||||||
| 3160 | |||||||
| 3161 | =head2 gcd | ||||||
| 3162 | |||||||
| 3163 | Simulates the computation of the GCD (greatest common divisor) of two | ||||||
| 3164 | numbers. | ||||||
| 3165 | |||||||
| 3166 | The parameters are: | ||||||
| 3167 | |||||||
| 3168 | =over 4 | ||||||
| 3169 | |||||||
| 3170 | =item * C |
||||||
| 3171 | |||||||
| 3172 | The first number used, instance of C |
||||||
| 3173 | |||||||
| 3174 | =item * C |
||||||
| 3175 | |||||||
| 3176 | The second number used, instance of C |
||||||
| 3177 | |||||||
| 3178 | =item * C |
||||||
| 3179 | |||||||
| 3180 | A string parameter specifying which kind of division is used: C<"std"> | ||||||
| 3181 | (default value) uses a standard division with a full trial-and-error | ||||||
| 3182 | processing for candidate quotient digits, C<"cheating"> uses a | ||||||
| 3183 | standard division in which the trial-and-error of candidate quotient | ||||||
| 3184 | digits is artificially reduced to a single iteration. | ||||||
| 3185 | |||||||
| 3186 | See the C |
||||||
| 3187 | C<"boat"> and C<"prepared"> values available for the C |
||||||
| 3188 | of the C |
||||||
| 3189 | parameter of the C |
||||||
| 3190 | |||||||
| 3191 | =back | ||||||
| 3192 | |||||||
| 3193 | =head1 BUGS, ISSUES AND ACCEPTABLE BREAKS FROM REALITY | ||||||
| 3194 | |||||||
| 3195 | For the various arithmetical methods, not all parameter combinations | ||||||
| 3196 | are used in real life. This includes especially the C<"cheating"> | ||||||
| 3197 | variants. | ||||||
| 3198 | |||||||
| 3199 | The values assigned to the C |
||||||
| 3200 | consistent and they may lead to awkward listings, in which a boring | ||||||
| 3201 | part is printed in whole detail and an interesting part is printed | ||||||
| 3202 | without enough detail. | ||||||
| 3203 | |||||||
| 3204 | =head1 SECURITY MATTERS | ||||||
| 3205 | |||||||
| 3206 | As said above, the numbers are not limited in length. The flip side is | ||||||
| 3207 | that the user can ask for the multiplication of two 1000-digit | ||||||
| 3208 | numbers, which means several millions of basic actions (single-digit | ||||||
| 3209 | multiplications, basic additions, etc). This can lead to a DOS-like | ||||||
| 3210 | situation: filled-up memory, clogged CPU for example. | ||||||
| 3211 | |||||||
| 3212 | Another issue is the initialisation of a C |
||||||
| 3213 | object with a CSV file. The content of the CSV file is not checked. | ||||||
| 3214 | This can result is line and column coordinates ranging in the | ||||||
| 3215 | thousands or beyond. In this case, the C method will build a | ||||||
| 3216 | huge string result. | ||||||
| 3217 | |||||||
| 3218 | =head1 SEE ALSO | ||||||
| 3219 | |||||||
| 3220 | The background of this module is extensively described in the Github repository | ||||||
| 3221 | of the Raku module with the same name. See | ||||||
| 3222 | L |
||||||
| 3223 | (or L |
||||||
| 3224 | if you speak French). | ||||||
| 3225 | |||||||
| 3226 | Raku module similar to this one: | ||||||
| 3227 | L |
||||||
| 3228 | |||||||
| 3229 | HP48 / HP49 programme dealing with divisions: | ||||||
| 3230 | L |
||||||
| 3231 | |||||||
| 3232 | =head1 DEDICATION | ||||||
| 3233 | |||||||
| 3234 | This module is dedicated to my primary school teachers, who taught me | ||||||
| 3235 | the basics of arithmetics, and even some advanced features, and to my | ||||||
| 3236 | secondary school math teachers, who taught me other advanced math | ||||||
| 3237 | concepts and features. | ||||||
| 3238 | |||||||
| 3239 | |||||||
| 3240 | =head1 AUTHOR | ||||||
| 3241 | |||||||
| 3242 | jforget, C<< |
||||||
| 3243 | |||||||
| 3244 | =head1 BUGS | ||||||
| 3245 | |||||||
| 3246 | Please report any bugs or feature requests to C |
||||||
| 3247 | the web interface at L |
||||||
| 3248 | automatically be notified of progress on your bug as I make changes. | ||||||
| 3249 | |||||||
| 3250 | =head1 SUPPORT | ||||||
| 3251 | |||||||
| 3252 | You can find documentation for this module with the perldoc command. | ||||||
| 3253 | |||||||
| 3254 | perldoc Arithmetic::PaperAndPencil | ||||||
| 3255 | |||||||
| 3256 | You can also look for information at: | ||||||
| 3257 | |||||||
| 3258 | =over 4 | ||||||
| 3259 | |||||||
| 3260 | =item * RT: CPAN's request tracker (report bugs here) | ||||||
| 3261 | |||||||
| 3262 | L |
||||||
| 3263 | |||||||
| 3264 | =item * CPAN Ratings | ||||||
| 3265 | |||||||
| 3266 | L |
||||||
| 3267 | |||||||
| 3268 | =item * Search CPAN | ||||||
| 3269 | |||||||
| 3270 | L |
||||||
| 3271 | |||||||
| 3272 | =back | ||||||
| 3273 | |||||||
| 3274 | |||||||
| 3275 | =head1 ACKNOWLEDGEMENTS | ||||||
| 3276 | |||||||
| 3277 | |||||||
| 3278 | =head1 LICENSE AND COPYRIGHT | ||||||
| 3279 | |||||||
| 3280 | This software is Copyright (c) 2024 by jforget. | ||||||
| 3281 | |||||||
| 3282 | This is free software, licensed under: | ||||||
| 3283 | |||||||
| 3284 | The Artistic License 2.0 (GPL Compatible) | ||||||
| 3285 | |||||||
| 3286 | |||||||
| 3287 | =cut | ||||||
| 3288 |