diff --git a/2023/Makefile b/2023/Makefile index dbcbe70..6941176 100644 --- a/2023/Makefile +++ b/2023/Makefile @@ -2,7 +2,7 @@ FC:=gfortran FFLAGS:=-Wall -Wno-maybe-uninitialized BIN:=./bin SRC:=./src -BINS:=./bin/day01.bin ./bin/day01b.bin ./bin/day02.bin ./bin/day03.bin ./bin/day04.bin ./bin/day05.bin ./bin/day05b.bin ./bin/day06.bin +BINS:=./bin/day01.bin ./bin/day01b.bin ./bin/day02.bin ./bin/day03.bin ./bin/day04.bin ./bin/day05.bin ./bin/day05b.bin ./bin/day06.bin ./bin/day07.bin ./bin/day07b.bin all: aoc19 diff --git a/2023/data/day07.txt b/2023/data/day07.txt new file mode 100644 index 0000000..b5ee485 --- /dev/null +++ b/2023/data/day07.txt @@ -0,0 +1,1001 @@ +K43AT 328 +AAQ2A 410 +45452 995 +T9999 645 +J7737 326 +4TT46 891 +A3AAT 565 +ATTTJ 793 +K2TJK 441 +6J66K 640 +QQQQ7 582 +K596A 203 +48544 862 +74AJQ 103 +J333J 895 +737T4 472 +26226 863 +QQQ7A 959 +6K5J6 257 +7QAT8 10 +4K9KT 894 +TTT66 720 +57874 13 +QJ64Q 536 +8444Q 497 +46K62 642 +Q4444 256 +75K96 984 +TQJ38 237 +Q7286 460 +A2255 985 +66464 661 +32J22 294 +2T22T 880 +2AJJJ 643 +555TT 637 +7T73T 519 +3786T 124 +JT2T2 735 +K4KKK 982 +A8TT4 526 +KK8TJ 334 +54A69 554 +6KK46 912 +T7JQT 766 +99399 437 +5TJ5J 842 +QQ99T 719 +3A9QK 715 +T9TT5 684 +A7A7A 394 +A9559 883 +J2662 50 +5J2A4 44 +636Q6 319 +96K93 937 +4KKJK 924 +AA4AA 555 +AJ695 755 +63T34 476 +K7K47 644 +66K69 166 +K556Q 404 +37249 748 +77JJ9 331 +JJ655 493 +QAKA2 350 +Q7QQK 243 +A6745 363 +QTJTT 538 +44QQ4 529 +666J3 115 +TQ72A 710 +Q5777 457 +4TTJ6 773 +JJ3J6 786 +AA955 911 +4JA44 198 +Q883J 517 +J9933 199 +8453J 349 +6646Q 846 +75J8J 761 +A7A7J 596 +2J993 228 +32636 137 +Q928J 778 +KKKJJ 960 +4466J 929 +775QQ 280 +7T476 749 +979KK 355 +35373 218 +K7788 392 +25K69 289 +74776 882 +A58T2 898 +2A22A 377 +TKT78 545 +K752T 253 +77779 945 +996AA 650 +QQ3A3 859 +K6J87 626 +K22K3 765 +TT37T 94 +372K3 212 +48887 525 +2676T 72 +977A3 641 +3J67K 111 +A6388 118 +3K359 993 +AA8AA 379 +J66J6 841 +2222J 1000 +T757J 117 +99J9T 772 +88846 475 +29J28 572 +77J72 900 +A8QAK 904 +T4KJK 621 +T44TJ 140 +JK9KK 593 +849TJ 828 +59794 486 +3K5QA 318 +K2J98 11 +77744 421 +2K279 231 +6Q3QT 79 +3A999 271 +3QT79 119 +T4598 840 +666T8 717 +9JJ99 811 +QQQKK 671 +QTQQT 303 +86666 605 +47AA3 482 +52525 816 +4Q2Q4 722 +77224 609 +78688 976 +7QKA9 865 +9Q99T 989 +5342A 279 +9Q35K 999 +777AQ 764 +AJ43Q 143 +QQQQ8 744 +2Q3J9 61 +KKK99 779 +KK8KK 966 +TQ839 51 +J5JA5 148 +4942T 725 +AT999 732 +62666 499 +89725 468 +3J566 953 +Q9A58 711 +9QQ5Q 413 +78J57 726 +945TA 921 +KKAT3 938 +3A433 654 +8AA82 88 +77KK7 430 +3T777 728 +QK32T 190 +6J638 708 +QTQJA 632 +KT5A9 221 +79KT8 879 +AT474 18 +77867 756 +99799 815 +A52T4 777 +3K9J4 562 +66QQ8 730 +888AJ 351 +K68KK 49 +44442 905 +Q3A52 304 +66AT9 681 +AQ44J 838 +T6TT8 739 +JA5KK 638 +82Q2J 785 +84665 411 +8K4J4 100 +6936K 664 +7J799 474 +QKQ8K 690 +929J4 860 +6747Q 780 +QKQTQ 979 +53JQ3 635 +T54Q7 43 +9876K 301 +57555 511 +A7777 933 +7533A 121 +T77TT 378 +94977 876 +44K9Q 758 +999A9 930 +99TTT 104 +J8243 375 +QQ2Q2 947 +QAQ99 789 +22A24 91 +9TJK9 733 +666J6 267 +444T3 611 +AA4JJ 194 +888A8 568 +4Q723 804 +5T565 150 +AA23A 347 +9725Q 122 +TT8T8 234 +A9445 342 +A2288 67 +99Q44 167 +3K688 600 +6QQQK 653 +T5J34 423 +3K5T4 868 +8J99A 515 +37T8K 383 +J4T85 182 +Q7644 449 +QQ4TQ 471 +56464 824 +6J85Q 798 +4Q6QQ 986 +8864K 613 +22422 415 +T22T4 695 +6J633 574 +479AK 175 +8JAQ4 397 +5J5T8 662 +A7J99 594 +85688 391 +A3TJ6 204 +J3T33 546 +Q777J 539 +6KJTJ 812 +8TT55 660 +3Q23Q 128 +J7JJ7 585 +6T6J6 837 +5288T 964 +4J34A 767 +77K37 797 +6A665 866 +49A6J 856 +Q9QQ8 261 +QJ9JQ 158 +T5363 75 +QT994 528 +A3335 184 +QAAAA 296 +22886 672 +2922J 110 +99K99 325 +23243 967 +AA545 361 +24443 324 +J258Q 239 +7685Q 731 +T7TKK 281 +QQQTJ 429 +8J828 552 +J8484 21 +3J27A 564 +2A5T9 750 +A3QT5 154 +599J5 245 +KK7A8 71 +8888K 485 +2K859 6 +98959 922 +6J669 123 +A5552 452 +QQA6K 649 +QTQQQ 81 +Q97KK 808 +82276 845 +T6Q36 788 +5TJTT 387 +77787 108 +Q39A2 287 +66Q6Q 896 +89635 197 +TT2TJ 120 +4AA2A 560 +99KK9 534 +KK3KK 479 +65698 330 +KJ63K 775 +K6676 442 +K2226 698 +KJ444 877 +42442 802 +KK8K3 220 +88555 942 +4QQ74 87 +35959 899 +A5736 64 +A8629 941 +2TA8Q 706 +87627 250 +AA6J3 676 +47442 492 +6QJ66 507 +8K3TQ 109 +Q7777 697 +AAAA3 412 +4999A 74 +996K9 498 +323KK 522 +355JA 978 +TK2A7 864 +A9JAQ 5 +5576T 713 +Q272Q 312 +877KK 89 +K6666 658 +J876Q 368 +A63K8 336 +83AAT 106 +6TQ82 373 +7JQQQ 782 +JKTT3 834 +QQ999 129 +3AK6Q 601 +J7TJ7 200 +TK999 185 +76333 907 +JAAAA 57 +5T7T5 37 +QAQ3Q 807 +2666T 406 +4TT43 501 +84484 22 +9T99T 651 +T8675 965 +9276A 848 +98J98 776 +T2299 40 +KTATA 162 +A4K5K 179 +8888J 473 +A554K 420 +999AJ 783 +9696T 367 +KK9KK 56 +TA9AT 892 +AT7T7 38 +T3T3T 530 +23A9T 634 +QA4K2 241 +88K68 362 +T4J9Q 193 +K9T72 52 +76566 92 +9JT67 3 +3Q468 768 +4285K 206 +J28K6 285 +6J86Q 159 +A4925 521 +J5525 531 +A5A55 366 +5968T 818 +44454 320 +8QK88 962 +99996 791 +4A44A 284 +97T48 146 +39T89 686 +3497K 298 +4224T 209 +AAA3K 615 +22795 628 +2QJQQ 141 +35999 73 +73337 32 +49999 403 +JJJJ3 665 +89K74 63 +Q76K2 157 +6868J 171 +J8JJ8 853 +3TJ56 869 +42TA6 682 +33633 337 +AJQ58 135 +3J388 164 +7Q6T2 909 +6TAQT 483 +33379 327 +833AA 332 +885QJ 177 +39522 908 +93JQK 15 +323K2 236 +28A5A 384 +J99JJ 558 +4Q4QQ 360 +38A95 210 +43344 746 +3J589 288 +JJ8JJ 28 +23223 436 +TAA58 149 +2227J 414 +QQQA4 356 +A6456 754 +34444 131 +83K6K 310 +37233 41 +A7797 84 +62426 333 +2A822 569 +KAAKK 358 +T2AJ6 901 +6J822 729 +8J86J 652 +A935K 247 +TTKT3 998 +8ATAT 12 +K5622 170 +8QQ8Q 30 +82288 524 +Q4T94 445 +TAAA2 506 +7A79Q 663 +AT94K 292 +J6937 659 +5343A 694 +43JT6 851 +K4334 700 +3K3K3 607 +AJ2JA 980 +AA4AJ 422 +4K444 448 +768TJ 743 +A5AJA 35 +A33AJ 971 +KA662 952 +226Q2 113 +488Q8 295 +633T3 481 +J22K2 861 +388J8 101 +3Q524 152 +96J69 466 +882T3 315 +56J8T 258 +AAJ22 418 +Q722T 306 +3Q334 969 +A9K99 455 +AT4J3 857 +5QKA9 29 +2KKK2 242 +74433 251 +96K69 843 +KJJ5K 86 +576K8 692 +27TTA 470 +66JK9 240 +4T6Q7 496 +65T99 925 +3AT53 693 +5KTK9 931 +Q4999 855 +3QQ8Q 854 +5555T 114 +55J66 884 +7777J 409 +2JKJ5 795 +75755 23 +444JJ 308 +5JKJ5 701 +72Q77 93 +28Q28 639 +2A257 438 +95KJ4 484 +QTQ39 890 +8JK8K 195 +999KQ 463 +64JQ6 648 +49444 796 +999A8 439 +9J229 277 +22Q6Q 345 +QQ2QQ 557 +AQ45K 836 +8T3KJ 918 +8KKTK 2 +J5T55 238 +K4663 794 +QQAQQ 216 +225K5 927 +32658 389 +92276 477 +63K9T 603 +58Q32 232 +8AK52 973 +KQKQK 323 +88592 656 +22223 395 +K4TT4 354 +46KK3 850 +5T53T 163 +44996 858 +3J3K3 7 +QQ2Q4 630 +9QA2K 136 +Q5KQQ 677 +JJJJJ 974 +55475 737 +6AK5Q 736 +Q4454 997 +T8282 144 +K3333 810 +92929 59 +K44KT 427 +7A774 889 +96996 902 +79QQ9 39 +A73A3 670 +44644 224 +2Q54Q 311 +56555 724 +783J7 19 +2KKKK 950 +T74K7 799 +64464 370 +J6T62 833 +885J8 459 +84J66 617 +77579 408 +2J36T 386 +KTK2K 24 +34334 249 +44489 939 +55955 915 +736QA 58 +4J548 839 +QQQ3Q 800 +57855 934 +K5KAA 270 +A6Q22 262 +2TTTT 398 +75A2Q 759 +J2529 575 +99373 16 +78355 981 +JA587 769 +AA38Q 255 +22A77 903 +89999 827 +6JT7T 913 +A59JK 872 +6QAQA 542 +98J99 712 +K4TTQ 520 +699J9 138 +39JJT 757 +A2TJ5 419 +Q8647 96 +JT779 619 +7T5TT 417 +A433A 685 +KTJKT 707 +29T73 679 +KKAKK 31 +72758 181 +TTATT 348 +65Q7T 467 +K8222 98 +QK5KK 504 +44QJQ 259 +6T475 709 +52589 33 +58898 631 +59535 741 +4J8KK 20 +TQQTT 132 +8KT6T 784 +Q33KK 291 +T9QT5 897 +3983J 127 +73A33 556 +J2452 718 +7465Q 886 +89899 935 +6TJA6 544 +79797 447 +89J77 571 +35333 518 +7478K 875 +6TQJ4 595 +636K5 747 +QJQ5A 156 +76776 165 +45588 822 +2T6A9 622 +333QQ 273 +9J888 563 +J2577 451 +6A8J3 847 +33J33 364 +J6TA8 689 +83333 916 +9473T 371 +8397A 516 +8352K 264 +38J8J 509 +93696 523 +69JJ7 464 +T6KK2 357 +734AQ 340 +QA6AA 461 +K2AKK 443 +74TA3 987 +52TJ7 961 +67992 321 +A2972 830 +9JQ9Q 625 +TTTT4 727 +TQ898 958 +2222K 610 +8346J 508 +9ATTT 540 +J4464 655 +4JAA3 189 +73669 762 +54445 983 +39QKQ 316 +6777Q 948 +ATAAA 893 +T5KTK 388 +62KKK 77 +58647 307 +5JA88 83 +9J944 183 +5J274 133 +44K4K 920 +4TTA9 54 +AA9A6 940 +KTKTK 592 +399Q2 399 +6JQQQ 573 +A2955 233 +37Q8T 274 +QTKTT 376 +9KT59 577 +KK3Q4 598 +99595 322 +3Q339 225 +65J55 201 +AQTQQ 874 +5667J 936 +TJ8Q2 829 +T6Q45 910 +KQ4AK 380 +8AQQJ 770 +28838 402 +JAAAJ 752 +A5AA5 4 +86886 34 +46494 551 +963J5 76 +773A7 814 +67794 505 +4KJ4K 559 +J8585 230 +KT3K6 618 +23QJ8 47 +QQ464 69 +96J9Q 469 +55777 714 +J2K58 227 +K24Q2 774 +888KJ 352 +Q3TQQ 647 +K3JA4 365 +J4TKQ 548 +88J4J 78 +9J44J 489 +22525 297 +QQ9QQ 42 +2222A 82 +5A4A4 988 +K6479 36 +A2AAA 597 +6J664 699 +85555 70 +77Q7Q 222 +AA5AA 541 +QQQQJ 612 +555J5 512 +44AA3 763 +65635 45 +JKKK5 871 +T3733 949 +JQK7Q 226 +Q4QQQ 126 +47AAA 214 +7T345 673 +73862 465 +5555A 994 +AA54K 787 +KK7K7 951 +Q5585 579 +84444 314 +7333K 283 +A37JK 68 +9QA36 53 +9T78T 172 +9J567 809 +KQQ6K 26 +J7882 444 +J5TKT 490 +QQQ97 992 +TTKTT 208 +6T666 211 +72977 266 +73AT9 532 +Q5KJ2 723 +AK4AA 852 +8QJQJ 820 +73383 426 +6K4A8 260 +88222 514 +832QQ 275 +77KQ7 491 +68J88 721 +46484 153 +55552 282 +8T3Q8 627 +7KQKQ 944 +T9Q84 390 +22775 771 +TKT72 604 +74QQQ 217 +5Q44Q 196 +J2TK3 881 +J88J8 305 +72777 268 +K3KKJ 400 +222TJ 329 +J3437 527 +27QAK 696 +K7676 272 +2A22K 578 +537J2 955 +777T7 926 +5K36A 646 +T2Q95 570 +27727 65 +T885T 688 +25442 602 +Q6Q7Q 543 +875K8 586 +78K3K 107 +KTKTQ 450 +555JJ 620 +TQAJJ 792 +6977Q 813 +65696 943 +J3563 956 +5KKKK 977 +88A6A 887 +AA22A 335 +Q8AQQ 405 +4JATK 702 +A6888 567 +J765T 487 +2Q4A6 478 +JK979 510 +44T27 278 +35323 751 +A7AAA 431 +8QT82 826 +QTJ86 928 +3J773 691 +K58J8 970 +88442 160 +A3AA9 633 +6AJ55 142 +QKKQ9 178 +93TJ7 805 +389A2 97 +4373A 95 +7Q784 359 +7KJ77 393 +74J4K 14 +94TTT 968 +3QA3K 248 +66944 48 +QQKQQ 823 +AA5A7 446 +5JT22 745 +T694K 738 +Q956Q 705 +34333 675 +8T88T 17 +2T3TJ 576 +5A578 186 +4848Q 549 +T322T 566 +77775 112 +QJ599 85 +AQKQA 229 +78Q77 678 +3K9K7 831 +55524 338 +A333A 932 +JJ222 191 +JJKJQ 313 +69669 500 +33322 513 +T7TTT 781 +A44JJ 580 +2QJ8J 276 +KA7A6 803 +346KT 401 +853Q7 906 +AA6A6 666 +3QA43 9 +28J25 244 +8686A 134 +KA88A 62 +K9888 535 +4T7KA 219 +KKK6K 996 +9T994 435 +K8KQK 174 +QQAA4 246 +5K5JK 588 +QJ875 957 +46358 919 +3A393 954 +7JKK7 972 +2QKK2 716 +TKJ9K 151 +66646 703 +5KJT2 369 +7KJK8 372 +A8A8A 169 +AAA9A 187 +TT55T 878 +44654 587 +Q6QQQ 90 +7AAJA 923 +6TTTJ 674 +66676 339 +88894 870 +Q2K48 533 +TTTT9 130 +763J3 343 +88333 817 +AQ785 704 +QQ5QA 385 +737T9 116 +95595 801 +J84AK 590 +79796 102 +J3TJ4 683 +26299 503 +8T888 867 +53AAJ 608 +2A56J 46 +8955A 381 +J5A55 844 +QJ9J9 636 +44J44 669 +A7JTA 550 +7TT24 317 +57A55 396 +J3JK3 55 +3TT33 888 +84JJ6 583 +3362T 547 +49494 176 +88858 173 +6KKJ6 614 +QK662 623 +Q4223 302 +397J5 147 +J5A9T 454 +9TT2T 145 +98T85 599 +86JQ2 433 +KQ977 806 +7T6T5 1 +72QQQ 873 +KTJKK 66 +77578 161 +TQ8T8 60 +AA25A 963 +T2AA4 382 +6T52J 346 +KK55A 494 +A4A4A 680 +55454 125 +49QQQ 657 +K6J9Q 290 +77J7J 155 +5AAJ5 687 +KQJ68 606 +88898 667 +29J27 616 +TJTTT 946 +46828 269 +2T28T 188 +787K7 293 +55223 254 +T6QT6 581 +TTA6A 825 +252AA 252 +JKQKK 205 +88585 819 +TT8TT 914 +K87T5 425 +KQKKK 416 +K9K74 263 +89627 624 +94889 537 +K96AQ 502 +Q77JA 991 +66367 849 +92922 760 +KAT4K 480 +ATTAA 553 +J4447 432 +63T5T 440 +282J2 192 +JKKKK 753 +6A74K 25 +46747 407 +TT3J9 299 +5KKK9 80 +6TA22 353 +T5795 265 +24TK9 202 +5Q555 207 +T5A45 341 +2K24J 742 +AJA9A 8 +45555 456 +88699 668 +66Q86 344 +AAA85 99 +7736T 591 +A6Q6Q 223 +A252J 589 +TTTKK 309 +77AAK 458 +68A9K 629 +6TK66 300 +2J242 885 +TAA68 488 +2Q72J 734 +936KA 213 +59JA4 180 +AA999 105 +843J9 990 +T4T44 215 +4ATAA 561 +J5333 821 +77774 424 +9AA6J 27 +JTJTT 790 +443KK 975 +TT8T9 286 +74Q89 832 +58QTA 453 +39393 917 +88234 740 +Q62AJ 374 +999Q9 235 +8Q828 428 +QJQJQ 462 +2K7TJ 139 +AJ239 835 +29499 434 +97J77 495 +99J99 584 +464J5 168 + diff --git a/2023/data/day07ex1.txt b/2023/data/day07ex1.txt new file mode 100644 index 0000000..e3500c3 --- /dev/null +++ b/2023/data/day07ex1.txt @@ -0,0 +1,5 @@ +32T3K 765 +T55J5 684 +KK677 28 +KTJJT 220 +QQQJA 483 diff --git a/2023/src/day07.f90 b/2023/src/day07.f90 new file mode 100644 index 0000000..d446ca8 --- /dev/null +++ b/2023/src/day07.f90 @@ -0,0 +1,171 @@ +program day7 + implicit none + integer, parameter :: max_chars = 300 + character(200) :: fname + character(max_chars) :: fline + integer :: n_arguments + integer, parameter :: max_hands = 2000 + character(len=5) :: hands(1:max_hands) + integer :: bids(1:max_hands) + integer :: rank(1:max_hands) + integer :: i, i2, n_hands + integer :: istat + integer :: beats, winnings, total_winnings + + n_arguments = command_argument_count() + if (n_arguments .eq. 1) then + call get_command_argument(1, fname) + print *, "File: ", trim(fname) + print * + else + print *, "Wrong number of arguments: ", n_arguments + stop + end if + + + open(10, file=fname) + n_hands = 0 + do i=1, max_hands + read(10, "(a)", iostat = istat) fline + if ((len_trim(fline) .eq. 0) .or. (is_iostat_end(istat))) then + exit + end if + read(fline, *) hands(i), bids(i) + n_hands = n_hands + 1 + end do + close(10) + print *, "Number of hands: ", n_hands + rank = -1 + rank(1) = 1 + print * + do i=2,n_hands + beats = 0 + do i2=1,(i-1) + if (rank_correct(hands(i), hands(i2))) then + ! hand i ranks higher than hand i2 + if (rank(i2) .gt. beats) then + beats = rank(i2) + end if + write(*, 21) i, hands(i), i2, hands(i2) + else + ! hand i ranks lower than hand i2 + rank(i2) = rank(i2) + 1 + write(*, 22) i, hands(i), i2, hands(i2) + end if + end do + rank(i) = beats+1 + end do + print * + total_winnings = 0 + do i=1, n_hands + winnings = bids(i) * rank(i) + write(*, 20) hands(i), bids(i), rank(i), winnings + total_winnings = total_winnings + winnings + end do + print * + print *, "Total winnings: ", total_winnings + +20 format("Hand: ", a5, "; Bid: ", i4, "; Rank: ", i4, "; Winnings: ", i8) +21 format(i4, " (", a5, ") beats ", i4, " (", a5, ")") +22 format(i4, " (", a5, ") beaten by ", i4, " (", a5, ")") + + contains + function hand_type(hand) + character(len=5), intent(in) :: hand + integer :: hand_type + character(len=1) :: dist_cards(1:5) + integer :: card_count(1:5) + integer :: n_dc + integer :: i, i2 + character(len=1) :: this_card + logical :: existing_card + integer :: sets(1:5) + dist_cards = ' ' + card_count = 0 + n_dc = 1 + dist_cards(1) = hand(1:1) + card_count(1) = 1 + do i=2,5 + this_card = hand(i:i) + existing_card = .false. + do i2=1,n_dc + if (dist_cards(i2) .eq. this_card) then + existing_card = .true. + exit + end if + end do + if (existing_card) then + card_count(i2) = card_count(i2) + 1 + else + n_dc = n_dc + 1 + card_count(n_dc) = 1 + dist_cards(n_dc) = this_card + end if + end do + sets = 0 + do i=1,n_dc + sets(card_count(i)) = sets(card_count(i)) + 1 + end do + if (sets(5) .eq. 1) then + ! Five of a kind + hand_type = 7 + else if (sets(4) .eq. 1) then + ! Four of a kind + hand_type = 6 + else if ((sets(3) .eq. 1) .and. (sets(2) .eq. 1)) then + ! Full house + hand_type = 5 + else if (sets(3) .eq. 1) then + ! Three of a kind + hand_type = 4 + else if (sets(2) .eq. 2) then + ! Two pair + hand_type = 3 + else if (sets(2) .eq. 1) then + ! One pair + hand_type = 2 + else + ! High card + hand_type = 1 + end if + end function hand_type + + function tiebreak(hand1, hand2) + ! True if hand1 would tiebreak ahead of hand2 + implicit none + character(len=5), intent(in) :: hand1, hand2 + logical :: tiebreak + character(len=13) :: cards = "23456789TJQKA" + integer :: pos_1, pos_2, i + do i=1,5 + pos_1 = scan(cards, hand1(i:i)) + pos_2 = scan(cards, hand2(i:i)) + if (pos_1 .lt. pos_2) then + tiebreak = .false. + return + else if (pos_1 .gt. pos_2) then + tiebreak = .true. + return + end if + end do + tiebreak = .true. + end function tiebreak + + function rank_correct(hand1, hand2) + implicit none + character(len=5), intent(in) :: hand1, hand2 + logical :: rank_correct + integer :: h1_type, h2_type + h1_type = hand_type(hand1) + h2_type = hand_type(hand2) + if (h1_type .gt. h2_type) then + rank_correct = .true. + else if (h1_type .lt. h2_type) then + rank_correct = .false. + else + rank_correct = tiebreak(hand1, hand2) + end if + end function rank_correct + + +end program day7 diff --git a/2023/src/day07b.f90 b/2023/src/day07b.f90 new file mode 100644 index 0000000..4c7e3cc --- /dev/null +++ b/2023/src/day07b.f90 @@ -0,0 +1,188 @@ +program day7b + implicit none + integer, parameter :: max_chars = 300 + character(200) :: fname + character(max_chars) :: fline + integer :: n_arguments + integer, parameter :: max_hands = 2000 + character(len=5) :: hands(1:max_hands) + integer :: bids(1:max_hands) + integer :: rank(1:max_hands) + integer :: i, i2, n_hands + integer :: istat + integer :: beats, winnings, total_winnings + + n_arguments = command_argument_count() + if (n_arguments .eq. 1) then + call get_command_argument(1, fname) + print *, "File: ", trim(fname) + print * + else + print *, "Wrong number of arguments: ", n_arguments + stop + end if + + + open(10, file=fname) + n_hands = 0 + do i=1, max_hands + read(10, "(a)", iostat = istat) fline + if ((len_trim(fline) .eq. 0) .or. (is_iostat_end(istat))) then + exit + end if + read(fline, *) hands(i), bids(i) + n_hands = n_hands + 1 + end do + close(10) + print *, "Number of hands: ", n_hands + rank = -1 + rank(1) = 1 + print * + do i=2,n_hands + beats = 0 + do i2=1,(i-1) + if (rank_correct(hands(i), hands(i2))) then + ! hand i ranks higher than hand i2 + if (rank(i2) .gt. beats) then + beats = rank(i2) + end if + write(*, 21) i, hands(i), i2, hands(i2) + else + ! hand i ranks lower than hand i2 + rank(i2) = rank(i2) + 1 + write(*, 22) i, hands(i), i2, hands(i2) + end if + end do + rank(i) = beats+1 + end do + print * + total_winnings = 0 + do i=1, n_hands + winnings = bids(i) * rank(i) + write(*, 20) hands(i), bids(i), hand_type(hands(i)), rank(i), winnings + total_winnings = total_winnings + winnings + end do + print * + print *, "Total winnings: ", total_winnings + +20 format("Hand: ", a5, "; Bid: ", i4, "; Type: ", i1, "; Rank: ", i4, "; Winnings: ", i8) +21 format(i4, " (", a5, ") beats ", i4, " (", a5, ")") +22 format(i4, " (", a5, ") b. by ", i4, " (", a5, ")") + + contains + function hand_type(hand) + character(len=5), intent(in) :: hand + integer :: hand_type + character(len=1) :: dist_cards(1:5) + integer :: card_count(1:5) + integer :: n_dc + integer :: i, i2 + character(len=1) :: this_card + logical :: existing_card + integer :: sets(1:5) + integer :: n_jokers + dist_cards = ' ' + card_count = 0 + n_dc = 1 + dist_cards(1) = hand(1:1) + card_count(1) = 1 + do i=2,5 + this_card = hand(i:i) + existing_card = .false. + do i2=1,n_dc + if (dist_cards(i2) .eq. this_card) then + existing_card = .true. + exit + end if + end do + if (existing_card) then + card_count(i2) = card_count(i2) + 1 + else + n_dc = n_dc + 1 + card_count(n_dc) = 1 + dist_cards(n_dc) = this_card + end if + end do + sets = 0 + n_jokers = 0 + do i=1,n_dc + if (dist_cards(i) .ne. 'J') then + sets(card_count(i)) = sets(card_count(i)) + 1 + else + n_jokers = card_count(i) + end if + end do + if (n_jokers .eq. 5) then + sets(5) = 1 + else if (n_jokers .gt. 0) then + do i=4,1,-1 + if (sets(i) .gt. 0) then + sets(i + n_jokers) = 1 + sets(i) = sets(i) - 1 + exit + end if + end do + end if + if (sets(5) .eq. 1) then + ! Five of a kind + hand_type = 7 + else if (sets(4) .eq. 1) then + ! Four of a kind + hand_type = 6 + else if ((sets(3) .eq. 1) .and. (sets(2) .eq. 1)) then + ! Full house + hand_type = 5 + else if (sets(3) .eq. 1) then + ! Three of a kind + hand_type = 4 + else if (sets(2) .eq. 2) then + ! Two pair + hand_type = 3 + else if (sets(2) .eq. 1) then + ! One pair + hand_type = 2 + else + ! High card + hand_type = 1 + end if + end function hand_type + + function tiebreak(hand1, hand2) + ! True if hand1 would tiebreak ahead of hand2 + implicit none + character(len=5), intent(in) :: hand1, hand2 + logical :: tiebreak + character(len=13) :: cards = "J23456789TQKA" + integer :: pos_1, pos_2, i + do i=1,5 + pos_1 = scan(cards, hand1(i:i)) + pos_2 = scan(cards, hand2(i:i)) + if (pos_1 .lt. pos_2) then + tiebreak = .false. + return + else if (pos_1 .gt. pos_2) then + tiebreak = .true. + return + end if + end do + tiebreak = .true. + end function tiebreak + + function rank_correct(hand1, hand2) + implicit none + character(len=5), intent(in) :: hand1, hand2 + logical :: rank_correct + integer :: h1_type, h2_type + h1_type = hand_type(hand1) + h2_type = hand_type(hand2) + if (h1_type .gt. h2_type) then + rank_correct = .true. + else if (h1_type .lt. h2_type) then + rank_correct = .false. + else + rank_correct = tiebreak(hand1, hand2) + end if + end function rank_correct + + +end program day7b