├── .gitignore ├── Analyzers ├── char_counter.pl ├── chr_freq.pl ├── dieharder.pl ├── first_letter_top.pl ├── kcal │ ├── kcal.pl │ └── products.csv ├── kernel_config_diff.pl ├── perl_code_analyzer.pl ├── perl_code_spellcheck.pl ├── reptop.pl ├── text_stats.pl ├── unidecode_word_top.pl ├── wcer.pl └── word_suffix_top.pl ├── Audio ├── auto-mp3tags.pl ├── group_audio_files.pl ├── mkv_audio_to_opus.pl ├── recompress_audio_track.pl ├── rem-mp3tags.pl ├── wave-cmp.pl └── wave-cmp2.pl ├── Benchmarks ├── array_range_vs_shift.pl ├── compression_algorithms.pl ├── json_vs_storable.pl ├── schwartzian_transform.pl └── types_of_variables.pl ├── Book tools ├── rosettacode_to_markdown.pl └── update_summary.pl ├── Compression ├── High-level │ ├── ablz_file_compression.pl │ ├── bbwr_file_compression.pl │ ├── blzss2_file_compression.pl │ ├── blzss_file_compression.pl │ ├── brlzss_file_compression.pl │ ├── bwac_file_compression.pl │ ├── bwad_file_compression.pl │ ├── bwlz2_file_compression.pl │ ├── bwlz3_file_compression.pl │ ├── bwlz_file_compression.pl │ ├── bwlza2_file_compression.pl │ ├── bwlza_file_compression.pl │ ├── bwlzad2_file_compression.pl │ ├── bwlzad_file_compression.pl │ ├── bwlzb_file_compression.pl │ ├── bwlzhd2_file_compression.pl │ ├── bwlzhd_file_compression.pl │ ├── bwlzss_file_compression.pl │ ├── bwrl2_file_compression.pl │ ├── bwrm2_file_compression.pl │ ├── bwrm_file_compression.pl │ ├── bwt2_file_compression.pl │ ├── bwt_file_compression.pl │ ├── bzip2_file_compression.pl │ ├── gzip_file_compression.pl │ ├── hblz_file_compression.pl │ ├── lz255_file_compression.pl │ ├── lz2ss_file_compression.pl │ ├── lz4_file_compression.pl │ ├── lz772_file_compression.pl │ ├── lz77_file_compression.pl │ ├── lz77f_file_compression.pl │ ├── lzac_file_compression.pl │ ├── lzb_file_compression.pl │ ├── lzbbw_file_compression.pl │ ├── lzbf_file_compression.pl │ ├── lzbh_file_compression.pl │ ├── lzbw2_file_compression.pl │ ├── lzbw3_file_compression.pl │ ├── lzbw4_file_compression.pl │ ├── lzbw5_file_compression.pl │ ├── lzbw_file_compression.pl │ ├── lzbwa_file_compression.pl │ ├── lzbwad_file_compression.pl │ ├── lzbwd_file_compression.pl │ ├── lzbwh_file_compression.pl │ ├── lzbws_file_compression.pl │ ├── lzhd2_file_compression.pl │ ├── lzhd_file_compression.pl │ ├── lzih_file_compression.pl │ ├── lzmrl2_file_compression.pl │ ├── lzmrl_file_compression.pl │ ├── lzop_file_compression.pl │ ├── lzsbw_file_compression.pl │ ├── lzss2_file_compression.pl │ ├── lzss77_file_compression.pl │ ├── lzss_file_compression.pl │ ├── lzssf_file_compression.pl │ ├── lzssm_file_compression.pl │ ├── lzw_file_compression.pl │ ├── mblz_file_compression.pl │ ├── mbwr_file_compression.pl │ ├── mrl_file_compression.pl │ ├── mybzip2_file_compression.pl │ ├── mygzip_file_compression.pl │ ├── mygzipf_file_compression.pl │ ├── mylz4_file_compression.pl │ ├── mylz4f_file_compression.pl │ ├── myzlib_file_compression.pl │ ├── rablz_file_compression.pl │ ├── rlzss_file_compression.pl │ ├── sbwt_file_compression.pl │ ├── xz_file_compression.pl │ ├── zlib_file_compression.pl │ └── zstd_file_compression.pl ├── bbwr_file_compression.pl ├── bqof_file_compression.pl ├── bwac_file_compression.pl ├── bwad_file_compression.pl ├── bwaz_file_compression.pl ├── bwlz2_file_compression.pl ├── bwlz_file_compression.pl ├── bwlza2_file_compression.pl ├── bwlza_file_compression.pl ├── bwlzad2_file_compression.pl ├── bwlzad_file_compression.pl ├── bwlzhd_file_compression.pl ├── bwlzss_file_compression.pl ├── bwrl2_file_compression.pl ├── bwrl_file_compression.pl ├── bwrla_file_compression.pl ├── bwrlz2_file_compression.pl ├── bwrlz_file_compression.pl ├── bwrm_file_compression.pl ├── bwt2_file_compression.pl ├── bwt_file_compression.pl ├── bww_file_compression.pl ├── bzip2_compressor.pl ├── bzip2_decompressor.pl ├── bzip2_file_compression.pl ├── compress.pl ├── gzip2_file_compression.pl ├── gzip_block_type_1.pl ├── gzip_block_type_1_huffman_only.pl ├── gzip_block_type_2.pl ├── gzip_block_type_2_huffman_only.pl ├── gzip_block_type_2_simple.pl ├── gzip_comment.pl ├── gzip_decompressor.pl ├── gzip_file_compression.pl ├── gzip_store.pl ├── hfm_file_compression.pl ├── lz4_compressor.pl ├── lz4_decompressor.pl ├── lz4_file_compression.pl ├── lz77_file_compression.pl ├── lza_file_compression.pl ├── lzac_file_compression.pl ├── lzaz_file_compression.pl ├── lzb2_file_compression.pl ├── lzb_file_compression.pl ├── lzbf2_file_compression.pl ├── lzbf_file_compression.pl ├── lzbh_file_compression.pl ├── lzbw_file_compression.pl ├── lzbwa_file_compression.pl ├── lzbwad_file_compression.pl ├── lzbwd_file_compression.pl ├── lzbwh_file_compression.pl ├── lzh_file_compression.pl ├── lzhc_file_compression.pl ├── lzhd_file_compression.pl ├── lzih_file_compression.pl ├── lzsa_file_compression.pl ├── lzsad_file_compression.pl ├── lzsbw_file_compression.pl ├── lzss2_file_compression.pl ├── lzss_file_compression.pl ├── lzssf_file_compression.pl ├── lzsst2_file_compression.pl ├── lzsst_file_compression.pl ├── lzt2_file_compression.pl ├── lzt_file_compression.pl ├── lzw_file_compression.pl ├── mbwr_file_compression.pl ├── mra_file_compression.pl ├── mrh_file_compression.pl ├── mrlz_file_compression.pl ├── ppmh_file_compression.pl ├── qof_file_compression.pl ├── rans_file_compression.pl ├── rlac_file_compression.pl ├── rlh_file_compression.pl ├── tac_file_compression.pl ├── tacc_file_compression.pl ├── test_compressors.pl ├── tzip2_file_compression.pl ├── tzip_file_compression.pl ├── unzip.pl ├── zip.pl ├── zlib_compressor.pl ├── zlib_decompressor.pl └── zlib_file_compression.pl ├── Converters ├── another_notes_to_markdown.pl ├── another_notes_to_material_notes.pl ├── any_to_3gp.pl ├── ass2srt.pl ├── code2pdf.pl ├── euler2pdf.pl ├── from_hex.pl ├── gdbm_to_berkeley.pl ├── gitbook2pdf.pl ├── gz2xz.pl ├── html2pdf.pl ├── html2pdf_chromium.pl ├── html2text.pl ├── json2csv.pl ├── markdown2pdf.pl ├── markdown2pdf_chromium.pl ├── markdown2text.pl ├── notepadfree_to_txt.pl ├── pod2pdf.pl ├── pod2text.pl ├── recompress.pl ├── unicode2ascii.pl ├── vnt2txt_simple.pl ├── xml2hash.pl ├── xpm_c_to_perl.pl ├── xz2gz.pl ├── zip2tar.pl └── zip2tar_fast.pl ├── Decoders ├── base64_decoding-tutorial.pl ├── cnp_info.pl └── named_parameters.pl ├── Digest ├── brute-force_resistant_hashing.pl └── crc32.pl ├── Encoding ├── adaptive_huffman_coding.pl ├── arithmetic_coding.pl ├── arithmetic_coding_adaptive_contexts_in_fixed_bits.pl ├── arithmetic_coding_adaptive_in_fixed_bits.pl ├── arithmetic_coding_anynum.pl ├── arithmetic_coding_in_fixed_bits.pl ├── arithmetic_coding_mpz.pl ├── ascii_encode_decode.pl ├── binary_arithmetic_coding.pl ├── binary_arithmetic_coding_anynum.pl ├── binary_variable_length_run_encoding.pl ├── binradix_arithmetic_coding.pl ├── binradix_arithmetic_coding_anynum.pl ├── burrows-wheeler_file_transform.pl ├── burrows-wheeler_transform-n-char_generalization.pl ├── burrows-wheeler_transform.pl ├── burrows-wheeler_transform_symbolic.pl ├── delta_encoding_with_double-elias_coding.pl ├── delta_encoding_with_elias_coding.pl ├── delta_encoding_with_unary_coding.pl ├── delta_rle_elias_encoding.pl ├── double-elias_gamma_encoding.pl ├── elias_gamma_encoding.pl ├── eyes_dropper.pl ├── fibonacci_coding.pl ├── huffman_coding.pl ├── int2bytes.pl ├── integers_binary_encoding.pl ├── integers_binary_encoding_with_delta_coding.pl ├── integers_binary_encoding_with_huffman_coding.pl ├── jpeg_transform.pl ├── length_encoder.pl ├── lz77_encoding.pl ├── lz77_encoding_symbolic.pl ├── lzss_encoding.pl ├── lzss_encoding_hash_table.pl ├── lzss_encoding_hash_table_fast.pl ├── lzss_encoding_symbolic.pl ├── lzt-fast.pl ├── lzw_encoding.pl ├── math_expr_encoder.pl ├── move-to-front_transform.pl ├── mtf-delta_encoding.pl ├── png_transform.pl ├── ppm_encoding.pl ├── ppm_encoding_dynamic.pl ├── rANS_encoding.pl ├── rANS_encoding_mpz.pl ├── run_length_with_elias_coding.pl ├── string_to_integer_encoding_based_on_primes.pl ├── swap_transform.pl ├── tlen_encoding.pl └── variable_length_run_encoding.pl ├── Encryption ├── RSA_encryption.pl ├── age-lf.pl ├── backdoored_rsa_with_x25519.pl ├── cbc+xor_file_encrypter.pl ├── crypt_rsa.pl ├── one-time_pad.pl ├── plage.pl └── simple_XOR_cipher.pl ├── File Readers ├── ldump ├── multi-file-line-reader.pl ├── n_repeated_lines.pl └── tailz ├── File Workers ├── arxiv_pdf_renamer.pl ├── auto_extensions.pl ├── collect_gifs.pl ├── collect_videos.pl ├── delete_if_exists.pl ├── dir_file_updater.pl ├── file-mover.pl ├── file_updater.pl ├── filename_cmp_del.pl ├── keep_this_formats.pl ├── make_filenames_portable.pl ├── md5_rename.pl ├── multiple_backups.pl ├── remove_eof_newlines.pl ├── split_to_n_lines.pl ├── sub_renamer.pl ├── undir.pl └── unidec_renamer.pl ├── Finders ├── ampath ├── dup_subtr_finder.pl ├── fcheck.pl ├── fdf ├── fdf-attr ├── fdf-filename ├── file_binsearch.pl ├── find_perl_scripts.pl ├── find_similar_filenames.pl ├── find_similar_filenames_unidec.pl ├── fsf.pl ├── fsfn.pl ├── human-like_finder.pl ├── large_file_search.pl ├── locatepm ├── longest_substring.pl ├── mimefind.pl ├── model_matching_system.pl ├── path_diff.pl ├── plocate.pl └── similar_files_levenshtein.pl ├── Formatters ├── ascii_table_csv.pl ├── file_columner.pl ├── fstab_beautifier.pl ├── js_beautify ├── reformat_literal_perl_strings.pl ├── replace_html_links.pl ├── sort_perl_subroutines.pl └── word_columner.pl ├── GD ├── AND_sierpinski_triangle.pl ├── LSystem │ ├── LSystem.pm │ ├── Turtle.pm │ ├── honeycomb.pl │ ├── honeycomb_2.pl │ ├── plant.pl │ ├── plant_2.pl │ ├── plant_3.pl │ ├── sierpinski_triangle.pl │ └── tree.pl ├── XOR_pattern.pl ├── abstract_map.pl ├── barnsley_fern_fractal.pl ├── binary_triangle.pl ├── black_star_turtle.pl ├── black_yellow_number_triangles.pl ├── box_pattern.pl ├── chaos_game_pentagon.pl ├── chaos_game_tetrahedron.pl ├── chaos_game_triangle.pl ├── circular_prime_triangle.pl ├── circular_triangle.pl ├── collatz_triangle.pl ├── color_wheel.pl ├── complex_square.pl ├── congruence_of_squares_triangle.pl ├── cuboid_turtle.pl ├── cuboid_turtle3.pl ├── cuboid_turtle_2.pl ├── dancing_shapes.pl ├── divisor_circles.pl ├── divisor_triangle.pl ├── elementary_cellular_automaton_generalized.pl ├── fact_exp_primorial_growing.pl ├── factor_circles.pl ├── factor_triangle.pl ├── factorial_turtles.pl ├── factors_of_two_triangle.pl ├── farey_turnings_plot.pl ├── fgraph.pl ├── fgraph_precision.pl ├── fibonacci_gd.pl ├── fibonacci_spirals.pl ├── generator_turtle.pl ├── geometric_shapes.pl ├── goldbach_conjecture_possibilities.pl ├── horsie_art.pl ├── julia_set.pl ├── julia_set_complex.pl ├── julia_set_random.pl ├── julia_set_rperl.pl ├── koch_snowflakes.pl ├── langton_s_ant_gd.pl ├── line_pattern_triangles.pl ├── magic_triangle.pl ├── mandelbrot_like_set.pl ├── mandelbrot_like_set_gcomplex.pl ├── mathematical_butt.pl ├── mathematical_shapes.pl ├── mirror_shells.pl ├── moebius_walking_line.pl ├── number_triangles.pl ├── numeric_circles.pl ├── pascal-fibonacci_triangle.pl ├── pascal_powers_of_two_triangle.pl ├── pascal_s_triangle_multiples.pl ├── pascal_special_triangle.pl ├── pattern_triangle.pl ├── peacock_triangles.pl ├── pi_abstract_art.pl ├── pi_turtle.pl ├── prime_consecutive_sums.pl ├── prime_gaps.pl ├── prime_rectangles.pl ├── prime_stripe_triangle.pl ├── prime_triangle_90deg.pl ├── pythagoras_tree.pl ├── random_abstract_art.pl ├── random_abstract_art_2.pl ├── random_langton_s_ant.pl ├── random_looking_pattern_triangle.pl ├── random_machinery_art.pl ├── random_noise_triangle.pl ├── random_turtles.pl ├── real_shell.pl ├── recursive_squares.pl ├── regular_poligons.pl ├── reversed_prime_triangles.pl ├── right_triangle_primes.pl ├── sandpiles.pl ├── sierpinski_fibonacci_triangle.pl ├── sierpinski_triangle.pl ├── spinning_shapes.pl ├── spiral_matrix_primes.pl ├── spiral_tree.pl ├── square_of_circles.pl ├── star_turtle.pl ├── stern_brocot_shapes.pl ├── triangle_factors.pl ├── triangle_primes.pl ├── triangle_primes_2.pl ├── triangle_primes_irregular.pl ├── trizen_fan_turtle.pl ├── trizen_flat_logo.pl ├── trizen_new_logo.pl ├── trizen_old_logo.pl ├── trizen_text_art.pl ├── tupper_s_self-referential_formula.pl ├── wavy_triangle.pl ├── zeta_real_half_terms.pl └── zig-zag_primes.pl ├── GTK+ ├── mouse_position.pl └── tray-file-browser.pl ├── Game solvers ├── asciiplanes-player.pl ├── dice_game_solver.pl ├── peg-solitaire-solver ├── reaction_time_test.pl ├── reflex_sheep_game.pl ├── sudoku_dice_game_solver.pl ├── sudoku_generator.pl ├── sudoku_solver.pl ├── sudoku_solver_backtracking.pl ├── sudoku_solver_iterative.pl ├── sudoku_solver_stack.pl └── visual_memory_test.pl ├── Games ├── arrow-key_drawer.pl ├── asciiplanes └── snake_game.pl ├── Generators ├── bernoulli_numbers_formulas.pl ├── faulhaber_s_formula_symbolic.pl ├── faulhaber_s_formulas_expanded.pl ├── faulhaber_s_formulas_expanded_2.pl ├── faulhaber_s_formulas_generator.pl ├── parsing_and_code_gen.pl ├── powers_of_factorial.pl ├── random_lsystem_generator.pl ├── semiprime_equationization_C_generator.pl ├── semiprime_equationization_Perl_generator.pl └── zeta_2n_generator.pl ├── Greppers ├── marif ├── mime_types.pl ├── mp3grep.pl ├── scgrep └── unigrep.pl ├── HAL ├── HAL3736 │ ├── HAL3736.memory │ └── HAL3736.pl ├── HAL8212 │ ├── HAL8212.memory │ └── HAL8212.pl └── HAL9000 │ ├── HAL9000.memory │ └── HAL9000.pl ├── Image ├── 2x_zoom.pl ├── add_exif_info.pl ├── bitmap_monochrome_encoding_decoding.pl ├── bwt_horizontal_transform.pl ├── bwt_rgb_horizontal_transform.pl ├── bwt_rgb_vertical_transform.pl ├── bwt_vertical_transform.pl ├── collage.pl ├── complex_transform.pl ├── cyan_vision.pl ├── darken_image.pl ├── diff_negative.pl ├── edge_detector.pl ├── extract_jpegs.pl ├── fractal_frame.pl ├── fractal_frame_transparent.pl ├── gd_png2jpg.pl ├── gd_similar_images.pl ├── gd_star_trails.pl ├── gif2webp.pl ├── horizontal_scrambler.pl ├── image-unpack.pl ├── image2ascii.pl ├── image2audio.pl ├── image2digits.pl ├── image2html.pl ├── image2matrix.pl ├── image2mozaic.pl ├── image2png.pl ├── image2prime.pl ├── imager_similar_images.pl ├── img-autocrop-avg.pl ├── img-autocrop-whitebg.pl ├── img-autocrop.pl ├── img_composition.pl ├── img_rewrite.pl ├── julia_transform.pl ├── lookalike_images.pl ├── magick_png2jpg.pl ├── magick_similar_images.pl ├── magick_star_trails.pl ├── matrix_visual.pl ├── mirror_images.pl ├── mtf_horizontal_transform.pl ├── mtf_vertical_transform.pl ├── nearest_neighbor_interpolation.pl ├── optimize_images.pl ├── optimize_images_littleutils.pl ├── outguess-png-imager.pl ├── outguess-png.pl ├── photo_mosaic_from_images.pl ├── qhi_decoder.pl ├── qhi_encoder.pl ├── qoi_decoder.pl ├── qoi_encoder.pl ├── qzst_decoder.pl ├── qzst_encoder.pl ├── recompress_images.pl ├── remove_sensitive_exif_tags.pl ├── resize_images.pl ├── rgb_dump.pl ├── sharp_2x_zoom.pl ├── slideshow.pl ├── vertical_scrambler.pl ├── visualize_binary.pl ├── webp2png.pl ├── zuper_image_decoder.pl └── zuper_image_encoder.pl ├── JAPH ├── alien_japh.pl ├── alpha_ascii_japh.pl ├── alpha_japh.pl ├── alpha_japh_2.pl ├── alpha_japh_3.pl ├── arrow_japh.pl ├── barewords_japh.pl ├── cubic_japh.pl ├── invisible_japh.pl ├── japh_from_ambiguity.pl ├── japh_from_auto-quoted_keywords.pl ├── japh_from_escapes.pl ├── japh_from_escapes_2.pl ├── japh_from_eval_subst.pl ├── japh_from_keywords.pl ├── japh_from_pod.pl ├── japh_from_poetry.pl ├── japh_from_punctuation_chars.pl ├── japh_from_subs.pl ├── japh_from_the_deep.pl ├── japh_variable.pl ├── japh_variables.pl ├── japh_variables_2.pl ├── leet_japh.pl ├── length_obfuscation.pl ├── log_japh.pl ├── log_japh_2.pl ├── non-alphanumeric_japh.pl ├── re_eval_japh.pl ├── slash_r_japh.pl ├── ternary_japh.pl ├── up_and_down.pl ├── vec_japh.pl └── vec_japh_2.pl ├── LICENSE ├── Lingua ├── en_phoneme.pl ├── lingua_ro_numbers.pl ├── poetry_from_poetry.pl ├── poetry_from_poetry_with_variations.pl ├── random_poetry_generator.pl └── rus_translit.pl ├── Math ├── 1_over_n_is_finite.pl ├── 1_over_n_period_length.pl ├── BPSW_primality_test.pl ├── BPSW_primality_test_mpz.pl ├── LUP_decomposition.pl ├── MBE_factorization_method.pl ├── PSW_primality_test.pl ├── PSW_primality_test_mpz.pl ├── RSA_PRNG.pl ├── RSA_example.pl ├── additive_binomial.pl ├── alexandrian_integers.pl ├── almost_prime_divisors.pl ├── almost_prime_divisors_recursive.pl ├── almost_prime_numbers.pl ├── almost_prime_numbers_in_range.pl ├── almost_prime_numbers_in_range_mpz.pl ├── almost_prime_numbers_in_range_v2.pl ├── almost_primes_from_factor_list.pl ├── almost_primes_in_range_from_factor_list.pl ├── area_of_triangle.pl ├── arithmetic_derivative.pl ├── arithmetic_expressions.pl ├── arithmetic_geometric_mean_complex.pl ├── arithmetic_sum_closed_form.pl ├── ascii_cuboid.pl ├── ascii_julia_set.pl ├── ascii_mandelbrot_set.pl ├── batir_factorial_asymptotic_formula_mpfr.pl ├── bell_numbers.pl ├── bell_numbers_mpz.pl ├── bernoulli_denominators.pl ├── bernoulli_denominators_records.pl ├── bernoulli_numbers.pl ├── bernoulli_numbers_from_factorials.pl ├── bernoulli_numbers_from_factorials_mpq.pl ├── bernoulli_numbers_from_factorials_mpz.pl ├── bernoulli_numbers_from_factorials_visual.pl ├── bernoulli_numbers_from_primes.pl ├── bernoulli_numbers_from_primes_gmpf.pl ├── bernoulli_numbers_from_primes_mpfr.pl ├── bernoulli_numbers_from_primes_ntheory.pl ├── bernoulli_numbers_from_tangent_numbers.pl ├── bernoulli_numbers_from_zeta.pl ├── bernoulli_numbers_ramanujan_congruences.pl ├── bernoulli_numbers_ramanujan_congruences_unreduced.pl ├── bernoulli_numbers_recursive.pl ├── bernoulli_numbers_recursive_2.pl ├── bernoulli_numbers_seidel.pl ├── bi-unitary_divisors.pl ├── binary_gcd_algorithm.pl ├── binary_gcd_algorithm_mpz.pl ├── binary_multiplier.pl ├── binary_prime_encoder.pl ├── binary_prime_encoder_fast.pl ├── binary_prime_sieve_mpz.pl ├── binary_splitting_product.pl ├── binomial_sum_with_imaginary_term.pl ├── binomial_theorem.pl ├── bitstring_prime_sieve_mpz.pl ├── bitstring_prime_sieve_vec.pl ├── both_truncatable_primes_in_base.pl ├── brazilian_primes_constant.pl ├── brown_numbers.pl ├── carmichael_factorization_method.pl ├── carmichael_factorization_method_generalized.pl ├── carmichael_numbers_from_multiple.pl ├── carmichael_numbers_from_multiple_mpz.pl ├── carmichael_numbers_from_multiple_recursive_mpz.pl ├── carmichael_numbers_generation_erdos_method.pl ├── carmichael_numbers_generation_erdos_method_dynamic_programming.pl ├── carmichael_numbers_in_range.pl ├── carmichael_numbers_in_range_from_prime_factors.pl ├── carmichael_numbers_in_range_mpz.pl ├── carmichael_numbers_random.pl ├── carmichael_strong_fermat_pseudoprimes_in_range.pl ├── carmichael_strong_fermat_pseudoprimes_in_range_mpz.pl ├── cartesian_product_iter.pl ├── cartesian_product_rec.pl ├── cauchy_numbers_of_first_type.pl ├── chebyshev_factorization_method.pl ├── chebyshev_factorization_method_mpz.pl ├── chernick-carmichael_numbers.pl ├── chernick-carmichael_numbers_below_limit.pl ├── chernick-carmichael_polynomials.pl ├── chernick-carmichael_with_n_factors_sieve.pl ├── chinese_factorization_method.pl ├── coin_change.pl ├── collatz_function.pl ├── complex_exponentiation_in_real_numbers.pl ├── complex_logarithm_in_real_numbers.pl ├── complex_modular_multiplicative_inverse.pl ├── complex_zeta_in_real_numbers.pl ├── congruence_of_powers_factorization_method.pl ├── consecutive_partitions.pl ├── continued_fraction_expansion_of_sqrt_of_n.pl ├── continued_fraction_expansion_of_sqrt_of_n_mpz.pl ├── continued_fraction_factorization_method.pl ├── continued_fractions.pl ├── continued_fractions_for_e.pl ├── continued_fractions_for_nth_roots.pl ├── continued_fractions_for_pi.pl ├── continued_fractions_for_square_roots.pl ├── continued_fractions_prime_constant.pl ├── convergent_series.pl ├── cosmic_calendar.pl ├── count_of_brilliant_numbers.pl ├── count_of_cube-full_numbers.pl ├── count_of_integers_with_gpf_of_n_equals_p.pl ├── count_of_integers_with_lpf_of_n_equals_p.pl ├── count_of_k-almost_primes.pl ├── count_of_k-omega_primes.pl ├── count_of_k-powerfree_numbers.pl ├── count_of_k-powerful_numbers.pl ├── count_of_k-powerful_numbers_in_range.pl ├── count_of_perfect_powers.pl ├── count_of_prime_power.pl ├── count_of_rough_numbers.pl ├── count_of_smooth_numbers.pl ├── count_of_smooth_numbers_mpz.pl ├── count_of_smooth_numbers_mpz_2.pl ├── count_of_smooth_numbers_with_k_factors.pl ├── count_of_squarefree_k-almost_primes.pl ├── count_of_squarefree_numbers.pl ├── count_subtriangles.pl ├── cube-full_numbers.pl ├── cuboid.pl ├── cyclotomic_factorization_method.pl ├── cyclotomic_factorization_method_2.pl ├── cyclotomic_polynomial.pl ├── definite_integral_numerical_approximation.pl ├── difference_of_k_powers.pl ├── difference_of_powers_factorization_method.pl ├── difference_of_three_squares_solutions.pl ├── difference_of_two_squares_solutions.pl ├── digits_to_number_subquadratic_algorithm.pl ├── digits_to_number_subquadratic_algorithm_mpz.pl ├── dirichlet_hyperbola_method.pl ├── discrete_root.pl ├── divisors_less_than_k.pl ├── divisors_of_factorial_below_limit.pl ├── divisors_of_factorial_in_range_iterator.pl ├── dixon_factorization_method.pl ├── e_from_binomial.pl ├── e_primorial.pl ├── ecm_factorization_method.pl ├── elementary_cellular_automaton_generalized.pl ├── elliptic-curve_factorization_method.pl ├── elliptic-curve_factorization_method_with_B2_stage.pl ├── elliptic-curve_factorization_method_with_B2_stage_mpz.pl ├── equally_spaced_squares_solutions.pl ├── esthetic_numbers.pl ├── ethiopian_multiplication.pl ├── ethiopian_multiplication_binary.pl ├── even_fermat_pseudoprimes_in_range.pl ├── even_squarefree_fermat_pseudoprimes_in_range.pl ├── exponential_divisors.pl ├── factorial_dsc_algorithm.pl ├── factorial_expansion_of_reciprocals.pl ├── factorial_from_primes.pl ├── factorial_from_primes_simple.pl ├── factorial_from_primorials.pl ├── factorial_from_trinomial_coefficients.pl ├── factorial_in_half_steps.pl ├── factorions_in_base_n.pl ├── factorization_with_difference_of_prime_factors.pl ├── farey_rational_approximation.pl ├── faulhaber_s_formula.pl ├── fermat_factorization_method.pl ├── fermat_factorization_method_2.pl ├── fermat_frobenius_quadratic_primality_test.pl ├── fermat_overpseudoprimes_generation.pl ├── fermat_overpseudoprimes_in_range.pl ├── fermat_pseudoprimes_from_multiple.pl ├── fermat_pseudoprimes_from_multiple_mpz.pl ├── fermat_pseudoprimes_generation.pl ├── fermat_pseudoprimes_generation_2.pl ├── fermat_pseudoprimes_generation_3.pl ├── fermat_pseudoprimes_in_range.pl ├── fermat_pseudoprimes_in_range_mpz.pl ├── fermat_superpseudoprimes_generation.pl ├── fibonacci_closed_form.pl ├── fibonacci_closed_form_2.pl ├── fibonacci_encoding.pl ├── fibonacci_factorization_method.pl ├── fibonacci_k-th_order.pl ├── fibonacci_k-th_order_efficient_algorithm.pl ├── fibonacci_k-th_order_fast.pl ├── fibonacci_k-th_order_odd_primes_indices.pl ├── fibonacci_number_fast.pl ├── fibonacci_polynomials_closed_form.pl ├── fibonacci_pseudoprimes_generation.pl ├── find_least_common_denominator.pl ├── floor_and_ceil_functions_fourier_series.pl ├── flt_factorization_method.pl ├── fraction_approximation.pl ├── fraction_to_decimal_expansion.pl ├── fractional_pi.pl ├── frobenius_pseudoprimes_generation.pl ├── fubini_numbers.pl ├── fubini_numbers_2.pl ├── fubini_numbers_recursive.pl ├── function_graph.pl ├── function_inverse_binary_search.pl ├── gamma_function.pl ├── gaussian_divisors.pl ├── gaussian_factors.pl ├── gaussian_integers_sum.pl ├── general_binary_multiplier.pl ├── goldbach_conjecture_2n_prime.pl ├── goldbach_conjecture_increasing_primes.pl ├── goldbach_conjecture_possibilities.pl ├── goldbach_conjecture_random_primes.pl ├── golomb_s_sequence.pl ├── greatest_common_unitary_divisor.pl ├── hamming_numbers.pl ├── harmonic_numbers.pl ├── harmonic_numbers_from_digamma.pl ├── harmonic_numbers_from_powers.pl ├── harmonic_numbers_from_powers_mpz.pl ├── harmonic_prime_powers.pl ├── hybrid_prime_factorization.pl ├── infinitary_divisors.pl ├── inverse_of_bernoulli_numbers.pl ├── inverse_of_euler_totient.pl ├── inverse_of_factorial.pl ├── inverse_of_factorial_stirling.pl ├── inverse_of_fibonacci.pl ├── inverse_of_multiplicative_functions.pl ├── inverse_of_p_adic_valuation.pl ├── inverse_of_sigma_function.pl ├── inverse_of_sigma_function_fast.pl ├── inverse_of_sigma_function_generalized.pl ├── inverse_of_usigma_function.pl ├── invert_transform_of_factorials.pl ├── is_absolute_euler_pseudoprime.pl ├── is_almost_prime.pl ├── is_bfsw_pseudoprime.pl ├── is_chernick_carmichael_number.pl ├── is_even_perfect.pl ├── is_even_perfect_2.pl ├── is_even_perfect_3.pl ├── is_extra_bfsw_pseudoprime.pl ├── is_omega_prime.pl ├── is_perfect_power.pl ├── is_smooth_over_product.pl ├── is_squarefree_over_product.pl ├── is_sum_of_two_cubes.pl ├── is_sum_of_two_squares.pl ├── iterative_difference_of_central_divisors_to_reach_zero.pl ├── k-imperfect_numbers.pl ├── k-odd-powerful_numbers.pl ├── k-powerful_numbers.pl ├── k-powerful_numbers_in_range.pl ├── karatsuba_multiplication.pl ├── kempner_binomial_numbers.pl ├── klein_J_invariant_and_modular_lambda.pl ├── lambert_W_function.pl ├── lambert_W_function_complex.pl ├── lanczos_approximation.pl ├── least_k_such_that_k_times_k-th_prime_is_greater_than_10_to_the_n.pl ├── least_nonresidue.pl ├── legendary_question_six.pl ├── length_of_shortest_addition_chain.pl ├── lerch_zeta_function.pl ├── logarithmic_integral_asymptotic_formula.pl ├── logarithmic_root.pl ├── logarithmic_root_complex.pl ├── logarithmic_root_in_two_variables.pl ├── logarithmic_root_mpfr.pl ├── long_division.pl ├── long_multiplication.pl ├── lucas-carmichael_numbers_from_multiple.pl ├── lucas-carmichael_numbers_from_multiple_mpz.pl ├── lucas-carmichael_numbers_in_range.pl ├── lucas-carmichael_numbers_in_range_from_prime_factors.pl ├── lucas-carmichael_numbers_in_range_mpz.pl ├── lucas-miller_factorization_method.pl ├── lucas-pocklington_primality_proving.pl ├── lucas-pratt_primality_proving.pl ├── lucas-pratt_prime_records.pl ├── lucas_factorization_method.pl ├── lucas_factorization_method_generalized.pl ├── lucas_pseudoprimes_generation.pl ├── lucas_pseudoprimes_generation_erdos_method.pl ├── lucas_sequences_U_V.pl ├── lucas_sequences_U_V_mpz.pl ├── lucas_theorem.pl ├── magic_3-gon_ring.pl ├── magic_5-gon_ring.pl ├── map_num.pl ├── matrix_determinant_bareiss.pl ├── matrix_path_2-ways_best.pl ├── matrix_path_2-ways_greedy.pl ├── matrix_path_3-ways_best.pl ├── matrix_path_3-ways_diagonal_best.pl ├── matrix_path_3-ways_greedy.pl ├── matrix_path_4-ways_best.pl ├── matrix_path_4-ways_best_2.pl ├── matrix_path_4-ways_best_3.pl ├── matrix_path_4-ways_greedy.pl ├── maximum_product_of_parts_bisection.pl ├── maximum_square_remainder.pl ├── mertens_function.pl ├── mertens_function_fast.pl ├── miller-rabin_deterministic_primality_test.pl ├── miller-rabin_deterministic_primality_test_mpz.pl ├── miller-rabin_factorization_method.pl ├── modular_bell_numbers.pl ├── modular_bell_numbers_mpz.pl ├── modular_binomial.pl ├── modular_binomial_fast.pl ├── modular_binomial_faster.pl ├── modular_binomial_ntheory.pl ├── modular_binomial_small_k.pl ├── modular_binomial_small_k_faster.pl ├── modular_cyclotomic_polynomial.pl ├── modular_factorial.pl ├── modular_fibonacci.pl ├── modular_fibonacci_anynum.pl ├── modular_fibonacci_cassini.pl ├── modular_fibonacci_cassini_fast.pl ├── modular_fibonacci_fast_mpz.pl ├── modular_fibonacci_mpz.pl ├── modular_fibonacci_polynomial.pl ├── modular_fibonacci_polynomial_2.pl ├── modular_hyperoperation.pl ├── modular_inverse.pl ├── modular_lucas_numbers.pl ├── modular_lucas_sequence_V.pl ├── modular_lucas_sequences_U_V.pl ├── modular_pseudo_square_root.pl ├── modular_pseudo_square_root_2.pl ├── modular_sigma_of_unitary_divisors_of_factorial.pl ├── modular_square_root.pl ├── modular_square_root_2.pl ├── modular_square_root_3.pl ├── modular_square_root_all_solutions.pl ├── modular_square_root_all_solutions_cipolla.pl ├── multi_sqrt_nums.pl ├── multinomial_coefficient.pl ├── multinomial_coefficient_from_binomial.pl ├── multivariate_gamma_function.pl ├── mysterious_sum-pentagonal_numbers.pl ├── mysterious_sum-pentagonal_numbers_2.pl ├── n_dimensional_circles.pl ├── near-power_factorization_method.pl ├── newton_s_method.pl ├── newton_s_method_recursive.pl ├── next_palindrome.pl ├── next_palindrome_from_non-palindrome.pl ├── next_palindrome_in_base.pl ├── next_power_of_two.pl ├── nth_composite.pl ├── nth_digit_of_fraction.pl ├── nth_prime_approx.pl ├── nth_root_good_rational_approximations.pl ├── nth_root_recurrence_constant.pl ├── nth_smooth_number.pl ├── number2expression.pl ├── number_of_conditional_GCDs.pl ├── number_of_connected_permutations.pl ├── number_of_partitions_into_2_distinct_positive_cubes.pl ├── number_of_partitions_into_2_distinct_positive_squares.pl ├── number_of_partitions_into_2_nonnegative_cubes.pl ├── number_of_partitions_into_2_positive_squares.pl ├── number_of_representations_as_sum_of_3_triangles.pl ├── number_of_representations_as_sum_of_four_squares.pl ├── number_of_representations_as_sum_of_two_squares.pl ├── number_to_digits_subquadratic_algorithm.pl ├── number_to_digits_subquadratic_algorithm_mpz.pl ├── numbers_with_pow_2_divisors.pl ├── omega_prime_divisors.pl ├── omega_prime_numbers_in_range.pl ├── omega_prime_numbers_in_range_mpz.pl ├── omega_prime_numbers_in_range_simple.pl ├── order_factorization_method.pl ├── palindrome_iteration.pl ├── partial_sums_of_dedekind_psi_function.pl ├── partial_sums_of_euler_totient_function.pl ├── partial_sums_of_euler_totient_function_fast.pl ├── partial_sums_of_euler_totient_function_fast_2.pl ├── partial_sums_of_euler_totient_function_times_k.pl ├── partial_sums_of_euler_totient_function_times_k_to_the_m.pl ├── partial_sums_of_exponential_prime_omega_functions.pl ├── partial_sums_of_gcd-sum_function.pl ├── partial_sums_of_gcd-sum_function_fast.pl ├── partial_sums_of_gcd-sum_function_faster.pl ├── partial_sums_of_generalized_gcd-sum_function.pl ├── partial_sums_of_gpf.pl ├── partial_sums_of_inverse_moebius_transform_of_dedekind_function.pl ├── partial_sums_of_jordan_totient_function.pl ├── partial_sums_of_jordan_totient_function_fast.pl ├── partial_sums_of_jordan_totient_function_times_k_to_the_m.pl ├── partial_sums_of_lcm_count_function.pl ├── partial_sums_of_liouville_function.pl ├── partial_sums_of_lpf.pl ├── partial_sums_of_n_over_k-almost_prime_divisors.pl ├── partial_sums_of_powerfree_numbers.pl ├── partial_sums_of_powerfree_part.pl ├── partial_sums_of_prime_bigomega_function.pl ├── partial_sums_of_prime_omega_function.pl ├── partial_sums_of_sigma0_function.pl ├── partial_sums_of_sigma_function.pl ├── partial_sums_of_sigma_function_times_k.pl ├── partial_sums_of_sigma_function_times_k_to_the_m.pl ├── partitions_count.pl ├── partitions_count_abs.pl ├── partitions_count_simple.pl ├── pascal-fibonacci_triangle.pl ├── pascal_s_triangle_multiples.pl ├── pattern_mixing.pl ├── pell_cfrac_factorization.pl ├── pell_factorization.pl ├── pell_factorization_anynum.pl ├── perfect_numbers.pl ├── period_of_continued_fraction_for_square_roots.pl ├── period_of_continued_fraction_for_square_roots_mpz.pl ├── period_of_continued_fraction_for_square_roots_ntheory.pl ├── phi-finder_factorization_method.pl ├── pi_from_infinity.pl ├── pisano_periods.pl ├── pisano_periods_efficient_algorithm.pl ├── pocklington-pratt_primality_proving.pl ├── pollard-strassen_factorization_method.pl ├── pollard_p-1_factorization.pl ├── pollard_rho_exp_factorization.pl ├── pollard_rho_factorization.pl ├── polygonal_numbers.pl ├── polygonal_representations.pl ├── polynomial_interpolation.pl ├── power_divisors.pl ├── power_of_factorial_ramanujan.pl ├── power_unitary_divisors.pl ├── powerfree_divisors.pl ├── powers_of_primes_in_factorial.pl ├── powers_of_primes_modulus_in_factorial.pl ├── prime_41.pl ├── prime_abundant_sequences.pl ├── prime_count_smooth_sum.pl ├── prime_factorization_concept.pl ├── prime_factors_of_binomial_coefficients.pl ├── prime_factors_of_binomial_product.pl ├── prime_factors_of_factorial.pl ├── prime_factors_of_superfactorial_and_hyperfactorial.pl ├── prime_formulas.pl ├── prime_functions_in_terms_of_zeros_of_zeta.pl ├── prime_numbers_generator.pl ├── prime_omega_function_generalized.pl ├── prime_quadratic_polynomial_analyzer.pl ├── prime_quadratic_polynomials.pl ├── prime_summation.pl ├── prime_zeta.pl ├── primes_diff.pl ├── primes_sum_of_pair_product.pl ├── primitive_sum_of_two_squares.pl ├── primorial_deflation.pl ├── pseudo_square_root.pl ├── pythagorean_triples.pl ├── quadratic-integer_factorization_method.pl ├── quadratic-integer_factorization_method_mpz.pl ├── quadratic_frobenius_primality_test.pl ├── quadratic_frobenius_pseudoprimes_generation.pl ├── quadratic_polynomial_in_terms_of_its_zeros.pl ├── ramanujan_sum.pl ├── ramanujan_sum_fast.pl ├── random_carmichael_fibonacci_pseudoprimes.pl ├── random_integer_factorization.pl ├── random_miller-rabin_pseudoprimes.pl ├── range_map.pl ├── rational_approximations.pl ├── rational_continued_fractions.pl ├── rational_prime_product.pl ├── rational_summation_of_fractions.pl ├── reciprocal_cycle_length.pl ├── rectangle_sides_from_area_and_diagonal.pl ├── rectangle_sides_from_diagonal_angles.pl ├── rectangle_sides_from_one_diagonal_angle.pl ├── recursive_matrix_multiplication.pl ├── rest_calc.pl ├── reversed_number_triangle.pl ├── reversed_number_triangles.pl ├── riemann_prime-counting_function.pl ├── riemann_s_J_function.pl ├── roots_on_the_rise.pl ├── secant_numbers.pl ├── semiprime_equationization.pl ├── semiprime_equationization_uncached.pl ├── sequence_analyzer.pl ├── sequence_closed_form.pl ├── sequence_polynomial_closed_form.pl ├── sieve_of_eratosthenes.pl ├── sigma0_of_factorial.pl ├── sigma_function.pl ├── sigma_of_factorial.pl ├── sigma_of_product_of_binomials.pl ├── sigma_p_adic.pl ├── siqs_factorization.pl ├── smallest_carmichael_divisible_by_n.pl ├── smallest_k-gonal_inverse.pl ├── smallest_k-gonal_inverse_brute_force.pl ├── smallest_lucas-carmichael_divisible_by_n.pl ├── smallest_number_with_at_least_n_divisors.pl ├── smallest_number_with_n_divisors.pl ├── smarandache_function.pl ├── smooth_numbers_generalized.pl ├── solutions_to_x_squared_equals_-1_mod_n.pl ├── solutions_to_x_squared_equals_1_mod_n.pl ├── solutions_to_x_squared_equals_a_mod_n.pl ├── solve_congruence_equation_example.pl ├── solve_cubic_equation.pl ├── solve_cubic_equation_real.pl ├── solve_modular_cubic_equation.pl ├── solve_modular_quadratic_equation.pl ├── solve_pell_equation.pl ├── solve_pell_equation_fast.pl ├── solve_pell_equation_generalized.pl ├── solve_pell_equation_simple.pl ├── solve_quadratic_diophantine_reciprocals.pl ├── solve_reciprocal_pythagorean_equation.pl ├── solve_sequence.pl ├── sophie_germain_factorization_method.pl ├── sorting_algorithms.pl ├── sphere_volume.pl ├── sqrt_mod_p_tonelli-shanks_mpz.pl ├── square_divisors.pl ├── square_product_subsets.pl ├── square_root_convergents.pl ├── square_root_method.pl ├── square_root_modulo_n_tonelli-shanks.pl ├── squarefree_almost_prime_divisors.pl ├── squarefree_almost_primes_from_factor_list.pl ├── squarefree_almost_primes_in_range.pl ├── squarefree_almost_primes_in_range_from_factor_list.pl ├── squarefree_almost_primes_in_range_mpz.pl ├── squarefree_divisors.pl ├── squarefree_fermat_overpseudoprimes_in_range.pl ├── squarefree_fermat_pseudoprimes_in_range.pl ├── squarefree_fermat_pseudoprimes_in_range_mpz.pl ├── squarefree_lucas_U_pseudoprimes_in_range.pl ├── squarefree_strong_fermat_pseudoprimes_in_range.pl ├── squarefree_strong_fermat_pseudoprimes_in_range_mpz.pl ├── squarefree_strong_fermat_pseudoprimes_to_multiple_bases_in_range.pl ├── squarefree_strong_fermat_pseudoprimes_to_multiple_bases_in_range_mpz.pl ├── stern_brocot_encoding.pl ├── stern_brocot_sequence.pl ├── strong_fermat_pseudoprimes_in_range.pl ├── strong_fermat_pseudoprimes_in_range_mpz.pl ├── sub-unit_squares.pl ├── sum_factorial.pl ├── sum_of_an_even_number_of_positive_squares.pl ├── sum_of_digits.pl ├── sum_of_digits_subquadratic_algorithm.pl ├── sum_of_digits_subquadratic_algorithm_mpz.pl ├── sum_of_k-powerful_numbers_in_range.pl ├── sum_of_natural_powers_in_constant_base.pl ├── sum_of_perfect_powers.pl ├── sum_of_prime-power_exponents_of_factorial.pl ├── sum_of_prime-power_exponents_of_product_of_binomials.pl ├── sum_of_prime_powers.pl ├── sum_of_primes_generalized.pl ├── sum_of_sigma.pl ├── sum_of_sigma_2.pl ├── sum_of_the_number_of_divisors.pl ├── sum_of_the_number_of_divisors_of_gcd_x_y.pl ├── sum_of_the_number_of_unitary_divisors.pl ├── sum_of_the_sum_of_divisors.pl ├── sum_of_three_cubes_problem.pl ├── sum_of_triangular_numbers_solutions.pl ├── sum_of_two_primes.pl ├── sum_of_two_squares_all_solutions.pl ├── sum_of_two_squares_multiple_solutions.pl ├── sum_of_two_squares_solution.pl ├── sum_remainders.pl ├── super_pandigital_numbers.pl ├── tangent_numbers.pl ├── trial_division_fast.pl ├── triangle_hyperoperation.pl ├── triangle_interior_angles.pl ├── tribonacci_primality_test.pl ├── trip2mars.pl ├── unitary_divisors.pl ├── unitary_divisors_fast.pl ├── unitary_squarefree_divisors.pl ├── wilson_prime_formula.pl ├── yahtzee.pl ├── zequals.pl ├── zeta_2n.pl ├── zeta_for_primes.pl ├── zeta_function.pl └── zeta_prime_count_approx.pl ├── Media └── wimp-viewer ├── Microphone ├── Alsa │ └── raw_from_microphone.pl └── Julius │ ├── julius_voice_control_concept.pl │ └── voice_control.pl ├── Monitoring └── file-monitor ├── Other ├── concatenation_weirdness.pl ├── lexical_subs_recursion_bug.pl ├── tail_recursion.pl └── yafu_factorization.pl ├── README.md ├── Regex ├── positive-negative_matching.pl ├── prime_regexp.pl ├── regex_optimizer_in_source.pl ├── regex_pair_factors.pl └── regexp_to_strings.pl ├── Search ├── binary_search.pl ├── binary_search_ge.pl └── binary_search_le.pl ├── Shell └── execute_perl_scripts.pl ├── Simulation └── 100_prisoners_riddle.pl ├── Socket └── chat_server.pl ├── Sort └── binsertion_sorting_algorithm.pl ├── Subtitle ├── srt-delay ├── srt_assembler.pl └── srt_fix.pl ├── Text ├── abs_string.pl ├── all_substrings.pl ├── change-encoding.pl ├── group_alike_words.pl ├── jaro-winkler_distance.pl ├── levenshtein_distance_iter.pl ├── levenshtein_distance_rec.pl ├── markov_chain_text_generator.pl ├── orthogonal_text_scrambling.pl ├── orthogonal_text_scrambling_double.pl ├── repeated_substrings.pl ├── search_by_prefix.pl ├── sim_end_words.pl ├── smartWordWrap.pl ├── smartWordWrap_lazy.pl ├── smartWordWrap_simple.pl ├── unique_prefixes.pl ├── word_roots.pl └── word_unscrambler.pl ├── Time ├── calendar.pl └── contdown.pl ├── Visualisators ├── binview.pl ├── disk-stats.pl ├── dnscrypt_stats.pl ├── greycmd.pl ├── human-finder-visual.pl ├── lz_visual.pl ├── matrix_path_2-ways_best.pl ├── matrix_path_3-ways_best.pl ├── matrix_path_3-ways_greedy.pl ├── pview ├── random_finder_visual.pl ├── triangle_sub-string_finder.pl ├── visual_lz77_compression.pl └── visual_sudoku_dice_solver.pl └── update_readme.pl /.gitignore: -------------------------------------------------------------------------------- 1 | /blib/ 2 | /.build/ 3 | _build/ 4 | cover_db/ 5 | inc/ 6 | Build 7 | !Build/ 8 | Build.bat 9 | .last_cover_stats 10 | /Makefile 11 | /Makefile.old 12 | /MANIFEST.bak 13 | /META.yml 14 | /META.json 15 | /MYMETA.* 16 | nytprof.out 17 | /pm_to_blib 18 | *.o 19 | *.bs 20 | Math/convergent_series.db 21 | Research/ 22 | -------------------------------------------------------------------------------- /Analyzers/char_counter.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # Count and list the unique characters within a file. 5 | 6 | use strict; 7 | use warnings; 8 | use open IO => ':utf8', ':std'; 9 | 10 | my $file = shift @ARGV; 11 | 12 | die "usage: $0 file\n" unless -f $file; 13 | 14 | my %hash; 15 | open my $fh, '<', $file; 16 | 17 | while (defined(my $l = getc $fh)) { 18 | next if exists $hash{$l}; 19 | $hash{$l} = (); 20 | } 21 | close $fh; 22 | 23 | { 24 | local $, = ' '; 25 | print '-' x 80 . "\n"; 26 | 27 | print my (@list) = (sort { lc $a cmp lc $b } keys %hash); 28 | 29 | print "\n" . '-' x 80 . "\n"; 30 | print unpack('C*', join('', @list)); 31 | print "\n" . '-' x 80 . "\n"; 32 | } 33 | 34 | printf "\n** Unique characters used: %d\n\n", scalar keys %hash; 35 | -------------------------------------------------------------------------------- /Analyzers/dieharder.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # 4 | ## Test Perl's pseudorandom number generator with `dieharder`. 5 | # 6 | 7 | # usage: 8 | # perl dieharder.pl > rand.txt && dieharder -g 202 -f rand.txt -a 9 | 10 | use 5.014; 11 | use strict; 12 | use warnings; 13 | 14 | my $seed = srand(); 15 | my $count = 1e6; 16 | my $bits = 32; 17 | 18 | print <<"EOT"; 19 | #================================================================== 20 | # generator lcg seed = $seed 21 | #================================================================== 22 | type: d 23 | count: $count 24 | numbit: $bits 25 | EOT 26 | 27 | my $max = 2**$bits; 28 | 29 | for (1 .. $count) { 30 | say int(rand($max)); 31 | } 32 | -------------------------------------------------------------------------------- /Analyzers/first_letter_top.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 25 June 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Make a top with the first letters of each word in a given text. 9 | 10 | # usage: cat file.txt | perl first_letter_top.pl 11 | 12 | use 5.014; 13 | use strict; 14 | use warnings; 15 | 16 | use List::Util qw(sum); 17 | use open IO => ':utf8', ':std'; 18 | 19 | my %table; 20 | 21 | foreach my $word (split(' ', do { local $/; <> })) { 22 | if ($word =~ /^[^\pL]*(\pL)/) { 23 | $table{lc($1)}++; 24 | } 25 | } 26 | 27 | my $max = sum(values %table); 28 | 29 | foreach my $key (sort { $table{$b} <=> $table{$a} } keys %table) { 30 | printf("%s -> %3d (%5.2f%%)\n", $key, $table{$key}, $table{$key} / $max * 100); 31 | } 32 | -------------------------------------------------------------------------------- /Analyzers/kcal/products.csv: -------------------------------------------------------------------------------- 1 | name, kcal/100g, price/100g 2 | Milk (1.5% fat),44,0.3 3 | Dark chocolate (50% cacao),519,2.7 4 | Mustard,178,0.93 5 | Mountain dew,52,0.54 6 | Sour cream (12% fat),131,0.7 7 | Sour cream (20% fat),207,0.9 8 | Pearl barley,352,0.3 9 | Corn flour,350,0.2 10 | Pufuleti,427,1.2 11 | Beer,40,0.37 12 | Chocolate (30% cacao),521,2.45 13 | Yogurt (2.5% fat),51,0.38 14 | Fish eggs,553,1.53 15 | Strong beer,53,0.4 16 | Eggs,130,0.86 17 | Wheat flakes,304,0.4 18 | Pork meat,541,2.4 19 | Ice cream,226,1.6 20 | -------------------------------------------------------------------------------- /Analyzers/unidecode_word_top.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 11 March 2013 6 | # https://github.com/trizen 7 | 8 | # usage: perl unidecode_word_top.pl [file] 9 | 10 | use 5.010; 11 | use strict; 12 | use autodie; 13 | use warnings; 14 | use Text::Unidecode qw(unidecode); 15 | 16 | open my $fh, '<:encoding(UTF-8)', shift; 17 | 18 | my %table; 19 | while (<$fh>) { 20 | my @words = split(' ', unidecode(lc $_)); 21 | s{^[[:punct:]]+}{}, s{[[:punct:]]+\z}{} for @words; 22 | /^\w/ && /\w\z/ && $table{$_}++ for @words; 23 | } 24 | 25 | foreach my $key (sort { $table{$b} <=> $table{$a} || $a cmp $b } keys %table) { 26 | printf "%-50s%4s\n", $key, $table{$key}; 27 | } 28 | -------------------------------------------------------------------------------- /Analyzers/wcer.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Count words in a text file 4 | # Coded by Trizen under GPL. 5 | # usage: cat file.txt | perl wcer 6 | # perl wcer file.txt 7 | 8 | my $x = 0; 9 | while (<>) {$x+=split' '} 10 | print STDOUT "$x\n"; 11 | exit 0; 12 | -------------------------------------------------------------------------------- /Analyzers/word_suffix_top.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 05 April 2015 6 | # https://github.com/trizen 7 | 8 | # Word suffix top 9 | 10 | use 5.014; 11 | use autodie; 12 | use warnings; 13 | 14 | use Text::Unidecode qw(unidecode); 15 | 16 | my %top; 17 | my $file = shift() // die "usage: $0 file [suffix len]\n"; 18 | my $i = shift() // 3; 19 | my $total = 0; 20 | 21 | { 22 | open my $fh, '<:utf8', $file; 23 | while (<$fh>) { 24 | s/[_\W]+\z//; 25 | if (/(\w{$i})\z/) { 26 | ++$top{lc(unidecode($1))}; 27 | ++$total; 28 | } 29 | } 30 | close $fh; 31 | } 32 | 33 | my $lonely = 0; 34 | foreach my $key (sort { $top{$b} <=> $top{$a} or $a cmp $b } keys %top) { 35 | printf("%s%10s%10.02f%%\n", $key, $top{$key}, $top{$key} / $total * 100); 36 | ++$lonely if ($top{$key} == 1); 37 | } 38 | 39 | printf "\n** Unique suffixes: %.02f%%\n", $lonely / $total * 100; 40 | -------------------------------------------------------------------------------- /Benchmarks/array_range_vs_shift.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.014; 4 | 5 | use Benchmark qw(cmpthese); 6 | 7 | package Foo { 8 | 9 | sub new { 10 | bless {}, __PACKAGE__; 11 | } 12 | 13 | sub call_me { } 14 | 15 | sub bar { 16 | $_[0]->call_me(@_[1 .. $#_]); 17 | } 18 | 19 | sub baz { 20 | shift(@_)->call_me(@_); 21 | } 22 | } 23 | 24 | my $obj = Foo->new(); 25 | 26 | cmpthese( 27 | -1, 28 | { 29 | with_shift => sub { 30 | $obj->baz(1, 2, 3, 4, 5); 31 | $obj->baz(); 32 | $obj->baz(1); 33 | $obj->baz(1, 2); 34 | }, 35 | with_range => sub { 36 | $obj->bar(1, 2, 3, 4, 5); 37 | $obj->bar(); 38 | $obj->bar(1); 39 | $obj->bar(1, 2); 40 | }, 41 | } 42 | ); 43 | 44 | __END__ 45 | Rate with_range with_shift 46 | with_range 721308/s -- -33% 47 | with_shift 1071850/s 49% -- 48 | -------------------------------------------------------------------------------- /Benchmarks/schwartzian_transform.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Performance comparison of Schwartzian transform. 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Schwartzian_transform 7 | 8 | use 5.010; 9 | use Benchmark qw(cmpthese); 10 | 11 | my @alpha = map { chr($_) } 32 .. 127; 12 | my @arr = ( 13 | map { 14 | join('', map { $alpha[rand @alpha] } 1 .. 140) 15 | } 1 .. 100 16 | ); 17 | 18 | cmpthese( 19 | -1, 20 | { 21 | schwartz => sub { 22 | my @sorted = map { $_->[1] } 23 | sort { $a->[0] cmp $b->[0] } 24 | map { [lc($_), $_] } @arr; 25 | @sorted; 26 | }, 27 | without_schwartz => sub { 28 | my @sorted = sort { lc($a) cmp lc($b) } @arr; 29 | @sorted; 30 | }, 31 | } 32 | ); 33 | 34 | __END__ 35 | Rate without_schwartz schwartz 36 | without_schwartz 4403/s -- -53% 37 | schwartz 9309/s 111% -- 38 | -------------------------------------------------------------------------------- /Benchmarks/types_of_variables.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Performance comparison between `state`, `my` and global variables. 4 | 5 | use 5.010; 6 | use Benchmark qw(cmpthese); 7 | 8 | cmpthese( 9 | -1, 10 | { 11 | my => sub { 12 | my $x = rand(1); 13 | $x + 1; 14 | }, 15 | state => sub { 16 | state $x; 17 | $x = rand(1); 18 | $x + 1; 19 | }, 20 | global => sub { 21 | $main::global = rand(1); 22 | $main::global + 1; 23 | } 24 | } 25 | ); 26 | 27 | 28 | __END__ 29 | Rate my global state 30 | my 12105605/s -- -17% -44% 31 | global 14563555/s 20% -- -32% 32 | state 21462081/s 77% 47% -- 33 | -------------------------------------------------------------------------------- /Converters/from_hex.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Convert HEX to binary. 4 | 5 | use 5.020; 6 | use strict; 7 | use warnings; 8 | 9 | use Getopt::Long qw(GetOptions); 10 | 11 | my $low_nybble = 0; 12 | 13 | GetOptions("l|low!" => \$low_nybble) 14 | or die "Error in arguments"; 15 | 16 | my $hex_str = ''; 17 | 18 | while (<>) { 19 | 20 | # Make sure the line starts with an hexadecimal 21 | if (/^[[:xdigit:]]/) { 22 | 23 | # Collect all hexadecimal strings from the line 24 | while (/([[:xdigit:]]+)/g) { 25 | $hex_str .= $1; 26 | } 27 | } 28 | } 29 | 30 | binmode(STDOUT, ':raw'); 31 | print pack(($low_nybble ? "h*" : "H*"), $hex_str); 32 | -------------------------------------------------------------------------------- /Converters/gdbm_to_berkeley.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # Date: 03 April 2023 5 | # https://github.com/trizen 6 | 7 | # Convert a GDBM database to a Berkeley database. 8 | 9 | use 5.036; 10 | use DB_File; 11 | use GDBM_File; 12 | 13 | scalar(@ARGV) == 2 or die "usage: $0 [input.dbm] [output.dbm]"; 14 | 15 | my $input_file = $ARGV[0]; 16 | my $output_file = $ARGV[1]; 17 | 18 | if (not -f $input_file) { 19 | die "Input file <<$input_file>> does not exist!\n"; 20 | } 21 | 22 | if (-e $output_file) { 23 | die "Output file <<$output_file>> already exists!\n"; 24 | } 25 | 26 | tie(my %input, 'GDBM_File', $input_file, &GDBM_READER, 0555) 27 | or die "Can't access database <<$input_file>>: $!"; 28 | 29 | tie(my %output, 'DB_File', $output_file, O_CREAT | O_RDWR, 0666, $DB_HASH) 30 | or die "Can't create database <<$output_file>>: $!"; 31 | 32 | while (my ($key, $value) = each %input) { 33 | $output{$key} = $value; 34 | } 35 | 36 | untie(%input); 37 | untie(%output); 38 | -------------------------------------------------------------------------------- /Converters/unicode2ascii.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 29 April 2012 5 | # Edit: 12 March 2023 6 | # https://github.com/trizen 7 | 8 | # Substitute Unicode characters with ASCII characters in a stream input. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Encode qw(decode_utf8); 15 | use Text::Unidecode qw(unidecode); 16 | 17 | while (defined(my $line = <>)) { 18 | print unidecode(decode_utf8($line)); 19 | } 20 | -------------------------------------------------------------------------------- /Converters/vnt2txt_simple.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 08 May 2013 6 | # https://github.com/trizen 7 | 8 | # Convert a .vnt file to a plain text file and set the right modification time. 9 | 10 | use strict; 11 | use warnings; 12 | 13 | use Date::Parse; 14 | use File::Slurper qw(read_text write_text); 15 | 16 | my $source = shift() // die "usage: $0 [vnt file]\n"; 17 | 18 | read_text($source) =~ /^BODY.*?:(.*?)\R^DCREATED:(\S+)\R^LAST-MODIFIED:(\S+)/ms; 19 | 20 | write_text((my $tfile = 21 | join('-', unpack("A4A2A2", $2)) . 22 | '.' . join(".", unpack("x9A2A2A2", $2)) . '.txt'), $1); 23 | 24 | utime time(), str2time($3), $tfile, $source; 25 | -------------------------------------------------------------------------------- /Digest/crc32.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Simple implementation of the Cyclic Redundancy Check (CRC32). 4 | 5 | # Reference: 6 | # https://web.archive.org/web/20240718094514/https://rosettacode.org/wiki/CRC-32 7 | 8 | use 5.036; 9 | 10 | sub create_table() { 11 | my @table; 12 | for my $i (0 .. 255) { 13 | my $k = $i; 14 | for (0 .. 7) { 15 | if ($k & 1) { 16 | $k >>= 1; 17 | $k ^= 0xedb88320; 18 | } 19 | else { 20 | $k >>= 1; 21 | } 22 | } 23 | push @table, $k; 24 | } 25 | return \@table; 26 | } 27 | 28 | sub crc32($str, $crc = 0) { 29 | state $crc_table = create_table(); 30 | $crc ^= 0xffffffff; 31 | foreach my $c (unpack("C*", $str)) { 32 | $crc = ($crc >> 8) ^ $crc_table->[($crc & 0xff) ^ $c]; 33 | } 34 | return ($crc ^ 0xffffffff); 35 | } 36 | 37 | say crc32 "The quick brown fox jumps over the lazy dog"; 38 | say crc32("over the lazy dog", crc32("The quick brown fox jumps ")); 39 | -------------------------------------------------------------------------------- /Encryption/crypt_rsa.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Using Crypt::RSA with a specific private key. 4 | 5 | use 5.014; 6 | use Crypt::RSA; 7 | 8 | my $rsa = Crypt::RSA->new; 9 | my $key = Crypt::RSA::Key->new; 10 | 11 | my ($public, $private) = 12 | $key->generate( 13 | p => "94424081139901371883469166542407095517576260048697655243", 14 | q => "79084622052242264844238683495727691663247340251867615781", 15 | e => 65537, 16 | ) 17 | or die "error"; 18 | 19 | my $cyphertext = $rsa->encrypt( 20 | Message => "Hello world!", 21 | Key => $public, 22 | Armour => 1, 23 | ) 24 | || die $rsa->errstr(); 25 | 26 | say $cyphertext; 27 | 28 | my $plaintext = $rsa->decrypt( 29 | Cyphertext => $cyphertext, 30 | Key => $private, 31 | Armour => 1, 32 | ) 33 | || die $rsa->errstr(); 34 | 35 | say $plaintext; 36 | -------------------------------------------------------------------------------- /File Readers/ldump: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 26 February 2013 6 | # https://github.com/trizen 7 | 8 | # Get the specified lines from a given file. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | @ARGV == 2 or die <<"USAGE"; 15 | usage: ldump [file] [lines] 16 | 17 | example: ldump /tmp/file.txt 23-40,80,105 18 | USAGE 19 | 20 | my @lines = map { /^(\d+)(?>-|\.\.)(\d+)\z/ ? ($1 .. $2) : $_ } 21 | split /\s*,\s*/, pop; 22 | 23 | my %lookup; 24 | @lookup{@lines} = (); 25 | 26 | while (<>) { 27 | print if exists($lookup{$.}); 28 | } 29 | -------------------------------------------------------------------------------- /File Readers/multi-file-line-reader.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 13 April 2012 6 | # https://github.com/trizen 7 | 8 | # If you saw this code on perlmonks.org, 9 | # posted by an Anonymous Monk, that was me. 10 | 11 | my (@files) = @ARGV ? @ARGV : ($0, $0); 12 | 13 | my @fh; 14 | my $i = 0; 15 | 16 | foreach my $file (@files) { 17 | next unless -f -r $file; 18 | open $fh[$i++], '<', $file 19 | or die "Cannot open ${file}: $!"; 20 | } 21 | 22 | while (1) { 23 | my @lines; 24 | 25 | foreach my $i (0 .. $#fh) { 26 | 27 | next unless ref $fh[$i] eq 'GLOB'; 28 | push @lines, scalar readline $fh[$i]; 29 | 30 | if (eof $fh[$i]) { 31 | close $fh[$i]; 32 | $fh[$i] = undef; 33 | } 34 | } 35 | 36 | last unless @lines; 37 | 38 | foreach my $line (@lines) { 39 | print $line; 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /File Readers/n_repeated_lines.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 25 April 2014 6 | # Website: https://github.com/trizen 7 | 8 | # Print only the lines that repeat n times in one or more files. 9 | # usage: perl n_repeated_lines.pl [n] [file1.txt] [...] 10 | 11 | use strict; 12 | use warnings; 13 | 14 | my $n = @ARGV && not(-f $ARGV[0]) ? shift() : 2; 15 | 16 | my %seen; 17 | while (<>) { 18 | /\S/ || next; 19 | ++$seen{unpack('A*')} == $n && print; 20 | } 21 | -------------------------------------------------------------------------------- /File Readers/tailz: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Simple program to read the last n line(s) of a file. 4 | # Reads from the end of the file for efficiency. 5 | 6 | # Originally coded by zentara on 06 September 2002: 7 | # https://www.perlmonks.org/index.pl?node_id=195768 8 | 9 | # Improved by Trizen on 11 February 2012 10 | 11 | # usage tailz filename numberoflines 12 | 13 | my $filename = shift or die "usage: $0 file numlines\n"; 14 | my $numlines = shift // 10; 15 | my $byte; 16 | 17 | # Open the file in read mode 18 | open my $fh, '<', $filename or die "Couldn't open $filename: $!"; 19 | 20 | # Rewind from the end of the file until count of eol 's 21 | seek $fh, -1, 2; # get past last eol 22 | my $count = 0; 23 | 24 | while (tell($fh) > 0) { 25 | seek $fh, -1, 1; 26 | read $fh, $byte, 1; 27 | last if $byte eq "\n" and ++$count == $numlines; 28 | seek $fh, -1, 1; 29 | } 30 | 31 | local $/ = undef; 32 | print scalar <$fh>; 33 | -------------------------------------------------------------------------------- /File Workers/delete_if_exists.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # https://github.com/trizen 6 | 7 | # 8 | # Delete files from $delete_dir if exists in $compare_dir (or its sub-directories) 9 | # 10 | # Usage: perl delete_if_exists.pl /delete/dir /compare/dir 11 | # 12 | 13 | use strict; 14 | use warnings; 15 | 16 | use File::Find qw(find); 17 | use File::Spec::Functions qw(rel2abs catdir); 18 | 19 | my $delete_dir = rel2abs(shift); 20 | my $compare_dir = rel2abs(shift || die "usage: $0 [delete_dir] [compare_dir]\n"); 21 | 22 | find sub { 23 | return unless -f; 24 | my $delete_file = catdir($delete_dir, $_); 25 | if (-f $delete_file) { 26 | print unlink($delete_file) 27 | ? "** Deleted: $delete_file\n" 28 | : "[!] Can't delete $delete_file: $!\n"; 29 | } 30 | } => $compare_dir; 31 | -------------------------------------------------------------------------------- /File Workers/remove_eof_newlines.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # Remove newline characters from the end of files 5 | 6 | # WARNING: No backup files are created! 7 | 8 | use strict; 9 | use warnings; 10 | use Tie::File; 11 | 12 | foreach my $filename (grep { -f } @ARGV) { 13 | 14 | print "** Processing $filename\n"; 15 | 16 | tie my @file, 'Tie::File', $filename 17 | or die "Unable to tie: $!\n"; 18 | 19 | pop @file while $file[-1] eq q{}; 20 | 21 | untie @file 22 | or die "Unable to untie: $!\n"; 23 | 24 | print "** Done.\n\n"; 25 | } 26 | -------------------------------------------------------------------------------- /Finders/find_perl_scripts.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # License: GPLv3 5 | # Date: 15 March 2012 6 | 7 | # Find perl scripts in a directory and its subdirectories 8 | 9 | use 5.010; 10 | use File::Find qw(find); 11 | 12 | my @dirs = grep { -d } @ARGV or die "usage: $0 [dirs]\n"; 13 | 14 | find { 15 | wanted => sub { 16 | if (/\.p[lm]$/i) { say } 17 | elsif (-T and open my $fh, '<', $_) { 18 | my $head = <$fh> || return; 19 | if ($head =~ m{^\s*#\s*!.*\bperl\d*\b}) { say } 20 | } 21 | }, 22 | no_chdir => 1 23 | }, @dirs 24 | -------------------------------------------------------------------------------- /Formatters/js_beautify: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use File::Slurper qw(read_text); 6 | use JavaScript::Beautifier qw(js_beautify); 7 | 8 | @ARGV && -f $ARGV[0] or die "usage: $0 \n"; 9 | 10 | print js_beautify( 11 | scalar read_text(shift) => { 12 | indent_size => 1, 13 | indent_character => "\t", 14 | } 15 | ); 16 | -------------------------------------------------------------------------------- /GD/AND_sierpinski_triangle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 20 January 2017 6 | # https://github.com/trizen 7 | 8 | # Generation of the Sierpinski triangle, 9 | # by plotting the values of the function 10 | # 11 | # f(n) = n AND n^2 12 | # 13 | 14 | # See also: 15 | # https://oeis.org/A213541 16 | # https://en.wikipedia.org/wiki/Sierpinski_triangle 17 | 18 | use 5.010; 19 | use strict; 20 | use warnings; 21 | 22 | use Imager; 23 | 24 | my $size = 1300; 25 | my $factor = 100; 26 | my $red = Imager::Color->new('#ff0000'); 27 | 28 | my $img = Imager->new(xsize => $size, 29 | ysize => $size); 30 | 31 | foreach my $n (1 .. $size * $factor) { 32 | $img->setpixel( 33 | x => $n / $factor, 34 | y => $size - ($n & ($n * $n)) / $factor, 35 | color => $red 36 | ); 37 | } 38 | 39 | $img->write(file => 'sierpinski_triangle.png'); 40 | -------------------------------------------------------------------------------- /GD/LSystem/honeycomb.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use lib qw(.); 8 | use LSystem; 9 | 10 | my %rules = ( 11 | A => '-A-B+B+B+B+', 12 | B => '-A+B+A+B+A+B+A-', 13 | ); 14 | 15 | my $lsys = LSystem->new( 16 | width => 1000, 17 | height => 1000, 18 | 19 | scale => 1, 20 | xoff => -500, 21 | yoff => -400, 22 | 23 | len => 20, 24 | angle => 60, 25 | color => 'orange', 26 | ); 27 | 28 | $lsys->execute('A', 6, "honeycomb.png", %rules); 29 | -------------------------------------------------------------------------------- /GD/LSystem/honeycomb_2.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use lib qw(.); 8 | use LSystem; 9 | 10 | my %rules = ( 11 | F => '+F-F-F-F-F-F-F-F-F+', # or: '+F-F-F-F-F-F-F+' 12 | ); 13 | 14 | my $lsys = LSystem->new( 15 | width => 1200, 16 | height => 1000, 17 | 18 | scale => 1, 19 | xoff => -600, 20 | yoff => -180, 21 | 22 | len => 20, 23 | angle => 60, 24 | color => 'orange', 25 | ); 26 | 27 | $lsys->execute('F', 5, "honeycomb_2.png", %rules); 28 | -------------------------------------------------------------------------------- /GD/LSystem/plant.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use lib qw(.); 8 | use LSystem; 9 | 10 | my %rules = (S => 'SS+[+S-S-S]-[-S+S+S]'); 11 | 12 | my $lsys = LSystem->new( 13 | width => 1000, 14 | height => 1000, 15 | xoff => -600, 16 | 17 | len => 8, 18 | angle => 25, 19 | color => 'dark green', 20 | ); 21 | 22 | $lsys->execute('S', 5, "plant.png", %rules); 23 | -------------------------------------------------------------------------------- /GD/LSystem/plant_2.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use lib qw(.); 8 | use LSystem; 9 | 10 | my %rules = ( 11 | S => 'T-[[S]+S]+T[+TS]-S', 12 | T => 'TT', # or: 'T[S]T' 13 | ); 14 | 15 | my $lsys = LSystem->new( 16 | width => 1000, 17 | height => 1000, 18 | 19 | scale => 0.7, 20 | xoff => -200, 21 | yoff => 300, 22 | 23 | len => 8, 24 | angle => 25, 25 | color => 'dark green', 26 | ); 27 | 28 | $lsys->execute('S', 6, "plant_2.png", %rules); 29 | -------------------------------------------------------------------------------- /GD/LSystem/plant_3.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use lib qw(.); 8 | use LSystem; 9 | 10 | my %rules = (F => 'FF-[-F+F-F]+[+F-F]'); 11 | 12 | my $lsys = LSystem->new( 13 | width => 1000, 14 | height => 1000, 15 | xoff => -350, 16 | 17 | len => 8, 18 | angle => 25, 19 | color => 'dark green', 20 | ); 21 | 22 | $lsys->execute('F', 5, "plant_3.png", %rules); 23 | -------------------------------------------------------------------------------- /GD/LSystem/sierpinski_triangle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | use lib qw(.); 8 | use LSystem; 9 | 10 | my %rules = ( 11 | S => 'S--S--S--T', 12 | T => 'TT', 13 | ); 14 | 15 | my $lsys = LSystem->new( 16 | width => 1000, 17 | height => 1000, 18 | 19 | scale => 0.4, 20 | xoff => -280, 21 | yoff => 400, 22 | 23 | len => 30, 24 | angle => 120, 25 | turn => 30, 26 | color => 'dark red', 27 | ); 28 | 29 | $lsys->execute('S--S--S', 7, "sierpinski_triangle.png", %rules); 30 | -------------------------------------------------------------------------------- /GD/LSystem/tree.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use lib qw(.); 7 | use LSystem; 8 | 9 | my %rules = ( 10 | a => 'S[---l:a][++++b]', 11 | b => 'S[++lb][--c]', 12 | c => 'S[-----lb]gS[+:c]', 13 | l => '[{S+S+S+S+S+S}]' 14 | ); 15 | 16 | my $lsys = LSystem->new( 17 | width => 800, 18 | height => 800, 19 | xoff => -400, 20 | 21 | len => 35, 22 | angle => 5, 23 | color => 'dark green', 24 | ); 25 | 26 | $lsys->execute('a', 10, "tree.png", %rules); 27 | -------------------------------------------------------------------------------- /GD/XOR_pattern.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 30 October 2017 5 | # https://github.com/trizen 6 | 7 | # Generation of a colored-table of values `n^k (mod m)`, where `n` are the rows and `k` are the columns. 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use Imager; 14 | 15 | my $size = 1000; 16 | my $red = Imager::Color->new('#ff0000'); 17 | 18 | my $img = Imager->new(xsize => $size, 19 | ysize => $size); 20 | 21 | my $mod = 7; 22 | 23 | my @colors = map { 24 | Imager::Color->new(sprintf("#%x", rand(256**3))) 25 | } 1 .. $mod; 26 | 27 | foreach my $n (0 .. $size - 1) { 28 | foreach my $k (0 .. $size - 1) { 29 | $img->setpixel(x => $k, y => $n, color => $colors[($n ^ $k) % $mod]); 30 | } 31 | } 32 | 33 | $img->write(file => 'xor_pattern.png'); 34 | -------------------------------------------------------------------------------- /GD/abstract_map.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 07 June 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate a complex shape using basic mathematics. 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | 17 | my $max = 1200000; 18 | my $limit = int(sqrt($max)) - 1; 19 | 20 | # create a new image 21 | my $img = GD::Simple->new($limit * 4, $limit * 2); 22 | 23 | # move to right 24 | $img->moveTo($limit * 3.20, $limit); 25 | 26 | my $j = 1; 27 | foreach my $i (1 .. $limit) { 28 | 29 | for my $n ($j .. $i**2) { 30 | $img->line(2); 31 | $img->turn($n**2 / $i); 32 | ++$j; 33 | } 34 | 35 | } 36 | 37 | open my $fh, '>:raw', "abstract_map.png"; 38 | print $fh $img->png; 39 | close $fh; 40 | -------------------------------------------------------------------------------- /GD/barnsley_fern_fractal.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 20 March 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Perl implementation of the Barnsley fern fractal. 9 | # See: https://en.wikipedia.org/wiki/Barnsley_fern 10 | 11 | use Imager; 12 | 13 | my $w = 640; 14 | my $h = 640; 15 | 16 | my $img = Imager->new(xsize => $w, ysize => $h, channels => 3); 17 | my $green = Imager::Color->new('#00FF00'); 18 | 19 | my ($x, $y) = (0, 0); 20 | 21 | foreach (1 .. 1e5) { 22 | my $r = rand(100); 23 | ($x, $y) = 24 | $r <= 1 ? ( 0.00 * $x - 0.00 * $y, 0.00 * $x + 0.16 * $y + 0.00) : 25 | $r <= 8 ? ( 0.20 * $x - 0.26 * $y, 0.23 * $x + 0.22 * $y + 1.60) : 26 | $r <= 15 ? (-0.15 * $x + 0.28 * $y, 0.26 * $x + 0.24 * $y + 0.44) : 27 | ( 0.85 * $x + 0.04 * $y, -0.04 * $x + 0.85 * $y + 1.60) ; 28 | $img->setpixel(x => $w / 2 + $x * 60, y => $y * 60, color => $green); 29 | } 30 | 31 | $img->flip(dir => 'v'); 32 | $img->write(file => 'barnsleyFern.png'); 33 | -------------------------------------------------------------------------------- /GD/binary_triangle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 16 January 2017 6 | # https://github.com/trizen 7 | 8 | # Draws a balanced binary triangle with n branches on each side. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Imager; 15 | use ntheory qw(:all); 16 | 17 | sub line { 18 | my ($img, $x, $y, $d, $n) = @_; 19 | 20 | my $x2 = $x + $n * $d; 21 | my $y2 = $y + $n * ($d ? 1 : 0); 22 | 23 | $img->line( 24 | color => 'red', 25 | x1 => $x, 26 | x2 => $x2, 27 | y1 => $y, 28 | y2 => $y2, 29 | ); 30 | 31 | return if $n <= 1; 32 | 33 | line($img, $x2, $y2, +1, $n >> 1); 34 | line($img, $x2, $y2, -1, $n >> 1); 35 | } 36 | 37 | my $n = 1024; 38 | 39 | my $img = Imager->new(xsize => $n * 2, ysize => $n); 40 | line($img, $n, 0, 0, $n); 41 | $img->write(file => 'binary_triangle.png'); 42 | -------------------------------------------------------------------------------- /GD/black_star_turtle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use integer; 4 | use strict; 5 | use warnings; 6 | 7 | use GD::Simple; 8 | 9 | my $img = 'GD::Simple'->new(1000, 1000); 10 | $img->moveTo(700, 500); 11 | 12 | my $nr = 442; 13 | 14 | sub t { $img->turn($_[0]) } 15 | sub l { $img->line($_[0]) } 16 | 17 | for (0 .. $nr) { 18 | t 45; 19 | 20 | #l $nr+$_; 21 | t -180; 22 | l $nr/ 2; 23 | t 45; 24 | l $nr / 2; 25 | t -180; 26 | l $nr; 27 | 28 | #t -180; 29 | #l $nr / 2; 30 | #t 90; 31 | #l $nr/2; 32 | t -180; 33 | l $nr+ $_; 34 | } 35 | 36 | my $image_name = 'black_star_turtle.png'; 37 | 38 | open my $fh, '>', $image_name or die $!; 39 | print {$fh} $img->png; 40 | close $fh; 41 | -------------------------------------------------------------------------------- /GD/box_pattern.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 24 May 2017 6 | # https://github.com/trizen 7 | 8 | # Generates an interesting pattern. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Imager; 15 | 16 | my $size = 1000; 17 | my $img = Imager->new(xsize => $size, ysize => $size); 18 | 19 | foreach my $x (1 .. $size) { 20 | foreach my $y (1 .. $size) { 21 | if (($x * $y) % (int(sqrt($x)) + int(sqrt($y))) == 0) { 22 | $img->setpixel(x => $x - 1, y => $y - 1, color => 'red'); 23 | } 24 | } 25 | } 26 | 27 | $img->write(file => 'box_pattern.png'); 28 | -------------------------------------------------------------------------------- /GD/circular_triangle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 08 June 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate a circular triangle based on triangular numbers. 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | 17 | my $from = 0; 18 | my $step = 1; 19 | 20 | my $max = 3_000_000; 21 | my $limit = int(sqrt($max)); 22 | 23 | # create a new image 24 | my $img = GD::Simple->new($limit * 6, $limit * 6); 25 | 26 | # move to right 27 | $img->moveTo($limit * 2.75, $limit * 1.75); 28 | 29 | my $j = 1; 30 | foreach my $i (1 .. $limit) { 31 | 32 | for my $n ($j .. $i**2) { 33 | $img->line(1); 34 | $img->turn(($from + $i) * (($i - $from) / $step + 1) / 2); 35 | ++$j; 36 | } 37 | 38 | ++$i; 39 | } 40 | 41 | open my $fh, '>:raw', "circular_triangle.png"; 42 | print $fh $img->png; 43 | close $fh; 44 | -------------------------------------------------------------------------------- /GD/color_wheel.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Draw a HSV color wheel. 4 | 5 | # Algorithm from: 6 | # https://rosettacode.org/wiki/Color_wheel 7 | 8 | use 5.010; 9 | use strict; 10 | use warnings; 11 | 12 | use Imager; 13 | use Math::GComplex qw(cplx i); 14 | 15 | my ($width, $height) = (300, 300); 16 | my $center = cplx($width / 2, $height / 2); 17 | 18 | my $img = Imager->new(xsize => $width, 19 | ysize => $height); 20 | 21 | my $pi = atan2(0, -1); 22 | 23 | foreach my $y (0 .. $height - 1) { 24 | foreach my $x (0 .. $width - 1) { 25 | 26 | my $vector = $center - $x - $y * i; 27 | my $magnitude = 2 * abs($vector) / $width; 28 | my $direction = ($pi + atan2($vector->real, $vector->imag)) / (2 * $pi); 29 | 30 | $img->setpixel( 31 | x => $x, 32 | y => $y, 33 | color => {hsv => [360 * $direction, $magnitude, $magnitude < 1 ? 1 : 0]} 34 | ); 35 | } 36 | } 37 | 38 | $img->write(file => 'color_wheel.png'); 39 | -------------------------------------------------------------------------------- /GD/complex_square.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # Date: 07 January 2016 5 | # License: GPLv3 6 | # Website: https://github.com/trizen 7 | 8 | # Illustration of the complex square root function 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Imager; 15 | use Math::AnyNum; 16 | 17 | my $img = Imager->new(xsize => 2000, ysize => 1500); 18 | 19 | my $white = Imager::Color->new('#ffffff'); 20 | my $black = Imager::Color->new('#000000'); 21 | 22 | $img->box(filled => 1, color => $black); 23 | 24 | for my $i (1 .. 400) { 25 | for my $j (1 .. 400) { 26 | my $x = Math::AnyNum->new_c($i, $j)->sqrt; 27 | my ($re, $im) = ($x->real->numify, $x->imag->numify); 28 | $img->setpixel(x => 300 + int(60 * $re), y => 400 + int(60 * $im), color => $white); 29 | } 30 | } 31 | 32 | $img->write(file => 'complex_square.png'); 33 | -------------------------------------------------------------------------------- /GD/cuboid_turtle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use GD::Simple; 7 | 8 | my $img = 'GD::Simple'->new(2000, 2000); 9 | $img->moveTo(670, 800); 10 | 11 | my $pi = atan2(1, -'inf'); 12 | my $nr = $pi * 100; 13 | 14 | for (0 .. 280) { 15 | $img->fgcolor('black'); 16 | $img->turn($nr); 17 | $img->line(-$nr); 18 | $img->turn(-134.2); 19 | $img->line(-$nr); 20 | $img->turn($nr); 21 | $img->line(-$nr); 22 | $img->turn(-134.1); 23 | $img->line(-$nr); 24 | $img->turn($nr); 25 | $img->line(-$nr); 26 | $img->turn(-134.2); 27 | $img->line(-$nr); 28 | $img->turn($nr); 29 | $img->line(-$nr); 30 | $img->fgcolor('red'); 31 | $img->turn(134.1); 32 | $img->line(-$nr); 33 | $img->fgcolor('black'); 34 | $img->turn(-134.1); 35 | $img->line($nr); 36 | $img->line(-$nr); 37 | $img->turn(-90); 38 | $img->line($nr); 39 | $img->line(-$nr); 40 | $img->turn(90); 41 | $img->line(-$nr); 42 | } 43 | 44 | my $image_name = 'cuboid_turtle.png'; 45 | 46 | open my $fh, '>', $image_name or die $!; 47 | print {$fh} $img->png; 48 | close $fh; 49 | -------------------------------------------------------------------------------- /GD/fibonacci_gd.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 18 May 2014 6 | # https://github.com/trizen 7 | 8 | use 5.010; 9 | use strict; 10 | use warnings; 11 | use GD::Simple; 12 | 13 | my $img = 'GD::Simple'->new(1500, 1000); 14 | $img->moveTo(250, 530); 15 | 16 | sub t($) { 17 | $img->turn(shift); 18 | } 19 | 20 | sub l($) { 21 | $img->line(shift); 22 | } 23 | 24 | sub c($) { 25 | $img->fgcolor(shift); 26 | } 27 | 28 | sub fib { 29 | my ($n) = @_; 30 | my $res = $n < 2 ? $n : fib($n - 2) + fib($n - 1); 31 | l($res * 4); 32 | t(90); 33 | $res; 34 | } 35 | 36 | fib(14); 37 | 38 | my $image_name = 'fibonacci_turtle.png'; 39 | 40 | open my $fh, '>', $image_name or die $!; 41 | print {$fh} $img->png; 42 | close $fh; 43 | -------------------------------------------------------------------------------- /GD/fibonacci_spirals.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 18 July 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate a Fibonacci cluster of spirals. 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | 17 | my $img = 'GD::Simple'->new(8000, 8000); 18 | $img->moveTo(3500, 3500); 19 | 20 | sub t($) { 21 | $img->turn(shift); 22 | } 23 | 24 | sub l($) { 25 | $img->line(shift); 26 | } 27 | 28 | sub c($) { 29 | $img->fgcolor(shift); 30 | } 31 | 32 | sub fibonacci(&$) { 33 | my ($callback, $n) = @_; 34 | my @fib = (1, 1); 35 | for (1 .. $n - 2) { 36 | $callback->($fib[0]); 37 | @fib = ($fib[-1], $fib[-1] + $fib[-2]); 38 | } 39 | $callback->($_) for @fib; 40 | } 41 | 42 | c 'red'; 43 | for my $i (1 .. 180) { 44 | fibonacci { 45 | l $_[0]**(1 / 11); 46 | t $i; 47 | } 48 | $i; 49 | t 0; 50 | } 51 | 52 | my $image_name = 'fibonacci_spirals.png'; 53 | 54 | open my $fh, '>:raw', $image_name or die $!; 55 | print {$fh} $img->png; 56 | close $fh; 57 | -------------------------------------------------------------------------------- /GD/generator_turtle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use GD::Simple; 4 | 5 | $img = 'GD::Simple'->new(1000, 1000); 6 | $img->moveTo(445, 275); 7 | 8 | my $nr = 124; 9 | 10 | sub t { $img->turn($_[0]) } 11 | sub l { $img->line($_[0]) } 12 | 13 | for (0 .. 125) { 14 | l $nr; 15 | t 90; 16 | l -$nr; 17 | l $nr; 18 | t -90; 19 | l $nr; 20 | l $nr/ 2; 21 | t 90; 22 | l $nr/ 2; 23 | t 90; 24 | l $nr; 25 | t -90; 26 | l $nr* 2; 27 | t -90; 28 | l $nr* 2; 29 | t -90; 30 | l $nr* 2; 31 | t -90; 32 | l $nr; 33 | t -180; 34 | l $nr; 35 | t 45; 36 | l $nr; 37 | t -180; 38 | l $nr; 39 | t -45; 40 | l $nr* 2; 41 | t -45; 42 | l $nr; 43 | t 90; 44 | l -$nr; 45 | t -45; 46 | l -$nr * 2; 47 | t -45; 48 | l -$nr; 49 | 50 | #last; 51 | } 52 | 53 | my $image_name = 'turtle_generator.png'; 54 | 55 | open my $fh, '>', $image_name or die $!; 56 | print {$fh} $img->png; 57 | close $fh; 58 | -------------------------------------------------------------------------------- /GD/horsie_art.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 08 June 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate a "horsie" image based on simple mathematics. 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | 17 | my $max = 3_500_000; 18 | my $limit = int(sqrt($max)); 19 | 20 | # create a new image 21 | my $img = GD::Simple->new($limit * 6, $limit * 6); 22 | 23 | # move to right 24 | $img->moveTo($limit * 4, $limit * 4); 25 | 26 | my $j = 1; 27 | foreach my $i (1 .. $limit) { 28 | 29 | my $t = $i; 30 | for my $n ($j .. $i**2) { 31 | $img->line(1); 32 | $img->turn($t); 33 | $t += $i; 34 | ++$j; 35 | } 36 | 37 | ++$i; 38 | } 39 | 40 | open my $fh, '>:raw', "horsie_art.png"; 41 | print $fh $img->png; 42 | close $fh; 43 | -------------------------------------------------------------------------------- /GD/julia_set_rperl.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 27 March 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Generate a Julia set, using Will Braswell's "MathPerl::Fractal::Julia" RPerl module. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Imager; 15 | use MathPerl::Fractal::Julia; 16 | 17 | my ($w, $h) = (800, 600); 18 | my $maxIter = 250; 19 | 20 | my $cx = -0.7; 21 | my $cy = 0.27015; 22 | 23 | my $matrix = MathPerl::Fractal::Julia::julia_escape_time( 24 | $cx, $cy, $w, $h, $maxIter, -2.5, 1.0, -1.0, 1.0, 0, 25 | ); 26 | 27 | my $img = Imager->new(xsize => $w, ysize => $h, channels => 3); 28 | my $color = Imager::Color->new('#000000'); 29 | 30 | my $y = 0; 31 | foreach my $row (@{$matrix}) { 32 | my $x = 0; 33 | foreach my $pixel (@{$row}) { 34 | my $i = $maxIter - $pixel / 255 * $maxIter; 35 | $color->set(hsv => [$i / $maxIter * 360, 1, $i]); 36 | $img->setpixel(x => $x, y => $y, color => $color); 37 | ++$x; 38 | } 39 | ++$y; 40 | } 41 | 42 | $img->write(file => "julia_set.png"); 43 | -------------------------------------------------------------------------------- /GD/koch_snowflakes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Draw Koch snowflakes as concentric rings, using Math::PlanePath. 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Koch_snowflake 7 | # https://metacpan.org/pod/Math::PlanePath::KochSnowflakes 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use Math::PlanePath::KochSnowflakes; 14 | my $path = Math::PlanePath::KochSnowflakes->new; 15 | 16 | use Imager; 17 | 18 | my $img = Imager->new(xsize => 1000, ysize => 1000); 19 | my $red = Imager::Color->new('#ff0000'); 20 | 21 | foreach my $n (1 .. 100000) { 22 | my ($x, $y) = $path->n_to_xy($n); 23 | $img->setpixel(x => 500 + $x, y => 500 + $y, color => $red); 24 | } 25 | 26 | $img->write(file => 'Koch_snowflakes.png'); 27 | -------------------------------------------------------------------------------- /GD/mathematical_butt.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 29 April 2014 5 | # https://github.com/trizen 6 | 7 | # A funny fanny shape. :-) 8 | 9 | use strict; 10 | use warnings; 11 | use GD::Simple; 12 | 13 | my $img = 'GD::Simple'->new(1000, 1000); 14 | $img->moveTo(500, 500); 15 | 16 | sub t($) { 17 | $img->turn(shift); 18 | } 19 | 20 | sub l($) { 21 | $img->line(shift); 22 | } 23 | 24 | sub c($) { 25 | $img->fgcolor(shift); 26 | } 27 | 28 | for my $i (1 .. 180) { 29 | c 'red'; 30 | for (1 .. 360) { 31 | l 4; # size 32 | t 1; 33 | } 34 | t 0; 35 | } 36 | 37 | my $image_name = 'mathematical_butt.png'; 38 | 39 | open my $fh, '>:raw', $image_name or die $!; 40 | print {$fh} $img->png; 41 | close $fh; 42 | -------------------------------------------------------------------------------- /GD/mirror_shells.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 30 April 2014 6 | # Website: https://github.com/trizen 7 | 8 | use 5.010; 9 | use strict; 10 | use warnings; 11 | use GD::Simple; 12 | 13 | my $img = 'GD::Simple'->new(1000, 600); 14 | $img->moveTo(220, 240); # hopefully, at the center of the image 15 | 16 | sub t($) { 17 | $img->turn(shift); 18 | } 19 | 20 | sub l($) { 21 | $img->line(shift); 22 | } 23 | 24 | sub c($) { 25 | $img->fgcolor(shift); 26 | } 27 | 28 | my $loop = 50; 29 | t 260; 30 | 31 | # From inside-out 32 | for my $j (1 .. $loop) { 33 | l $j; 34 | t $loop- $j + 1; 35 | } 36 | 37 | t 180; 38 | 39 | # From outside-in 40 | for my $j (1 .. $loop) { 41 | l $loop- $j + 1; 42 | t $j; 43 | } 44 | 45 | my $image_name = "mirror_shells.png"; 46 | 47 | open my $fh, '>', $image_name or die $!; 48 | print {$fh} $img->png; 49 | close $fh; 50 | -------------------------------------------------------------------------------- /GD/moebius_walking_line.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 13 November 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Draw a line using the values of the Möbius function: μ(n) 9 | 10 | # The rules are the following: 11 | # when μ(n) = -1, the angle is changed to -45 degrees 12 | # when μ(n) = +1, the angle is changed to +45 degrees 13 | # when μ(n) = 0, the angle is changed to 0 degrees 14 | 15 | # In all three cases, a pixel is recorded for each value of μ(n). 16 | 17 | use 5.010; 18 | use strict; 19 | use warnings; 20 | 21 | use GD::Simple; 22 | use ntheory qw(moebius); 23 | 24 | my $width = 1000; 25 | my $height = 100; 26 | 27 | my $img = GD::Simple->new($width, $height); 28 | 29 | $img->moveTo(0, $height / 2); 30 | 31 | foreach my $u (moebius(1, $width)) { 32 | if ($u == 1) { 33 | $img->angle(45); 34 | } 35 | elsif ($u == -1) { 36 | $img->angle(-45); 37 | } 38 | else { 39 | $img->angle(0); 40 | } 41 | $img->line(1); 42 | } 43 | 44 | open my $fh, '>:raw', 'moebius_walking_like.png'; 45 | print $fh $img->png; 46 | close $fh; 47 | -------------------------------------------------------------------------------- /GD/pattern_triangle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 26 May 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate a pattern triangle based on square numbers (scaled down by a trivial constant) 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | 17 | sub generate { 18 | my ($n, $data) = @_; 19 | 20 | foreach my $i (0 .. $n) { 21 | $data->{sprintf('%.0f', ($i**2) / 12000)} = 1; 22 | } 23 | 24 | return $n; 25 | } 26 | 27 | say "** Generating..."; 28 | 29 | my %data; 30 | my $max = generate(500000, \%data); 31 | my $limit = int(sqrt($max)) - 1; 32 | 33 | # create a new image 34 | my $img = GD::Simple->new($limit * 2, $limit + 1); 35 | 36 | my $i = 1; 37 | my $j = 1; 38 | 39 | for my $m (reverse(0 .. $limit)) { 40 | $img->moveTo($m, $i - 1); 41 | 42 | for my $n ($j .. $i**2) { 43 | $img->fgcolor(exists($data{$j}) ? 'red' : 'black'); 44 | $img->line(1); 45 | ++$j; 46 | } 47 | ++$i; 48 | } 49 | 50 | open my $fh, '>:raw', "pattern_triangle.png"; 51 | print $fh $img->png; 52 | close $fh; 53 | -------------------------------------------------------------------------------- /GD/peacock_triangles.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 26 August 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate an interesting image containing some triangles with "peacock tails" 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | 17 | my $max = 1200000; # duration: about 6 seconds 18 | my $limit = int(sqrt($max)) - 1; 19 | 20 | my $img = GD::Simple->new($limit * 12, $limit * 4); 21 | 22 | my $i = 1; 23 | my $j = 1; 24 | 25 | $img->turn(0.001); 26 | 27 | say "** Generating..."; 28 | for my $m (reverse(0 .. $limit)) { 29 | $img->moveTo($m * 12, 2 * ($i - 1)); 30 | 31 | for my $n ($j .. $i**2) { 32 | $img->line(1); 33 | ++$j; 34 | } 35 | ++$i; 36 | } 37 | 38 | open my $fh, '>:raw', "peacock_triangles.png"; 39 | print $fh $img->png; 40 | close $fh; 41 | -------------------------------------------------------------------------------- /GD/pi_abstract_art.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # Date: 02 February 2022 5 | # https://github.com/trizen 6 | 7 | # Generate a random art, using the digits of Pi in a given base. 8 | 9 | # See also: 10 | # https://yewtu.be/watch?v=tkC1HHuuk7c 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | use GD::Simple; 17 | use ntheory qw(Pi todigits); 18 | 19 | my $width = 4000; 20 | my $height = 5000; 21 | 22 | # create a new image 23 | my $img = GD::Simple->new($width, $height); 24 | 25 | # move to the center 26 | $img->moveTo($width >> 1, $height >> 1); 27 | 28 | my $digits = 100000; # how many of digits of pi to use 29 | my $base = 4; # base 30 | my $line_size = 7; # size of the line 31 | 32 | my $pi = join '', Pi($digits); 33 | $pi =~ s/\.//; 34 | 35 | my @digits = todigits($pi, $base); 36 | my $theta = 360 / $base; 37 | 38 | for my $d (@digits) { 39 | $img->turn($theta * $d); 40 | $img->line($line_size); 41 | } 42 | 43 | open my $fh, '>:raw', "pi_abstract_art.png"; 44 | print $fh $img->png; 45 | close $fh; 46 | -------------------------------------------------------------------------------- /GD/prime_rectangles.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 23 May 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Draw overlapping prime rectangles. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use GD::Simple; 15 | use ntheory qw(forprimes prev_prime); 16 | 17 | my $P = prev_prime(1000) + 1; 18 | my $img = GD::Simple->new($P, $P); 19 | 20 | $img->bgcolor(undef); 21 | $img->fgcolor('red'); 22 | 23 | forprimes { 24 | my $p = $_; 25 | forprimes { 26 | $img->rectangle(1, 1, $_, $p); 27 | } 0, $P; 28 | } 0, $P; 29 | 30 | open my $fh, '>:raw', 'prime_rectangles.png'; 31 | print {$fh} $img->png; 32 | close $fh; 33 | -------------------------------------------------------------------------------- /GD/prime_triangle_90deg.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 14 September 2016 5 | # License: GPLv3 6 | # https://github.com/trizen 7 | 8 | use strict; 9 | use warnings; 10 | 11 | use Imager; 12 | 13 | use POSIX qw(ceil); 14 | use ntheory qw(is_prime); 15 | 16 | my $limit = 1000; 17 | my $red = Imager::Color->new('#ff0000'); 18 | 19 | my $img = Imager->new(xsize => 2 * $limit, 20 | ysize => $limit,); 21 | 22 | sub get_point { 23 | my ($n) = @_; 24 | 25 | my $row = ceil(sqrt($n)); 26 | my $cell = 2 * $row - 1 - $row**2 + $n; 27 | 28 | ($cell, $row); 29 | } 30 | 31 | foreach my $n (1 .. $limit**2) { 32 | if (is_prime($n)) { 33 | my ($x, $y) = get_point($n); 34 | $img->setpixel(x => $x, y => $y, color => $red); 35 | } 36 | } 37 | 38 | $img->write(file => 'prime_triangle_90deg.png'); 39 | -------------------------------------------------------------------------------- /GD/random_abstract_art.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 08 June 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate complex random art based on simple mathematics. 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | use List::Util qw(shuffle); 17 | 18 | my $max = 1_000_000; 19 | my $limit = int(sqrt($max)); 20 | 21 | say "Possible combinations: $limit!"; 22 | 23 | # create a new image 24 | my $img = GD::Simple->new($limit * 3, $limit * 3); 25 | 26 | # move to the center 27 | $img->moveTo($limit * 1.5, $limit * 1.5); 28 | 29 | my $i = 1; 30 | my $j = 1; 31 | 32 | for my $m (shuffle(1 .. $limit)) { 33 | 34 | for my $n ($j .. $i**2) { 35 | $img->line(1); 36 | $img->turn($n**2 / $m); 37 | ++$j; 38 | } 39 | 40 | ++$i; 41 | } 42 | 43 | open my $fh, '>:raw', "random_abstract_art.png"; 44 | print $fh $img->png; 45 | close $fh; 46 | -------------------------------------------------------------------------------- /GD/random_abstract_art_2.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 08 June 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate complex random art based on simple mathematics. 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | 17 | my $max = 1_000_000; 18 | my $limit = int(sqrt($max)); 19 | 20 | # create a new image 21 | my $img = GD::Simple->new($limit * 3, $limit * 3); 22 | 23 | # move to the center 24 | $img->moveTo($limit * 1.5, $limit * 1.5); 25 | 26 | my $i = 1; 27 | my $j = 1; 28 | 29 | for my $m (map { rand($limit) - rand($limit) } (1 .. $limit)) { 30 | 31 | for my $n ($j .. $i**2) { 32 | $img->line(1); 33 | $img->turn($n**2 / $m); 34 | ++$j; 35 | } 36 | 37 | ++$i; 38 | } 39 | 40 | open my $fh, '>:raw', "random_abstract_art_2.png"; 41 | print $fh $img->png; 42 | close $fh; 43 | -------------------------------------------------------------------------------- /GD/random_machinery_art.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 21 July 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate a complex machine-like art based on simple mathematics. 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | use List::Util qw(shuffle); 17 | 18 | my $max = 1_000_000; 19 | my $limit = int(sqrt($max)); 20 | 21 | say "Possible combinations: $limit!"; 22 | 23 | # create a new image 24 | my $img = GD::Simple->new($limit * 3, $limit * 3); 25 | 26 | # move to the center 27 | $img->moveTo($limit * 1.5, $limit * 1.5); 28 | 29 | my $i = 1; 30 | my $j = 1; 31 | 32 | for my $m (shuffle(1 .. $limit)) { 33 | 34 | for my $n ($j .. $i**2) { 35 | $img->line(1); 36 | $img->turn($n * $i + $m); 37 | ++$j; 38 | } 39 | 40 | ++$i; 41 | } 42 | 43 | open my $fh, '>:raw', "random_machinery.png"; 44 | print $fh $img->png; 45 | close $fh; 46 | -------------------------------------------------------------------------------- /GD/random_noise_triangle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 26 May 2015 6 | # https://github.com/trizen 7 | 8 | # 9 | ## Generate a random pattern triangle 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | use GD::Simple; 16 | 17 | sub generate { 18 | my ($n, $data) = @_; 19 | 20 | foreach my $i (1 .. $n) { 21 | if (rand(1) < 0.5) { 22 | $data->{$i} = 1; 23 | } 24 | } 25 | 26 | return $n; 27 | } 28 | 29 | say "** Generating..."; 30 | 31 | my %data; 32 | my $max = generate(300000, \%data); 33 | my $limit = int(sqrt($max)) - 1; 34 | 35 | # create a new image 36 | my $img = GD::Simple->new($limit * 2, $limit + 1); 37 | 38 | my $i = 1; 39 | my $j = 1; 40 | 41 | for my $m (reverse(0 .. $limit)) { 42 | $img->moveTo($m, $i - 1); 43 | 44 | for my $n ($j .. $i**2) { 45 | $img->fgcolor(exists($data{$j}) ? 'red' : 'black'); 46 | $img->line(1); 47 | ++$j; 48 | } 49 | ++$i; 50 | } 51 | 52 | open my $fh, '>:raw', "random_noise_triangle.png"; 53 | print $fh $img->png; 54 | close $fh; 55 | -------------------------------------------------------------------------------- /GD/real_shell.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 30 April 2014 6 | # Website: https://github.com/trizen 7 | 8 | use 5.010; 9 | use strict; 10 | use warnings; 11 | use GD::Simple; 12 | 13 | my $img = 'GD::Simple'->new(500, 600); 14 | 15 | sub t($) { 16 | $img->turn(shift); 17 | } 18 | 19 | sub l($) { 20 | $img->line(shift); 21 | } 22 | 23 | sub c($) { 24 | $img->fgcolor(shift); 25 | } 26 | 27 | $img->clear; 28 | $img->moveTo(250, 300); # hopefully, at the center of the image 29 | 30 | my $loop = 5; 31 | for (my $j = 0.01 ; $j <= $loop ; $j += 0.01) { 32 | l $j; 33 | t $loop- $j + 1; 34 | } 35 | 36 | my $image_name = "shell.png"; 37 | 38 | open my $fh, '>', $image_name or die $!; 39 | print {$fh} $img->png; 40 | close $fh; 41 | -------------------------------------------------------------------------------- /GD/spinning_shapes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 30 April 2014 6 | # Website: https://github.com/trizen 7 | 8 | use 5.010; 9 | use strict; 10 | use warnings; 11 | use GD::Simple; 12 | 13 | my $img = 'GD::Simple'->new(2000, 2000); 14 | $img->fgcolor('blue'); 15 | 16 | sub t($) { 17 | $img->turn(shift); 18 | } 19 | 20 | sub l($) { 21 | $img->line(shift); 22 | } 23 | 24 | sub c($) { 25 | $img->fgcolor(shift); 26 | } 27 | 28 | my $dir = 'Spinning Shapes'; 29 | 30 | if (not -d $dir) { 31 | mkdir($dir) || die "Can't mkdir `$dir': $!"; 32 | } 33 | 34 | chdir($dir) || die "Can't chdir `$dir': $!"; 35 | 36 | for (my $i = 1 ; $i <= 180 ; $i += 1) { 37 | 38 | say "$i degrees"; 39 | 40 | $img->clear; 41 | $img->moveTo(1000, 1000); # hopefully, at the center of the image 42 | 43 | for my $j (1 .. 360) { 44 | l($j * 2); 45 | t $i; 46 | } 47 | 48 | my $image_name = sprintf("%03d.png", $i); 49 | 50 | open my $fh, '>:raw', $image_name or die $!; 51 | print {$fh} $img->png; 52 | close $fh; 53 | } 54 | -------------------------------------------------------------------------------- /GD/spiral_tree.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 13 August 2015 6 | # https://github.com/trizen 7 | 8 | # Generate a spiral tree with branches 9 | # Inspired from: https://www.youtube.com/watch?v=RWAcbV4X7C8 10 | 11 | use GD::Simple; 12 | my $img = GD::Simple->new(1000, 700); 13 | 14 | $img->moveTo(500, 650); 15 | $img->turn(-90); 16 | 17 | sub branch { 18 | my ($len) = @_; 19 | 20 | $img->line($len); 21 | $len *= 0.64; 22 | 23 | if ($len > 2) { 24 | 25 | my @pos1 = $img->curPos; 26 | my $angle1 = $img->angle; 27 | 28 | $img->turn(45); 29 | branch($len); 30 | $img->moveTo(@pos1); 31 | $img->angle($angle1); 32 | 33 | my @pos2 = $img->curPos; 34 | my $angle2 = $img->angle; 35 | 36 | $img->turn(-90); 37 | branch($len); 38 | $img->moveTo(@pos2); 39 | $img->angle($angle2); 40 | } 41 | } 42 | 43 | branch(250); 44 | 45 | open my $fh, '>:raw', 'spiral_tree.png'; 46 | print $fh $img->png; 47 | close $fh; 48 | -------------------------------------------------------------------------------- /GD/trizen_flat_logo.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use GD::Simple; 7 | 8 | my $img = 'GD::Simple'->new(2300, 2300); 9 | $img->moveTo(465, 1305); 10 | 11 | my $nr = 308.5; 12 | 13 | for (0 .. 222) { 14 | $img->fgcolor(qw(blue green) [$_ % 2]); 15 | $img->turn(45); 16 | $img->line(-$nr - $_); 17 | $img->line(-$nr); 18 | $img->line(-$nr); 19 | $img->line(-$nr); 20 | $img->fgcolor(qw(green blue) [$_ % 2]); 21 | $img->turn(-45); 22 | $img->line($nr); 23 | $img->line($nr); 24 | $img->line($nr); 25 | $img->line($nr); 26 | $img->fgcolor('black'); 27 | $img->turn(45); 28 | $img->line($nr + $_); 29 | $img->fgcolor('purple'); 30 | $img->turn(-45); 31 | $img->line(-$nr); 32 | $img->line(-$nr); 33 | } 34 | 35 | my $image_name = 'trizen_flat_logo.png'; 36 | 37 | open my $fh, '>:raw', $image_name or die $!; 38 | print {$fh} $img->png; 39 | close $fh; 40 | -------------------------------------------------------------------------------- /GD/trizen_new_logo.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use GD::Simple; 7 | 8 | my $img = 'GD::Simple'->new(2000, 2000); 9 | $img->moveTo(510, 1100); 10 | 11 | my $nr = 308.5; 12 | 13 | for (0 .. 280) { 14 | 15 | $img->fgcolor('green'); 16 | $img->turn($nr); 17 | 18 | for (1 .. 4) { 19 | $img->line(-$nr); 20 | } 21 | 22 | $img->fgcolor('gray'); 23 | $img->turn(-$nr); 24 | 25 | for (1 .. 4) { 26 | $img->line($nr); 27 | } 28 | 29 | $img->fgcolor('blue'); 30 | $img->line($nr); 31 | 32 | $img->fgcolor('purple'); 33 | $img->turn($nr); 34 | $img->line(-$nr); 35 | 36 | $img->fgcolor('red'); 37 | $img->line(-$nr); 38 | } 39 | 40 | my $image_name = 'trizen_new_logo.png'; 41 | 42 | open my $fh, '>:raw', $image_name or die $!; 43 | print {$fh} $img->png; 44 | close $fh; 45 | -------------------------------------------------------------------------------- /GD/trizen_old_logo.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use GD::Simple; 7 | 8 | my $img = 'GD::Simple'->new(1000, 1000); 9 | $img->moveTo(285, 80); 10 | 11 | my $nr = 257; 12 | 13 | for (0 .. 100) { 14 | $img->fgcolor('green'); 15 | $img->turn($nr); 16 | $img->line(-$nr); 17 | $img->line(-$nr); 18 | $img->line(-$nr); 19 | $img->line(-$nr); 20 | $img->fgcolor('gray'); 21 | $img->turn(-$nr); 22 | $img->line($nr); 23 | $img->line($nr); 24 | $img->line($nr); 25 | $img->line($nr); 26 | $img->fgcolor('blue'); 27 | $img->turn(-$nr); 28 | $img->line($nr); 29 | $img->fgcolor('purple'); 30 | $img->turn($nr); 31 | $img->line(-$nr); 32 | $img->fgcolor('red'); 33 | $img->turn($nr); 34 | $img->line(-$nr); 35 | } 36 | 37 | my $image_name = 'trizen_old_logo.png'; 38 | 39 | open my $fh, '>', $image_name or die $!; 40 | print {$fh} $img->png; 41 | close $fh; 42 | -------------------------------------------------------------------------------- /GD/zeta_real_half_terms.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 08 August 2017 5 | # https://github.com/trizen 6 | 7 | # Plotting of the terms in the series: 8 | # 9 | # zeta(1/2 + s*i) = Sum_{n>=1} 1/(n^(1/2 + s*i)) 10 | # 11 | 12 | # where we have the identity: 13 | # 1/(n^(1/2 + s*i)) = (cos(log(n) * s) - i*sin(log(n) * s)) / sqrt(n) 14 | 15 | use 5.010; 16 | use strict; 17 | use warnings; 18 | 19 | use Imager; 20 | 21 | my $red = Imager::Color->new('#ff0000'); 22 | 23 | my $size = 1000; 24 | my $img = Imager->new(xsize => $size, 25 | ysize => $size); 26 | 27 | my $s = 14.134725142; 28 | 29 | foreach my $n (1 .. 3000) { 30 | 31 | my ($x, $y) = ( 32 | cos(log($n) * $s) / sqrt($n), 33 | -sin(log($n) * $s) / sqrt($n), 34 | ); 35 | 36 | $img->setpixel( 37 | x => ($size / 2 + $size / 2 * $x), 38 | y => ($size / 2 + $size / 2 * $y), 39 | color => $red, 40 | ); 41 | } 42 | 43 | $img->write(file => 'zeta_real_half.png'); 44 | -------------------------------------------------------------------------------- /GTK+/mouse_position.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 14 November 2017 5 | # https://github.com/trizen 6 | 7 | # Get the current location of the mouse cursor. 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use Gtk2 ('-init'); 14 | 15 | my (undef, $x, $y) = 'Gtk2::Window'->new->get_screen->get_display->get_pointer; 16 | 17 | say "x=$x y=$y"; 18 | -------------------------------------------------------------------------------- /Game solvers/reaction_time_test.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 16 August 2019 5 | # https://github.com/trizen 6 | 7 | # A simple program to cheat in the "Reaction time test". 8 | # https://www.humanbenchmark.com/tests/reactiontime 9 | 10 | use 5.014; 11 | use strict; 12 | use warnings; 13 | 14 | use GD; 15 | use Time::HiRes qw(sleep); 16 | 17 | say "Starting..."; 18 | sleep 5; 19 | system("xdotool", "click", "1"); # click to start 20 | 21 | my $count = 0; 22 | 23 | while (1) { 24 | 25 | my $gd = GD::Image->new(scalar `maim --geometry '20x20+1+300' --format=jpg /dev/stdout`); 26 | 27 | my $pixel = $gd->getPixel(0, 0); # test first pixel 28 | my ($r, $g, $b) = $gd->rgb($pixel); 29 | 30 | if ($g > 100) { # test for greenness 31 | say "Detected green..."; 32 | 33 | system("xdotool", "click", "1"); # green detected 34 | last if ++$count == 5; 35 | 36 | sleep(2); 37 | system("xdotool", "click", "1"); # click to continue 38 | sleep 2; 39 | } 40 | 41 | sleep 0.0001; 42 | } 43 | -------------------------------------------------------------------------------- /Greppers/unigrep.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 18 December 2020 5 | # https://github.com/trizen 6 | 7 | # A unidecode grep-like program. 8 | 9 | # In addition to normal grepping, it also converts input to ASCII and checks the given regex. 10 | 11 | # usage: 12 | # perl unigrep.pl [regex] [input] 13 | # find . | perl unigrep.pl [regex] 14 | 15 | use 5.010; 16 | use strict; 17 | use warnings; 18 | 19 | use Encode qw(decode_utf8); 20 | use Text::Unidecode qw(unidecode); 21 | use Getopt::Std qw(getopts); 22 | 23 | my %opt; 24 | getopts('i', \%opt); 25 | 26 | my $param = shift(@ARGV) // ''; 27 | my $regex = ($opt{i} ? qr/$param/oi : qr/$param/o); 28 | 29 | my $uniregex = do { 30 | my $t = decode_utf8($param); 31 | $opt{i} ? qr/$t/io : qr/$t/o; 32 | }; 33 | 34 | while (<>) { 35 | 36 | my $orig = $_; 37 | my $line = decode_utf8($_); 38 | my $unidec = unidecode($line); 39 | 40 | if ( $orig =~ $regex 41 | or $line =~ $uniregex 42 | or $unidec =~ $regex 43 | or $unidec =~ $uniregex) { 44 | print $orig; 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /HAL/HAL8212/HAL8212.memory: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # This file is part of the HAL8212 program. 4 | # Don't edit this file, unless you know what are you doing! 5 | 6 | # Updated on: Thu Apr 17 18:44:39 2014 7 | # by: HAL8212.pl 8 | 9 | scalar {} 10 | -------------------------------------------------------------------------------- /HAL/HAL9000/HAL9000.memory: -------------------------------------------------------------------------------- 1 | ../HAL3736/HAL3736.memory -------------------------------------------------------------------------------- /Image/extract_jpegs.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Unpack two or more concatenated JPEG files. 4 | 5 | # See also: 6 | # https://stackoverflow.com/questions/4585527/detect-end-of-file-for-jpg-images 7 | 8 | use 5.014; 9 | use strict; 10 | use warnings; 11 | 12 | use Digest::MD5 qw(md5_hex); 13 | 14 | binmode(STDIN, ':raw'); 15 | binmode(STDOUT, ':raw'); 16 | 17 | my $data = do { 18 | local $/; 19 | <>; 20 | }; 21 | 22 | #my @files = split(/\x{FF}\x{D8}/, $data); 23 | #my @files = split(/^\xFF\xD8/m, $data); 24 | 25 | my $count = 1; 26 | 27 | #$data = reverse($data); 28 | 29 | #foreach my $data (@files) { 30 | while ($data =~ /(\xFF\xD8.*?\xFF\xD9)/gs) { 31 | my $jpeg = $1; 32 | my $name = sprintf("file_%d %s.jpg", $count++, md5_hex($jpeg)); 33 | open my $fh, '>:raw', $name 34 | or die "Can't open <<$name>>: $!"; 35 | print $fh $jpeg; 36 | close $fh; 37 | } 38 | -------------------------------------------------------------------------------- /Image/image2matrix.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 13 August 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Transform an image into a matrix of RGB values. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Imager; 15 | 16 | my $file = shift(@ARGV) // die "usage: $0 [image]"; 17 | my $img = Imager->new(file => $file); 18 | 19 | foreach my $y (0 .. $img->getheight - 1) { 20 | say join( 21 | ',', 22 | map { 23 | my $color = $img->getpixel(y => $y, x => $_); 24 | my ($r, $g, $b) = $color->rgba; 25 | 26 | my $rgb = $r; 27 | $rgb = ($rgb << 8) + $g; 28 | $rgb = ($rgb << 8) + $b; 29 | 30 | $rgb 31 | } (0 .. $img->getwidth - 1) 32 | ); 33 | } 34 | -------------------------------------------------------------------------------- /Image/img_rewrite.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 30 January 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Rewrite a set of images specified as arguments. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Image::Magick; 15 | 16 | foreach my $file (@ARGV) { 17 | say "** Processing file `$file'..."; 18 | my $img = Image::Magick->new; 19 | $img->Read($file) && do { 20 | warn "[!] Can't load image `$file' ($!). Skipping file...\n"; 21 | next; 22 | }; 23 | unlink($file); 24 | $img->Write($file); 25 | } 26 | -------------------------------------------------------------------------------- /Image/rgb_dump.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Dump the first n pixels from a given image. 4 | 5 | use 5.020; 6 | use warnings; 7 | 8 | use Imager; 9 | use experimental qw(signatures); 10 | 11 | @ARGV || do { 12 | say STDERR "usage: $0 [input.png] [n]"; 13 | exit(2); 14 | }; 15 | 16 | my $in_file = $ARGV[0]; 17 | my $n = $ARGV[1] // 10; 18 | 19 | my $img = 'Imager'->new(file => $in_file) 20 | or die "Can't read image: $in_file"; 21 | 22 | my $width = $img->getwidth; 23 | my $height = $img->getheight; 24 | 25 | OUTER: foreach my $y (0 .. $height - 1) { 26 | foreach my $x (0 .. $width - 1) { 27 | --$n >= 0 or last OUTER; 28 | my $color = $img->getpixel(x => $x, y => $y); 29 | my ($r, $g, $b) = $color->rgba; 30 | printf("%08b,%08b,%08b | %2x,%2x,%2x | %3d,%3d,%3d\n", ($r, $g, $b) x 3); 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /JAPH/alpha_japh_2.pl: -------------------------------------------------------------------------------- 1 | print chr length o x ord qw o J o and 2 | print chr length o x ord qw x u x and 3 | print chr length o x ord qw o s o and 4 | print chr length o x ord qw x t x and 5 | print chr length o x ord qq o o and 6 | print chr length o x ord qw x a x and 7 | print chr length o x ord qw o n o and 8 | print chr length o x ord qw x o x and 9 | print chr length o x ord qw o t o and 10 | print chr length o x ord qw x h x and 11 | print chr length o x ord qw o e o and 12 | print chr length o x ord qw x r x and 13 | print chr length o x ord qq o o and 14 | print chr length o x ord qw x P x and 15 | print chr length o x ord qw o e o and 16 | print chr length o x ord qw x r x and 17 | print chr length o x ord qw o l o and 18 | print chr length o x ord qq x x and 19 | print chr length o x ord qw o h o and 20 | print chr length o x ord qw x a x and 21 | print chr length o x ord qw o c o and 22 | print chr length o x ord qw x k x and 23 | print chr length o x ord qw o e o and 24 | print chr length o x ord qw x r x and 25 | print chr length time and do not exit 26 | -------------------------------------------------------------------------------- /JAPH/alpha_japh_3.pl: -------------------------------------------------------------------------------- 1 | qw qxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxqand 2 | s yys xxprint scalar reverse q qrekcah lreP rehtona tsuJqxe and print qq x 3 | xyexxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 4 | -------------------------------------------------------------------------------- /JAPH/arrow_japh.pl: -------------------------------------------------------------------------------- 1 | !_&print q qJq or 2 | !__&print q quq or 3 | !___&print q qsq or 4 | !____&print q qtq or 5 | !_____&print q q q or 6 | !______&print q qaq or 7 | !_______&print q qnq or 8 | !________&print q qoq or 9 | !_________&print q qtq or 10 | !__________&print q qhq or 11 | !___________&print q qeq or 12 | !____________&print q qrq or 13 | !____________&print q q q or 14 | !____________&print q qPq or 15 | !___________&print q qeq or 16 | !__________&print q qrq or 17 | !_________&print q qlq or 18 | !________&print q q q or 19 | !_______&print q qhq or 20 | !______&print q qaq or 21 | !_____&print q qcq or 22 | !____&print q qkq or 23 | !___&print q qeq or 24 | !__&print q qrq or 25 | !_&print q q,q,$/ 26 | -------------------------------------------------------------------------------- /JAPH/barewords_japh.pl: -------------------------------------------------------------------------------- 1 | Just another Perl hacker 2 | 3 | local+$,=$";package another;sub Just{print(substr((caller(0))[3],3**2),@_)} 4 | package hacker;sub Perl{Just another((split/:./,(caller(0))[3])[1,0]),exit} 5 | -------------------------------------------------------------------------------- /JAPH/cubic_japh.pl: -------------------------------------------------------------------------------- 1 | +($\,$})=($/,q$@$);@@=split$!=>($@ 2 | =$}|'/'=>$:=$@,++$@,$@++,$~=(++$@=> 3 | ++$@),$.=$",$_=$/|$}.(+(++$@=>++$@). 4 | $~).++$~.$..($;=$}|'!').($^='.'|$}).+ 5 | ('/'|$}).$~.($@=$}|'(').($"='%'|$}).(+ 6 | +++$:=>++$:,+++$:).$..($:^'"').$".$:.(q 7 | },}|$}).$..$@.$;.($}.$}|'#+').$".$:.q|,| 8 | );sub f{print@_}sub i(_){my($l,$j)=0;my( 9 | $x,$y,$z,$c,$h,$v,$d,$s,$p,$o)=(+@{+pop} 10 | ,qw w+ -w,qw\| /\,sub{$j=$_[0];$l+$j>+@@ 11 | &&($l=$?);@@[do{$l=$j+$l;$l-$j..$l-1}]}, 12 | $?);f$.x($z+1),$c,$h x$x,$c;f$.x($z-$_+1 13 | ),$d,$s->($x),$d,$s->($_-1-$p),$_>$y?!$p 14 | &&++$p?do{$o=$z-$y;$c}:$p++?$d:$c:$v for 15 | 1..$z;f$c,$h x$x,$c,$p?($s->($z-$o),$d): 16 | ($s->($z),$z<$y?$v:$c);f$v,$s->($x),$v, 17 | ,$z-1>=$y?$_>=$z?($s->($x),$c):($s->($ 18 | z-$_-$o),$d):$y-$_>$z?($s->($z),$v):( 19 | $s->($y-$_),$y-$_==$z?$c:$d)for+1..$ 20 | y;f$c,$h x$x,$c}+i,,for[24,24,24],[ 21 | 1,24,0],[24,1,0],[1,0,24],[24,3,1] 22 | -------------------------------------------------------------------------------- /JAPH/invisible_japh.pl: -------------------------------------------------------------------------------- 1 | open _=>">$0";print _+'print chr length for split"\5"=>qq;';print _+qq 2 | "\0"x+ord($_)=>"\5"for(split//=>join''=>'Vioh<}rshtynutime=>seek=>tell=>$"=>alarm=>next=> 2 | our=>tied=>hex=>each=>recv=>$"=>pipe=>exit=>redo=>lock=>$"=> 3 | hex=>accept=>connect=>keys=>eof=>rewinddir=>chr length time; 4 | -------------------------------------------------------------------------------- /JAPH/japh_from_escapes.pl: -------------------------------------------------------------------------------- 1 | 'J  2 | o  P   '=~($_=qr/^J\u\s\t \a\no\t\h\e\r P\e\r\l \h\a\ck\e\r$/)&& 3 | print s/(?(?{$-[0]==$=\/2})(?{'l'})|(?{$!}))|^\W+(.)(?{$1 4 | .($1^'?')})|[\\^](?=\w)(?{$@})|\W+\z(?{",$\/"})/$^R/girls 5 | -------------------------------------------------------------------------------- /JAPH/japh_from_escapes_2.pl: -------------------------------------------------------------------------------- 1 | print qr/\J\u\s\t \a\n\o\t\h\e\r \P\e\r\l \h\a\c\k\e\r/=~s/\W*(\w\s?)/$1/girls=~s\.$\,$/\r 2 | -------------------------------------------------------------------------------- /JAPH/japh_from_eval_subst.pl: -------------------------------------------------------------------------------- 1 | s/(?{(('[[).\|`][[{[.@\/(^.[{;\,[@:?+^)('^'+)@@(^*((\/[:@\/[@;\{+^.@{([\@;["').'"')})/$^R/ee 2 | -------------------------------------------------------------------------------- /JAPH/japh_from_pod.pl: -------------------------------------------------------------------------------- 1 | sub f{my%D;@D{@_}=();for(@_){if(-d){next if${_}eq'.';my@g;opendir(D,${_})||next; 2 | while(defined(my$d=readdir(D))){unless(${d}eq'.'or${d}eq'..'){push@g,"${_}/$d"}} 3 | closedir(D);push@f,grep({-f}@g);f(grep((!exists($D{$_})),grep({-d}@g)))}elsif(-f 4 | ){push@f,$_}}return@f}my$q=qr/["']\w[^\W\d]{3}\h\w{5}([[:alpha:]])\S\b\N\D\1\w+? 5 | \s\p{PosixAlpha}\B.[\x63-\x72]{4,},?(?:\\n)?["']/six;do{-T||next;open(_,'<',$_); 6 | sysread _,$_,-s;if(/$q/o){$_=eval$&;chomp;local$\=$/;print;exit}}foreach(f@INC); 7 | -------------------------------------------------------------------------------- /JAPH/japh_from_poetry.pl: -------------------------------------------------------------------------------- 1 | $_ = q q 2 | Jungla urbană si tonalitatea 3 | amplifică naivitatea omului terestru, hrănind eficient răutatea... 4 | Preoții explică răscumpărațiilor luciferului 5 | hârtia acoperită cu koranul enunțat răului... 6 | 7 | q;for(split /\s/){ print chr ord, q q q } print chr length time 8 | -------------------------------------------------------------------------------- /JAPH/japh_from_punctuation_chars.pl: -------------------------------------------------------------------------------- 1 | $,='@',$@=$,|'/',$:=$@,++$@,$@++,$~=(++$@,++$@),$.=$",$_=$/|$,.((++$@,++$@).$~) 2 | .++$~.$..($;=$,|'!').($^='.'|$,).('/'|$,).$~.($@=$,|'(').($"='%'|$,).(++$:=>,++ 3 | $:,++$:).$..($:^'"').$".$:.(','|$,).$..$@.$;.($,.$,|'#+').$".$:.','.$/=>=>print 4 | -------------------------------------------------------------------------------- /JAPH/japh_from_subs.pl: -------------------------------------------------------------------------------- 1 | print"@{sub hacker;[grep{sub Just;$::{$_}eq-1}keys%:: 2 | ];sub Perl}[!!_+(++${sub another;_}),$?,//,$#$],$/";; 3 | -------------------------------------------------------------------------------- /JAPH/japh_from_the_deep.pl: -------------------------------------------------------------------------------- 1 | \&~=~'\(';print+s{\x42}{$"}r,for($`..-$`)[4889245,650731,2540044,8375064,1505137],$/; 2 | -------------------------------------------------------------------------------- /JAPH/japh_variable.pl: -------------------------------------------------------------------------------- 1 | BEGIN{$^W=1,$SIG{__WARN__}=sub{pop=~s/:+([^"]+)/die 2 | "$1,$\/"=~tr\_\ \r/error}}$Just_another_Perl_hacker 3 | -------------------------------------------------------------------------------- /JAPH/japh_variables.pl: -------------------------------------------------------------------------------- 1 | for($-..$=+$=){$_=chr;/[a-z]/io||next;$$_ = $_, $$_ = $_} 2 | print "$J$u$s$t $a$n$o$t$h$e$r $P$e$r$l $h$a$c$k$e$r,$/"; 3 | -------------------------------------------------------------------------------- /JAPH/japh_variables_2.pl: -------------------------------------------------------------------------------- 1 | $\=$/;foreach($-..$=+$=){$_=chr,m$[\x61-\x75\x2C]$i||next,$$_ = $_ and $$$_=$$_} 2 | print join $",$J.$u.$s.$t,$a.$n.$o.$t.$h.$e.$r,$P.$e.$r.$l,$h.$a.$c.$k.$e.$r.$,; 3 | -------------------------------------------------------------------------------- /JAPH/leet_japh.pl: -------------------------------------------------------------------------------- 1 | for(chr 97..chr 117){$_[@_]=$_}for$1(split/\D/,){$_.=$_ 2 | [$1]if$_[$1]}s/([^Ja]+)([^p]+)([^h]+)(.+)/\u$1 $2 \u$3 $4,\n/ 3 | ;@_=split//;for(@_){print;print"\0"x6**$]if$^O=~/^l/}__DATA__ 4 | 9+20+18+19+23*0*13+14+19+7+4+17*15*4+17*11+7+0*2*10-4+17=1337 5 | -------------------------------------------------------------------------------- /JAPH/length_obfuscation.pl: -------------------------------------------------------------------------------- 1 | $_=q qrea ncJertsa ,thelhPkour q,my $i=length; 2 | while($i){s/(.{$i})(.)/$2$1/g;--$i}print+$_.$/ 3 | -------------------------------------------------------------------------------- /JAPH/log_japh.pl: -------------------------------------------------------------------------------- 1 | print chr for unpack q((a2)*), substr log(18747683), 3, 8; 2 | -------------------------------------------------------------------------------- /JAPH/log_japh_2.pl: -------------------------------------------------------------------------------- 1 | use bignum;$\=$/;$,=$"; print map { pack "C${\(length>>1)}", unpack 2 | "x3(a2)*", log } 51063670, 20632319030177, 54134528, 1100260138130; 3 | -------------------------------------------------------------------------------- /JAPH/non-alphanumeric_japh.pl: -------------------------------------------------------------------------------- 1 | $,='@',$@=$,|'/',$:=$@=>++$@,$@++,$~=(++$@=>/\/\//=>,++$@)=>$\=("$,$,$,$,"^ 2 | '%#(/'),$_=($/|$,).((++$@,++$@).$~).++$~.$".($;=$,|'!').($^=('.',=>,=>,)|$, 3 | ).('/'|$,).$~.($@=$,|'(').($.='%'|$,).(++$:=>/<=|=>/=>,++$:=>++$:).$".($:^+ 4 | '"').$..$:.(','|$,).$".$@.$;.($,.$,|'#+').$..$:.',',`$\ '$_'>&${\($]>>//)}` 5 | -------------------------------------------------------------------------------- /JAPH/re_eval_japh.pl: -------------------------------------------------------------------------------- 1 | use re 'eval'; 2 | _=~('(?{'.('[[).\|`][[{[.@/(^.[{;\,[@:?+^)(' 3 | ^'+)@@(^*((/[:@/[@;\{+^.@{([\@;["').'"})');; 4 | -------------------------------------------------------------------------------- /JAPH/slash_r_japh.pl: -------------------------------------------------------------------------------- 1 | print$/=~s~~r~r=~s~~e~r=~s~~k~r=~s~~c~r=~s~~a~r=~s~~h~r=~s~~ ~r=~s<> 2 | ~l~r=~s~~r~r=~s~~e~r=~s~~P~r=~s~~ ~r=~s~~r~r=~s~~e~r=~s~~h~r=~s~~t~r 3 | =~s~~o~r=~s~~n~r=~s~~a~r=~s~~ ~r=~s~~t~r=~s~~s~r=~s~~u~r=~s~~J~r//// 4 | -------------------------------------------------------------------------------- /JAPH/up_and_down.pl: -------------------------------------------------------------------------------- 1 | eval { hacker 2 | Perl 3 | another 4 | Just 5 | $,=$"}; 6 | eval { Just 7 | another 8 | Perl 9 | hacker 10 | }; 11 | package another 12 | ;sub Just 13 | {print qw; Perl 14 | hacker 15 | ;} 16 | package hacker 17 | ;sub Perl 18 | {print qw; Just 19 | another 20 | ;,''} 21 | -------------------------------------------------------------------------------- /JAPH/vec_japh.pl: -------------------------------------------------------------------------------- 1 | $_ = [ 2 | 74, 116, 113, 113, 3 | 28, 92, 104, 104, 4 | 108, 95, 91, 103, 5 | 20, 67, 87, 99, 6 | 92, 15, 86, 78, 7 | 79, 86, 79, 91, 8 | 20, 19, 00, 73, 9 | ]; 10 | 11 | {vec(${print${$j},$/;$j},$i++ 12 | ,8)=$$_[$i]+$i;$$_[$i]&&redo} 13 | -------------------------------------------------------------------------------- /JAPH/vec_japh_2.pl: -------------------------------------------------------------------------------- 1 | $_=[$j=#]; 2 | 101, 98, 102, 108, 28, 3 | 69, 111, 108, 108, 23, 4 | 87, 99, 99, 103, 90, 5 | 86, 98, 15, 62, 82, 6 | 94, 87, 10, 81, 73, 7 | 74, 81, 74, 86, 15, 8 | 2, 31, 6, 17, 0, 9 | $i=$j-$j]; 10 | 11 | {vec($j,$i++,8)=$$_[$i]+$i;$$_[$i]&&redo||`$j`} 12 | -------------------------------------------------------------------------------- /Lingua/en_phoneme.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # License: GPLv3 5 | # Date: 15 April 2014 6 | # Website: https://github.com/trizen 7 | 8 | # usage: ./en_phoneme.pl [word] [word] [...] 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Lingua::EN::Phoneme; 15 | my $lep = Lingua::EN::Phoneme->new; 16 | 17 | sub normalize { 18 | my $syl = lc($_[0]); 19 | $syl =~ s/h0\z/x/; 20 | $syl =~ s/\w\K0\z//; 21 | $syl =~ s/\w\K1\z//; 22 | return $syl; 23 | } 24 | 25 | foreach my $word (@ARGV) { 26 | my $p_word = $lep->phoneme($word) // do { 27 | warn "error: '$word' is not an English word!\n"; 28 | next; 29 | }; 30 | say join(" ", map { normalize($_) } split(' ', $p_word)); 31 | } 32 | -------------------------------------------------------------------------------- /Lingua/lingua_ro_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use utf8; 4 | use 5.014; 5 | use strict; 6 | use warnings; 7 | 8 | use open ':std' => 'utf8'; 9 | 10 | use Scalar::Util qw(looks_like_number); 11 | use Lingua::RO::Numbers qw(ro_to_number number_to_ro); 12 | 13 | require Term::ReadLine; 14 | my $term = Term::ReadLine->new($0); 15 | 16 | while (1) { 17 | my $num = $term->readline("Introduceți un număr: ") // last; 18 | say +(looks_like_number($num) ? number_to_ro($num) : ro_to_number($num)) // next; 19 | } 20 | -------------------------------------------------------------------------------- /Lingua/rus_translit.pl: -------------------------------------------------------------------------------- 1 | use Lingua::Translit; 2 | my $tr = new Lingua::Translit('DIN 1460 RUS'); 3 | print $tr->translit(@ARGV ? shift : join'',<>); 4 | -------------------------------------------------------------------------------- /Math/1_over_n_is_finite.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 25 December 2012 6 | # https://github.com/trizen 7 | 8 | # Checks if 1/n is finite or infinite. 9 | 10 | # See also: https://perlmonks.org/index.pl?node_id=1006283 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | sub is_finite { 17 | my ($x) = @_; 18 | $x || return; 19 | $x /= 5 while $x % 5 == 0; 20 | return !($x & $x - 1); 21 | } 22 | 23 | foreach my $i (1 .. 20) { 24 | printf "%-4s is finite: %d\n", "1/$i", is_finite($i); 25 | } 26 | -------------------------------------------------------------------------------- /Math/1_over_n_period_length.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 09 October 2016 6 | # Website: https://github.com/trizen 7 | 8 | # The period length after the decimal point of 1/n. 9 | # This is defined only for integers prime to 10. 10 | 11 | # Inspired by N. J. Wildberger's video: 12 | # https://www.youtube.com/watch?v=lMrz7ISoDGs 13 | 14 | # See also: 15 | # https://oeis.org/A002329 16 | 17 | use 5.010; 18 | use strict; 19 | use warnings; 20 | 21 | use ntheory qw(divisors euler_phi powmod); 22 | 23 | sub period_length_1_over_n { 24 | my ($n) = @_; 25 | 26 | my @divisors = divisors(euler_phi($n)); 27 | 28 | foreach my $d (@divisors) { 29 | if (powmod(10, $d, $n) == 1) { 30 | return $d; 31 | } 32 | } 33 | 34 | return -1; 35 | } 36 | 37 | foreach my $n (1 .. 99) { 38 | my $l = period_length_1_over_n($n); 39 | printf("P(%2d) = %d\n", $n, $l) if $l != -1; 40 | } 41 | -------------------------------------------------------------------------------- /Math/almost_prime_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 14 February 2021 5 | # https://github.com/trizen 6 | 7 | # Generate k-almost prime numbers <= n. (not in sorted order) 8 | 9 | # See also: 10 | # https://en.wikipedia.org/wiki/Almost_prime 11 | 12 | use 5.020; 13 | use ntheory qw(:all); 14 | use experimental qw(signatures); 15 | 16 | sub almost_prime_numbers ($n, $k, $callback) { 17 | 18 | sub ($m, $p, $r) { 19 | 20 | if ($r == 1) { 21 | 22 | forprimes { 23 | $callback->(mulint($m, $_)); 24 | } $p, divint($n, $m); 25 | 26 | return; 27 | } 28 | 29 | my $s = rootint(divint($n, $m), $r); 30 | 31 | for (my $q = $p ; $q <= $s ; $q = next_prime($q)) { 32 | __SUB__->(mulint($m, $q), $q, $r - 1); 33 | } 34 | }->(1, 2, $k); 35 | } 36 | 37 | # Generate all the numbers k <= 100 for which bigomega(k) = 4 38 | almost_prime_numbers(100, 4, sub ($n) { say $n }); 39 | -------------------------------------------------------------------------------- /Math/area_of_triangle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 17 August 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Find the area of a triangle where all three sides are known, using Heron's Formula. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | sub triangle_area { 15 | my ($x, $y, $z) = @_; 16 | my $s = ($x + $y + $z) / 2; 17 | sqrt($s * ($s - $x) * ($s - $y) * ($s - $z)); 18 | } 19 | 20 | say triangle_area(5, 5, 6); 21 | -------------------------------------------------------------------------------- /Math/arithmetic_derivative.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 18 August 2017 5 | # https://github.com/trizen 6 | 7 | # A simple implementation of the arithmetic derivative function for positive integers. 8 | 9 | # See also: 10 | # https://projecteuler.net/problem=484 11 | 12 | use 5.016; 13 | use strict; 14 | use warnings; 15 | 16 | use ntheory qw(factor); 17 | 18 | sub arithmetic_derivative { 19 | my ($n) = @_; 20 | 21 | my $sum = 0; 22 | foreach my $p (factor($n)) { 23 | $sum += $n / $p; 24 | } 25 | 26 | return $sum; 27 | } 28 | 29 | say arithmetic_derivative(1234); #=> 619 30 | say arithmetic_derivative(479001600); #=> 3496919040 31 | say arithmetic_derivative(162375475128); #=> 298100392484 32 | -------------------------------------------------------------------------------- /Math/arithmetic_sum_closed_form.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 20 November 2017 6 | # https://github.com/trizen 7 | 8 | # Compute the sum of an arithmetic sequence. 9 | 10 | # Example: arithmetic_sum_*(1,3,1) returns 6 because 1+2+3 = 6 11 | # arithmetic_sum_*(1,7,2) returns 16 because 1+3+5+7 = 16 12 | 13 | # arithmetic_sum_*(begin, end, step) 14 | 15 | use 5.010; 16 | use strict; 17 | use warnings; 18 | 19 | use experimental qw(signatures); 20 | 21 | sub arithmetic_sum_continuous ($x, $y, $z) { 22 | ($x + $y) * (($y - $x) / $z + 1) / 2; 23 | } 24 | 25 | sub arithmetic_sum_discrete ($x, $y, $z) { 26 | (int(($y - $x) / $z) + 1) * ($z * int(($y - $x) / $z) + 2 * $x) / 2; 27 | } 28 | 29 | say arithmetic_sum_continuous(10, 113, 6); #=> 1117.25 30 | say arithmetic_sum_discrete(10, 113, 6); #=> 1098 31 | -------------------------------------------------------------------------------- /Math/bell_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Fast algorithm for computing the first n Bell numbers, using Aitken's array. 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Bell_number 7 | 8 | use 5.020; 9 | use strict; 10 | use warnings; 11 | 12 | use experimental qw(signatures); 13 | ## use Math::AnyNum qw(:overload); 14 | 15 | sub bell_numbers ($n) { 16 | 17 | my @acc; 18 | my @bell = (1); 19 | 20 | foreach my $k (1 .. $n) { 21 | 22 | my $t = $bell[-1]; 23 | 24 | foreach my $i (0 .. $#acc) { 25 | $t += $acc[$i]; 26 | $acc[$i] = $t; 27 | } 28 | 29 | unshift(@acc, $bell[-1]); 30 | push @bell, $acc[-1]; 31 | } 32 | 33 | @bell; 34 | } 35 | 36 | say join ', ', bell_numbers(15); 37 | 38 | __END__ 39 | 1, 1, 2, 5, 15, 52, 203, 877, 4140, 21147, 115975, 678570, 4213597, 27644437, 190899322, 1382958545 40 | -------------------------------------------------------------------------------- /Math/bell_numbers_mpz.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Fast algorithm for computing the first `n` Bell numbers, using Aitken's array (optimized for space). 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Bell_number 7 | 8 | use 5.020; 9 | use strict; 10 | use warnings; 11 | 12 | use Math::GMPz; 13 | use experimental qw(signatures); 14 | 15 | sub bell_numbers($n) { 16 | 17 | my @acc; 18 | 19 | my $t = Math::GMPz::Rmpz_init(); 20 | my @bell = (Math::GMPz::Rmpz_init_set_ui(1)); 21 | 22 | foreach my $k (1 .. $n) { 23 | 24 | Math::GMPz::Rmpz_set($t, $bell[-1]); 25 | 26 | foreach my $item (@acc) { 27 | Math::GMPz::Rmpz_add($t, $t, $item); 28 | Math::GMPz::Rmpz_set($item, $t); 29 | } 30 | 31 | unshift @acc, Math::GMPz::Rmpz_init_set($bell[-1]); 32 | push @bell, Math::GMPz::Rmpz_init_set($acc[-1]); 33 | } 34 | 35 | @bell; 36 | } 37 | 38 | say join ', ', bell_numbers(15); 39 | 40 | __END__ 41 | 1, 1, 2, 5, 15, 52, 203, 877, 4140, 21147, 115975, 678570, 4213597, 27644437, 190899322, 1382958545 42 | -------------------------------------------------------------------------------- /Math/bernoulli_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Akiyama–Tanigawa algorithm for computing the nth-Bernoulli number. 4 | 5 | use 5.010; 6 | use strict; 7 | use warnings; 8 | 9 | use Math::AnyNum qw(:overload); 10 | 11 | # Translation of: 12 | # https://en.wikipedia.org/wiki/Bernoulli_number#Algorithmic_description 13 | 14 | sub bernoulli { 15 | my ($n) = @_; 16 | 17 | return 0 if $n > 1 && $n % 2; # Bn = 0 for all odd n > 1 18 | 19 | my @A; 20 | for my $m (0 .. $n) { 21 | $A[$m] = 1 / ($m + 1); 22 | 23 | for (my $j = $m ; $j > 0 ; $j--) { 24 | $A[$j - 1] = $j * ($A[$j - 1] - $A[$j]); 25 | } 26 | } 27 | 28 | return $A[0]; # which is Bn 29 | } 30 | 31 | foreach my $i (0 .. 50) { 32 | printf "B%-3d = %s\n", 2 * $i, bernoulli(2 * $i); 33 | } 34 | -------------------------------------------------------------------------------- /Math/bernoulli_numbers_ramanujan_congruences.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Formula due to Ramanujan for computing the nth-Bernoulli number. 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Bernoulli_number#Ramanujan's_congruences 7 | 8 | use 5.020; 9 | use warnings; 10 | 11 | use experimental qw(signatures); 12 | use Math::AnyNum qw(:overload sum binomial); 13 | 14 | sub ramanujan_bernoulli_number ($n, $cache = {}) { 15 | 16 | return 1/2 if ($n == 1); 17 | return 0 if ($n%2 == 1); 18 | 19 | $cache->{$n} //= do { 20 | (($n%6 == 4 ? -1/2 : 1) * ($n+3)/3 - 21 | sum(map { 22 | binomial($n+3, $n - 6*$_) * __SUB__->($n - 6*$_, $cache) 23 | } 1 .. ($n - $n%6) / 6) 24 | ) / binomial($n+3, $n) 25 | }; 26 | } 27 | 28 | foreach my $i (0 .. 50) { 29 | printf "B%-3d = %s\n", 2 * $i, ramanujan_bernoulli_number(2 * $i); 30 | } 31 | -------------------------------------------------------------------------------- /Math/bernoulli_numbers_recursive_2.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 04 October 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Recursive computation of Bernoulli numbers (slightly improved). 9 | # https://en.wikipedia.org/wiki/Bernoulli_number#Recursive_definition 10 | 11 | use 5.014; 12 | use strict; 13 | use warnings; 14 | 15 | use Memoize qw(memoize); 16 | use Math::AnyNum qw(:overload binomial); 17 | 18 | memoize('bernoulli'); 19 | 20 | sub bernoulli { 21 | my ($n) = @_; 22 | 23 | return 1/2 if $n == '1'; 24 | return 0 if $n % '2'; 25 | return 1 if $n == '0'; 26 | 27 | my $bern = 1/2 - 1 / ($n + 1); 28 | for (my $k = '2' ; $k < $n ; $k += '2') { 29 | $bern -= bernoulli($k) * binomial($n, $k) / ($n - $k + '1'); 30 | } 31 | $bern; 32 | } 33 | 34 | foreach my $i (0 .. 50) { 35 | printf "B%-3d = %s\n", '2' * $i, bernoulli('2' * $i); 36 | } 37 | -------------------------------------------------------------------------------- /Math/binary_gcd_algorithm.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 12 August 2017 5 | # https://github.com/trizen 6 | 7 | # Algorithm invented by J. Stein in 1967, described in the 8 | # book "Algorithmic Number Theory" by Eric Bach and Jeffrey Shallit. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | sub binary_gcd { 15 | my ($u, $v) = @_; 16 | 17 | my $g = 1; 18 | 19 | while (($u & 1) == 0 and ($v & 1) == 0) { 20 | $u >>= 1; 21 | $v >>= 1; 22 | $g <<= 1; 23 | } 24 | 25 | while ($u != 0) { 26 | if (($u & 1) == 0) { 27 | $u >>= 1; 28 | } 29 | elsif (($v & 1) == 0) { 30 | $v >>= 1; 31 | } 32 | elsif ($u >= $v) { 33 | $u -= $v; 34 | $u >>= 1; 35 | } 36 | else { 37 | $v -= $u; 38 | $v >>= 1; 39 | } 40 | } 41 | 42 | return ($g * $v); 43 | } 44 | 45 | say binary_gcd(10628640, 3628800); #=> 1440 46 | say binary_gcd(3628800, 10628640); #=> 1440 47 | -------------------------------------------------------------------------------- /Math/binary_multiplier.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 07 August 2015 6 | # Website: https://github.com/trizen 7 | 8 | # A very simple binary multiplier. 9 | # Derived from: https://en.wikipedia.org/wiki/Binary_multiplier#A_more_advanced_approach:_an_unsigned_example 10 | 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | my $a = 0b11110001; 16 | my $b = 0b11011011; 17 | 18 | say $a; 19 | say $b; 20 | say $a * $b; 21 | 22 | my @a = reverse(split(//, sprintf("%b", $a))); 23 | 24 | my $p = 0; 25 | foreach my $i (@a) { 26 | $i && ($p += $b); 27 | $b <<= 1; 28 | } 29 | 30 | say $p; 31 | -------------------------------------------------------------------------------- /Math/binary_splitting_product.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Compute the product of a list of numbers, using binary splitting. 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Binary_splitting 7 | 8 | use 5.020; 9 | use strict; 10 | use warnings; 11 | 12 | use experimental qw(signatures); 13 | 14 | sub binsplit_product ($s, $n, $m) { 15 | $n > $m and return 1; 16 | $n == $m and return $s->[$n]; 17 | my $k = ($n + $m) >> 1; 18 | __SUB__->($s, $n, $k) * __SUB__->($s, $k + 1, $m); 19 | } 20 | 21 | foreach my $n (1 .. 10) { 22 | my @list = (1 .. $n); 23 | printf "%2d! = %s\n", $n, binsplit_product(\@list, 0, $#list); 24 | } 25 | -------------------------------------------------------------------------------- /Math/binomial_theorem.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 19 December 2016 6 | # https://github.com/trizen 7 | 8 | # Implementation of the binomial theorem. 9 | 10 | # Defined as: 11 | # (a + b)^n = sum(g(k) * a^(n-k) * b^k, {k=0, n}) 12 | # 13 | # where g(k) is: 14 | # g(0) = 1 15 | # g(k) = (n - k + 1) * g(k-1) / k 16 | 17 | use 5.010; 18 | use strict; 19 | use warnings; 20 | 21 | no warnings 'recursion'; 22 | 23 | # 24 | ## The binomial coefficient: (n, k) 25 | # 26 | sub g { 27 | my ($n, $k) = @_; 28 | $k == 0 ? 1 : ($n - $k + 1) * g($n, $k - 1) / $k; 29 | } 30 | 31 | # 32 | ## Binomial summation for (a + b)^n 33 | # 34 | sub binomial_sum { 35 | my ($a, $b, $n) = @_; 36 | my $sum = 0; 37 | foreach my $k (0 .. $n) { 38 | $sum += g($n, $k) * $a**($n - $k) * $b**$k; 39 | } 40 | return $sum; 41 | } 42 | 43 | # 44 | ## Example for (1 + 1/30)^30 45 | # 46 | 47 | my $a = 1; 48 | my $b = 1/30; 49 | my $n = 30; 50 | 51 | say binomial_sum($a, $b, $n); #=> 2.6743187758703 52 | -------------------------------------------------------------------------------- /Math/bitstring_prime_sieve_vec.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 14 May 2018 5 | # https://github.com/trizen 6 | 7 | # A decently fast bit-string sieve for prime numbers. 8 | 9 | # Useful when memory is very restricted. 10 | 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | sub bitstring_prime_sieve { 16 | my ($n) = @_; 17 | 18 | my $c = ''; 19 | my $bound = int(sqrt($n)); 20 | 21 | for (my $i = 3 ; $i <= $bound ; $i += 2) { 22 | if (!vec($c, $i, 1)) { 23 | for (my $j = $i * $i ; $j <= $n ; $j += $i << 1) { 24 | vec($c, $j, 1) = 1; 25 | } 26 | } 27 | } 28 | 29 | my @primes = (2); 30 | foreach my $k (1 .. ($n - 1) >> 1) { 31 | vec($c, ($k << 1) + 1, 1) || push(@primes, ($k << 1) + 1); 32 | } 33 | return @primes; 34 | } 35 | 36 | my $n = shift(@ARGV) // 100; 37 | my @primes = bitstring_prime_sieve($n); 38 | say join(' ', @primes); 39 | say "PI($n) = ", scalar(@primes); 40 | -------------------------------------------------------------------------------- /Math/brown_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # See: https://www.youtube.com/watch?v=-Djj6pfR9KU 4 | 5 | use 5.010; 6 | use strict; 7 | use warnings; 8 | 9 | use Math::AnyNum qw(factorial is_power); 10 | 11 | for my $i (1 .. 60) { 12 | my $n = factorial($i) + 1; 13 | is_power($n) || next; 14 | printf("(%d, %d)\n", int(sqrt($n)), $i); 15 | } 16 | 17 | __END__ 18 | (5, 4) 19 | (11, 5) 20 | (71, 7) 21 | -------------------------------------------------------------------------------- /Math/carmichael_numbers_from_multiple.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 17 March 2023 5 | # https://github.com/trizen 6 | 7 | # Generate Carmichael numbers from a given multiple. 8 | 9 | # See also: 10 | # https://trizenx.blogspot.com/2020/08/pseudoprimes-construction-methods-and.html 11 | 12 | use 5.036; 13 | use Math::GMPz; 14 | use ntheory qw(:all); 15 | 16 | sub carmichael_from_multiple ($m, $callback) { 17 | 18 | my $L = lcm(map { subint($_, 1) } factor($m)); 19 | my $v = invmod($m, $L) // return; 20 | 21 | for (my $p = $v ; ; $p += $L) { 22 | 23 | gcd($m, $p) == 1 or next; 24 | 25 | my @factors = factor_exp($p); 26 | (vecall { $_->[1] == 1 } @factors) || next; 27 | 28 | my $n = $m * $p; 29 | my $l = lcm(map { subint($_->[0], 1) } @factors); 30 | 31 | if (($n - 1) % $l == 0) { 32 | $callback->($n); 33 | } 34 | } 35 | } 36 | 37 | carmichael_from_multiple(13 * 19, sub ($n) { say $n }); 38 | -------------------------------------------------------------------------------- /Math/cartesian_product_rec.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 23 April 2017 5 | # https://github.com/trizen 6 | 7 | # Recursive algorithm for computing the Cartesian product. 8 | 9 | # Algorithm from Math::Cartesian::Product 10 | # https://metacpan.org/pod/Math::Cartesian::Product 11 | 12 | use 5.016; 13 | use warnings; 14 | 15 | sub cartesian(&@) { 16 | my ($callback, @C) = @_; 17 | my (@c, @r); 18 | 19 | sub { 20 | if (@c < @C) { 21 | for my $item (@{$C[@c]}) { 22 | CORE::push(@c, $item); 23 | __SUB__->(); 24 | CORE::pop(@c); 25 | } 26 | } 27 | else { 28 | $callback->(@c); 29 | } 30 | } 31 | ->(); 32 | } 33 | 34 | cartesian { 35 | say "@_"; 36 | } (['a', 'b'], ['c', 'd', 'e'], ['f', 'g']); 37 | -------------------------------------------------------------------------------- /Math/complex_logarithm_in_real_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 11 December 2017 5 | # https://github.com/trizen 6 | 7 | # Identity for computing the natural logarithm of a complex number, in real numbers, with the identity: 8 | # 9 | # log(a+b*i) = log(a^2 + b^2)/2 + atan(b/a)*i 10 | # 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | sub complex_log { 17 | my ($re, $im) = @_; 18 | 19 | ( 20 | log($re**2 + $im**2)/2, 21 | atan2($im, $re) 22 | ); 23 | } 24 | 25 | # 26 | ## Example for log(3+5i) 27 | # 28 | 29 | my $re = 3; 30 | my $im = 5; 31 | 32 | my ($real, $imag) = complex_log($re, $im); 33 | 34 | say "log($re + $im*i) = $real + $imag*i"; #=> 1.76318026230808 + 1.03037682652431*i 35 | -------------------------------------------------------------------------------- /Math/complex_zeta_in_real_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 08 August 2017 5 | # https://github.com/trizen 6 | 7 | # Computing the zeta function for a complex input, using only real numbers. 8 | 9 | # Defined as: 10 | # zeta(a + b*i) = Sum_{n>=1} 1/n^(a + b*i) 11 | 12 | # where we have the identity: 13 | # 1/n^(a + b*i) = (cos(log(n) * b) - i*sin(log(n) * b)) / n**a 14 | 15 | use 5.010; 16 | use strict; 17 | use warnings; 18 | 19 | use experimental qw(signatures); 20 | 21 | sub complex_zeta ($r = 1 / 2, $s = 14.134725142, $rep = 1e6) { 22 | 23 | my $real = 0; 24 | my $imag = 0; 25 | 26 | foreach my $n (1 .. $rep) { 27 | $real += cos(log($n) * $s) / $n**$r; 28 | $imag -= sin(log($n) * $s) / $n**$r; 29 | } 30 | 31 | return ($real, $imag); 32 | } 33 | 34 | my $r = 3; # real part 35 | my $s = 4; # imaginary part 36 | 37 | my ($real, $imag) = complex_zeta($r, $s); 38 | say "zeta($r + $s*i) =~ complex($real, $imag)"; #=> complex(0.890554906959998, -0.0080759454242689) 39 | -------------------------------------------------------------------------------- /Math/continued_fractions.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 04 November 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Continued fractions 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | no warnings 'recursion'; 15 | 16 | sub root2 { 17 | my ($n) = @_; 18 | 19 | return 0 if $n <= 0; 20 | 21 | 1.0/( 22 | 2.0 + root2($n-1) 23 | ) 24 | } 25 | 26 | sub e { 27 | my($i, $n) = @_; 28 | 29 | return 0 if $n >= $i; 30 | 31 | 1.0/( 32 | 1.0 + 1.0/( 33 | 2.0*$n + 1.0/( 34 | 1.0 + e($i, $n+1) 35 | ) 36 | ) 37 | ) 38 | } 39 | 40 | say 1+root2(100); # sqrt(2) 41 | say 2+e(100, 1); # e 42 | -------------------------------------------------------------------------------- /Math/continued_fractions_for_pi.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 10 May 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Continued fractions for PI. 9 | # Inspired by: https://www.youtube.com/watch?v=fd39yK2GZSA 10 | 11 | use 5.010; 12 | use strict; 13 | 14 | sub pi_1 { 15 | my ($i, $limit) = @_; 16 | $limit > 0 ? ($i**2 / (2 + pi_1($i + 2, $limit - 1))) : 0; 17 | } 18 | 19 | sub pi_2 { 20 | my ($i, $limit) = @_; 21 | $limit > 0 ? ($i**2 / (2 * $i + 1 + pi_2($i + 1, $limit - 1))) : 0; 22 | } 23 | 24 | sub pi_3 { 25 | my ($i, $limit) = @_; 26 | $limit > 0 ? ((2 * $i + 1)**2 / (6 + pi_3($i + 1, $limit - 1))) : 0; 27 | } 28 | 29 | say 4 / (1 + pi_1(1, 100000)); # slow convergence 30 | say 4 / (1 + pi_2(1, 100)); # fast convergence 31 | say 3 + pi_3(0, 100000); # slow convergence 32 | -------------------------------------------------------------------------------- /Math/continued_fractions_for_square_roots.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 09 November 2015 5 | # https://github.com/trizen 6 | 7 | # Square roots as continued fractions 8 | 9 | # See also: 10 | # https://en.wikipedia.org/wiki/Continued_fraction#Generalized_continued_fraction_for_square_roots 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | no warnings 'recursion'; 17 | 18 | sub square_root { 19 | my ($n, $precision) = @_; 20 | $precision > 0 ? ($n - 1) / (2 + square_root($n, $precision - 1)) : 0; 21 | } 22 | 23 | for my $i (1 .. 10) { 24 | printf("sqrt(%2d) = %s\n", $i, 1 + square_root($i, 1000)); 25 | } 26 | -------------------------------------------------------------------------------- /Math/continued_fractions_prime_constant.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 10 May 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Continued fraction constant for primes. 9 | 10 | use 5.010; 11 | use strict; 12 | use ntheory qw(nth_prime); 13 | 14 | sub prime_constant { 15 | my ($i, $limit) = @_; 16 | my $p = nth_prime($i); 17 | $limit > 0 ? ($p / ($p + prime_constant($i + 1, $limit - 1))) : 0; 18 | } 19 | 20 | my $pc = prime_constant(1, 10000); 21 | 22 | say $pc; 23 | say 1 / (1 + $pc); # "1" is considered prime here 24 | 25 | __END__ 26 | 0.71961651193526 27 | 0.581525004592215 28 | -------------------------------------------------------------------------------- /Math/count_of_perfect_powers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Efficient formula for counting the numbers of perfect powers <= n. 4 | 5 | # Formula: 6 | # a(n) = n - Sum_{1..floor(log_2(n))} mu(k) * (floor(n^(1/k)) - 1) 7 | # = 1 - Sum_{2..floor(log_2(n))} mu(k) * (floor(n^(1/k)) - 1) 8 | 9 | # See also: 10 | # https://oeis.org/A069623 11 | 12 | use 5.036; 13 | use ntheory qw(logint rootint moebius vecsum); 14 | 15 | sub perfect_power_count ($n) { 16 | 1 - vecsum(map { moebius($_) * (rootint($n, $_) - 1) } 2 .. logint($n, 2)); 17 | } 18 | 19 | foreach my $n (0 .. 15) { 20 | printf("a(10^%d) = %s\n", $n, perfect_power_count(10**$n)); 21 | } 22 | 23 | __END__ 24 | a(10^0) = 1 25 | a(10^1) = 4 26 | a(10^2) = 13 27 | a(10^3) = 41 28 | a(10^4) = 125 29 | a(10^5) = 367 30 | a(10^6) = 1111 31 | a(10^7) = 3395 32 | a(10^8) = 10491 33 | a(10^9) = 32670 34 | a(10^10) = 102231 35 | a(10^11) = 320990 36 | a(10^12) = 1010196 37 | a(10^13) = 3184138 38 | a(10^14) = 10046921 39 | a(10^15) = 31723592 40 | -------------------------------------------------------------------------------- /Math/count_of_squarefree_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 09 February 2017 6 | # https://github.com/trizen 7 | 8 | # Counts the number of squarefree numbers in the range [1, n]. 9 | 10 | # See also: 11 | # https://oeis.org/A053462 12 | # https://projecteuler.net/problem=193 13 | # https://en.wikipedia.org/wiki/Square-free_integer 14 | # https://en.wikipedia.org/wiki/M%C3%B6bius_function 15 | 16 | use 5.010; 17 | use strict; 18 | use integer; 19 | 20 | use ntheory qw(moebius sqrtint); 21 | 22 | sub squarefree_count { 23 | my ($n) = @_; 24 | 25 | my $k = 1; 26 | my $count = 0; 27 | 28 | foreach my $m (moebius(1, sqrtint($n))) { 29 | $count += $m * ($n / ($k++)**2); 30 | } 31 | 32 | return $count; 33 | } 34 | 35 | say squarefree_count(10**9); #=> 607927124 36 | -------------------------------------------------------------------------------- /Math/cuboid.pl: -------------------------------------------------------------------------------- 1 | sub say{print@_,$/}sub cube 2 | {my($x,$y,$z)=map{int}@_;my( 3 | $c,$h,$v,$d,$s)=((qw{+ - | /} 4 | ),$ARGV[3]||' ');my($p,$o)=(0, 5 | 0);say ' 'x($z+1),$c,$h x$x,$c; 6 | for(1..$z){say ' 'x($z-$_+1),$d, 7 | $s x$x,$d,$s x($_-1-$p),$_>$y?!$p 8 | ?do{$p=1;$o=$z-$y;$c}:$p++?$d:$c: 9 | $v;}say$c,$h x$x,$c,$z<$y?do{$s x 10 | $z,$v}:$p?do{$s x($z-$o),$d}:do{$ 11 | s x$z,$c};for(1..$y){say$v,$s x$x 12 | ,$v,$z-1>=$y?$_>=$z?($s x$x,$c):( 13 | $s x($z-$_-$o),$d):$z==$y?do{$s# 14 | x($y-$_),$d}:$y-$_>$z?do{$s x$z 15 | ,$v}:$y-$_==$z?do{$s x($y-$_), 16 | $c}:do{$s x($y-$_),$d}}say$c, 17 | $h x$x,$c}cube @ARGV>2?@ARGV 18 | [0..2]:map{rand($_)}20,10,8 19 | -------------------------------------------------------------------------------- /Math/definite_integral_numerical_approximation.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 21 February 2018 5 | # https://github.com/trizen 6 | 7 | # Simple numerical approximation for definite integrals. 8 | 9 | use 5.020; 10 | use strict; 11 | use warnings; 12 | 13 | use experimental qw(signatures); 14 | 15 | sub integral ($from, $to, $expr, $dx = 0.0001) { 16 | my $sum = 0; 17 | 18 | for (my $x = $from ; $x <= $to ; $x += $dx) { 19 | $sum += $expr->($x) * $dx; 20 | } 21 | 22 | return $sum; 23 | } 24 | 25 | say integral(0, atan2(0, -1), sub ($x) { sin($x) }); # 1.99999999867257 26 | say integral(2, 100, sub ($x) { 1 / log($x) }); # 29.0810390821689 27 | say integral(-3, 5, sub ($x) { 10 * $x**3 + $x * cos($x) }); # 1355.97975127903 28 | -------------------------------------------------------------------------------- /Math/difference_of_k_powers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 28 April 2017 6 | # https://github.com/trizen 7 | 8 | # Find the smallest representations for natural numbers as the difference of some k power. 9 | 10 | # Example: 11 | # 781 = 4^5 - 3^5 12 | # 992 = 10^3 - 2^3 13 | # 999 = 32^2 - 5^2 14 | 15 | use 5.010; 16 | use strict; 17 | use warnings; 18 | 19 | use Math::AnyNum qw(root ceil log2); 20 | 21 | OUTER: foreach my $n (1 .. 1000) { 22 | foreach my $i (2 .. ceil(log2($n))) { 23 | my $s = ceil(root($n, $i)); 24 | foreach my $k (0 .. $s) { 25 | if ($s**$i - $k**$i == $n) { 26 | say "$n = $s^$i - $k^$i"; 27 | next OUTER; 28 | } 29 | } 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /Math/discrete_root.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 10 January 2017 6 | # https://github.com/trizen 7 | 8 | # An example for finding the smallest value `x` in: 9 | # 10 | # x^e = r (mod n) 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | use ntheory qw(invmod powmod euler_phi); 17 | 18 | sub discrete_root { 19 | my ($e, $r, $n) = @_; 20 | my $d = invmod($e, euler_phi($n)); 21 | powmod($r, $d, $n); 22 | } 23 | 24 | # 25 | ## Solves for x in x^65537 = 1653 (mod 2279) 26 | # 27 | 28 | say discrete_root(65537, 1653, 2279); # 1234 29 | -------------------------------------------------------------------------------- /Math/divisors_less_than_k.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 04 August 2019 5 | # https://github.com/trizen 6 | 7 | # Generate all the divisors d of n, such that d <= k. 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use ntheory qw(factor_exp divisors); 14 | 15 | sub divisors_le { 16 | my ($n, $k) = @_; 17 | 18 | my @d = (1); 19 | my @pp = grep { $_->[0] <= $k } factor_exp($n); 20 | 21 | foreach my $pp (@pp) { 22 | 23 | my ($p, $e) = @$pp; 24 | 25 | my @t; 26 | my $r = 1; 27 | 28 | for my $i (1 .. $e) { 29 | $r *= $p; 30 | foreach my $u (@d) { 31 | push(@t, $u * $r) if ($u * $r <= $k); 32 | } 33 | } 34 | 35 | push @d, @t; 36 | } 37 | 38 | return sort { $a <=> $b } @d; 39 | } 40 | 41 | # Generate the divisors of 5040 less than or equal to 42 42 | say join ' ', divisors_le(5040, 42); 43 | -------------------------------------------------------------------------------- /Math/e_from_binomial.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 17 July 2016 6 | # Website: https://github.com/trizen 7 | 8 | # A new identity for e, based on (n+1)^n / n^n, as n->infinity, 9 | # with the binomial expansion of (n+1)^n derived by the author. 10 | 11 | # n -> ∞ 12 | # --- 13 | # \ binomial(n, k) 14 | # / --------------- = e 15 | # --- n^(n-k) 16 | # k = 0 17 | 18 | use 5.014; 19 | use strict; 20 | use warnings; 21 | 22 | use Math::AnyNum qw(:overload binomial); 23 | 24 | my $n = 5000; 25 | my $sum = 0.0; 26 | 27 | foreach my $k(0 .. $n) { 28 | $sum += binomial($n, $k) / $n**($n-$k); 29 | } 30 | 31 | say $sum; 32 | -------------------------------------------------------------------------------- /Math/e_primorial.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 04 September 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Compute a new constant, called e-primorial 9 | # using the following formula: 10 | # 1 + sum({n=0, Inf}, 1/n#) 11 | # where 'n#' is the product of the first n primes. 12 | 13 | # Example: 14 | # 1 + 1/2 + 1/(2*3) + 1/(2*3*5) + 1/(2*3*5*7) 15 | 16 | use 5.010; 17 | use strict; 18 | use warnings; 19 | 20 | use bignum (try => 'GMP'); 21 | use ntheory qw(forprimes); 22 | 23 | my $s = 0; 24 | my $p = 1; 25 | 26 | forprimes { 27 | $s += 1 / ($p *= $_); 28 | } 29 | 1000; 30 | 31 | say $s; 32 | 33 | __END__ 34 | 0.705230171791800965147431682888248513743607733565505914344254271579448720350814858381153069719904774040199744849124258793026220304812181974452618661012021323159778159738892351792865007915208229244324416883081570696757761526547730409991939570626315095656064297092991040559037018681680261221057850602197069242610518384960529122692938064843534568180026418571495177395781060935455813529379203383024423075030933708131887415 35 | -------------------------------------------------------------------------------- /Math/ethiopian_multiplication.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Derived: 13 July 2016 6 | # Coded: 23 October 2016 7 | # Website: https://github.com/trizen 8 | 9 | # A derivation of the Ethiopian multiplication method (also known as "Russian multiplication"). 10 | 11 | # a*b = sum((floor(a * 2^(-k)) mod 2) * b*2^k, {k = 0, floor(log(a)/log(2))}) 12 | 13 | # See also: 14 | # https://mathworld.wolfram.com/RussianMultiplication.html 15 | 16 | use 5.010; 17 | use strict; 18 | use warnings; 19 | 20 | sub ethiopian_multiplication { 21 | my ($x, $y) = @_; 22 | 23 | my $r = 0; 24 | foreach my $k (0 .. log($x) / log(2)) { 25 | $r += (($x >> $k) % 2) * ($y << $k); 26 | } 27 | return $r; 28 | } 29 | 30 | say ethiopian_multiplication(3, 5); #=> 15 31 | say ethiopian_multiplication(7, 41); #=> 287 32 | -------------------------------------------------------------------------------- /Math/factorial_from_primes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 18 July 2016 6 | # Website: https://github.com/trizen 7 | 8 | # A fast algorithm, based on powers of primes, 9 | # for exactly computing very large factorials. 10 | 11 | use 5.020; 12 | use strict; 13 | use warnings; 14 | 15 | use Math::GMPz qw(:mpz); 16 | use experimental qw(signatures); 17 | use ntheory qw(forprimes todigits vecsum); 18 | 19 | sub factorial_power ($n, $p) { 20 | ($n - vecsum(todigits($n, $p))) / ($p - 1); 21 | } 22 | 23 | sub factorial ($n) { 24 | 25 | my $t = Rmpz_init(); 26 | my $f = Rmpz_init_set_ui(1); 27 | 28 | Rmpz_mul_2exp($f, $f, my $p = factorial_power($n, 2)); 29 | 30 | forprimes { 31 | if ($p == 1) { 32 | Rmpz_mul_ui($f, $f, $_); 33 | } 34 | else { 35 | Rmpz_ui_pow_ui($t, $_, $p = factorial_power($n, $_)); 36 | Rmpz_mul($f, $f, $t); 37 | } 38 | } 3, $n; 39 | 40 | $f; 41 | } 42 | 43 | say factorial($ARGV[0] // 1234); 44 | 45 | for (0..10) { 46 | say factorial($_); 47 | } 48 | -------------------------------------------------------------------------------- /Math/factorial_from_primes_simple.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 18 July 2016 6 | # Website: https://github.com/trizen 7 | 8 | # A fast algorithm, based on powers of primes, 9 | # for exactly computing very large factorials. 10 | 11 | use 5.020; 12 | use strict; 13 | use warnings; 14 | 15 | use experimental qw(signatures); 16 | 17 | use ntheory qw(forprimes); 18 | use Math::AnyNum qw(:overload sumdigits); 19 | 20 | sub factorial_power ($n, $p) { 21 | ($n - sumdigits($n, $p)) / ($p - 1); 22 | } 23 | 24 | sub factorial ($n) { 25 | 26 | my $f = 1; 27 | 28 | forprimes { 29 | $f *= $_**factorial_power($n, $_); 30 | } $n; 31 | 32 | return $f; 33 | } 34 | 35 | for my $n (0 .. 50) { 36 | say "$n! = ", factorial($n); 37 | } 38 | -------------------------------------------------------------------------------- /Math/factorial_from_trinomial_coefficients.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # An efficient algorithm for computing n! using trinomial coefficients. 4 | 5 | # See also: 6 | # https://oeis.org/A056040 7 | # https://oeis.org/A000142/a000142.pdf 8 | 9 | use 5.020; 10 | use strict; 11 | use warnings; 12 | 13 | use Math::GMPz; 14 | use experimental qw(signatures); 15 | 16 | sub trinomial ($m, $n, $o) { 17 | 18 | my $prod = Math::GMPz::Rmpz_init(); 19 | Math::GMPz::Rmpz_bin_uiui($prod, $m + $n + $o, $o); 20 | 21 | if ($n) { 22 | my $t = Math::GMPz::Rmpz_init(); 23 | Math::GMPz::Rmpz_bin_uiui($t, $m + $n, $n); 24 | Math::GMPz::Rmpz_mul($prod, $prod, $t); 25 | } 26 | 27 | return $prod; 28 | } 29 | 30 | sub Factorial($n) { 31 | return 1 if ($n < 2); 32 | Factorial($n >> 1)**2 * trinomial($n >> 1, $n % 2, $n >> 1); 33 | } 34 | 35 | foreach my $n (0 .. 30) { 36 | say "$n! = ", Factorial($n); 37 | } 38 | -------------------------------------------------------------------------------- /Math/factorial_in_half_steps.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 22 August 2015 6 | # Website: https://github.com/trizen 7 | 8 | # A new algorithm to compute n! in int(n/2) iterations, instead of n. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | #---------------------------------------------- 15 | ## The algorithm 16 | #---------------------------------------------- 17 | # 6! = 1 * 2 * 3 * 4 * 5 * 6 18 | # 19 | # = 1*6 * 2*5 * 3*4 20 | # = 6 * 10 * 12 21 | # 22 | # = (7*1 - 1^2) * (7*2 - 2^2) * (7*3 - 3^2) 23 | # = 1*(7-1) * 2*(7-2) * 3*(7-3) 24 | #---------------------------------------------- 25 | 26 | sub factorial { 27 | my ($n) = @_; 28 | 29 | use integer; 30 | 31 | my $p = 1; 32 | my $d = $n / 2; 33 | my $m = $n % 2; 34 | my $k = $n + 1; 35 | 36 | foreach my $i (1 .. $d) { 37 | $p *= $i * ($k - $i); 38 | } 39 | 40 | $m ? $p * ($k / 2) : $p; 41 | } 42 | 43 | foreach my $i (1 .. 15) { 44 | say "$i! = ", factorial($i); 45 | } 46 | -------------------------------------------------------------------------------- /Math/fermat_pseudoprimes_from_multiple.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 08 March 2023 5 | # https://github.com/trizen 6 | 7 | # Generate Fermat pseudoprimes from a given multiple, to a given base. 8 | 9 | # See also: 10 | # https://trizenx.blogspot.com/2020/08/pseudoprimes-construction-methods-and.html 11 | 12 | use 5.036; 13 | use ntheory qw(:all); 14 | 15 | sub fermat_pseudoprimes_from_multiple ($base, $m, $callback) { 16 | 17 | my $L = znorder($base, $m); 18 | my $v = invmod($m, $L) // return; 19 | 20 | for (my $p = $v ; ; $p += $L) { 21 | if (is_pseudoprime($m * $p, $base)) { 22 | $callback->($m * $p); 23 | } 24 | } 25 | } 26 | 27 | fermat_pseudoprimes_from_multiple(2, 341, sub ($n) { say $n }); 28 | -------------------------------------------------------------------------------- /Math/fibonacci_closed_form.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 29 October 2015 6 | # Website: https://github.com/trizen 7 | 8 | # A simple closed-form to the Fibonacci sequence 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | sub fib { 15 | my ($n) = @_; 16 | 17 | state $S = sqrt(5); 18 | state $T = ((1 + $S) / 2); 19 | state $U = (2 / (1 + $S)); 20 | state $PI = atan2(0, -'inf'); 21 | 22 | ($T**$n - ($U**$n * cos($PI * $n))) / $S; 23 | } 24 | 25 | for my $n (1 .. 20) { 26 | say "F($n) = ", fib($n); 27 | } 28 | -------------------------------------------------------------------------------- /Math/fibonacci_closed_form_2.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 29 October 2015 6 | # Website: https://github.com/trizen 7 | 8 | # A very simple and fast closed-form to the Fibonacci sequence 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | sub fib { 15 | my ($n) = @_; 16 | 17 | state $S = sqrt(1.25) + 0.5; 18 | state $T = sqrt(1.25) - 0.5; 19 | state $W = $S + $T; 20 | 21 | ($S**$n - (-$T)**($n)) / $W; 22 | } 23 | 24 | for my $n (1 .. 20) { 25 | say "F($n) = ", fib($n); 26 | } 27 | -------------------------------------------------------------------------------- /Math/fibonacci_k-th_order.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 20 April 2018 5 | # https://github.com/trizen 6 | 7 | # Compute the k-th order Fibonacci numbers. 8 | 9 | # See also: 10 | # https://oeis.org/A000045 (2-nd order: Fibonacci numbers) 11 | # https://oeis.org/A000073 (3-rd order: Tribonacci numbers) 12 | # https://oeis.org/A000078 (4-th order: Tetranacci numbers) 13 | # https://oeis.org/A001591 (5-th order: Pentanacci numbers) 14 | 15 | use 5.020; 16 | use strict; 17 | use warnings; 18 | 19 | use ntheory qw(vecsum); 20 | use experimental qw(signatures); 21 | 22 | sub kth_order_fibonacci ($n, $k = 2) { 23 | 24 | my @A = ((0) x ($k - 1), 1); 25 | 26 | for (1 .. $n) { 27 | @A = (@A[1 .. $k - 1], vecsum(@A[0 .. $k - 1])); 28 | } 29 | 30 | return $A[-1]; 31 | } 32 | 33 | for my $n (0 .. 20) { 34 | say kth_order_fibonacci($n, 5); 35 | } 36 | -------------------------------------------------------------------------------- /Math/fibonacci_number_fast.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 19 June 2018 5 | # https://github.com/trizen 6 | 7 | # An efficient algorithm for computing the nth-Fibonacci number. 8 | 9 | # See also: 10 | # https://github.com/trizen/perl-scripts/blob/master/Math/modular_fibonacci_cassini.pl 11 | # https://github.com/trizen/perl-scripts/blob/master/Math/modular_fibonacci_cassini_fast.pl 12 | 13 | use 5.020; 14 | use warnings; 15 | use experimental qw(signatures); 16 | use Math::AnyNum qw(:overload ilog2 getbit); 17 | 18 | sub fibonacci_number($n) { 19 | 20 | my ($f, $g) = (0, 1); 21 | my ($a, $b) = (0, 1); 22 | 23 | foreach my $k (0 .. ilog2($n)||0) { 24 | ($f, $g) = ($f*$a + $g*$b, $f*$b + $g*($a+$b)) if getbit($n, $k); 25 | ($a, $b) = ($a*$a + $b*$b, $a*$b + $b*($a+$b)); 26 | } 27 | 28 | return $f; 29 | } 30 | 31 | say fibonacci_number(100); #=> 354224848179261915075 32 | say join(' ', map { fibonacci_number($_) } 0 .. 15); #=> 0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 33 | -------------------------------------------------------------------------------- /Math/fibonacci_polynomials_closed_form.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Closed-form expression for Fibonacci polynomials: 4 | # Sum_{k=0..n} (fibonacci(k) * x^k) 5 | 6 | # Formulas generated by Wolfram|Alpha. 7 | 8 | # See also: 9 | # https://projecteuler.net/problem=435 10 | 11 | use 5.020; 12 | use strict; 13 | use warnings; 14 | 15 | use experimental qw(signatures); 16 | use Math::AnyNum qw(:overload); 17 | 18 | sub F1 ($n, $x) { 19 | (2**(-$n-1)*$x*(2*sqrt(5)*(1+sqrt(5))**$n*$x**($n+1)+(5+sqrt(5))*(1+sqrt(5))**$n*$x**$n-2*sqrt(5)*$x*($x-sqrt(5)*$x)**$n-sqrt(5)*($x-sqrt(5)*$x)**$n+5*($x-sqrt(5)*$x)**$n-5*2**($n+1)))/(5*($x**2+$x-1)); 20 | } 21 | 22 | sub F2 ($n, $x) { 23 | -(2**(2-$n)*(1+sqrt(5))**(-1-$n)*$x*((2*(1+sqrt(5)))**$n*(5+3*sqrt(5))-((-4)**$n*(1+sqrt(5))+2*(1+sqrt(5))**(2*$n)*(2+sqrt(5)))*$x**$n+(3+sqrt(5))*((-4)**$n-(1+sqrt(5))**(2*$n))*$x**(1+$n)))/(sqrt(5)*(1+sqrt(5)+2*$x)*(-2+$x+sqrt(5)*$x)); 24 | } 25 | 26 | say F1(7, 11); #=> 268357683 27 | say F2(7, 11); #=> =//= 28 | -------------------------------------------------------------------------------- /Math/find_least_common_denominator.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 10 May 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Find the least common denominator for a list of fractions and map each 9 | # numerator to the ratio of the common denominator over the original denominator. 10 | 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | use ntheory qw(lcm); 16 | use Math::AnyNum qw(:overload); 17 | 18 | my @fractions = ( 19 | 19 / 6, 20 | 160 / 51, 21 | 1744 / 555, 22 | 644 / 205, 23 | 2529 / 805, 24 | ); 25 | 26 | my $common_den = lcm(map { $_->denominator } @fractions); 27 | 28 | my @numerators = map { 29 | $_->numerator * $common_den / $_->denominator 30 | } @fractions; 31 | 32 | say "=> Numerators:"; 33 | foreach my $n (@numerators) { say "\t$n" } 34 | 35 | say "\n=> Common denominator: $common_den"; 36 | -------------------------------------------------------------------------------- /Math/fraction_to_decimal_expansion.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 14 November 2017 5 | # https://github.com/trizen 6 | 7 | # Conversion of a fraction to a decimal-expansion with an arbitrary number of decimals, using Math::AnyNum. 8 | 9 | use 5.020; 10 | use warnings; 11 | 12 | use experimental qw(signatures); 13 | use Math::AnyNum qw(bernfrac ilog10); 14 | 15 | sub frac2dec ($x, $p = 32) { 16 | my $size = ilog10(abs($x)) + 1; 17 | $x->as_dec($size + $p); 18 | } 19 | 20 | my $n = bernfrac(60); 21 | 22 | say frac2dec($n); #=> -21399949257225333665810744765191097.39267415116172387457421830769266 23 | say frac2dec($n, 48); #=> -21399949257225333665810744765191097.392674151161723874574218307692659887265915822235 24 | -------------------------------------------------------------------------------- /Math/fractional_pi.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 10 May 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Calculate PI by computing the numerator and the denominator fraction that approaches the value of PI. 9 | # It's based on the continued fraction: n^2 / (2n+1) 10 | 11 | # See: https://oeis.org/A054766 12 | # https://oeis.org/A054765 13 | 14 | use 5.010; 15 | use strict; 16 | use warnings; 17 | 18 | use Memoize qw(memoize); 19 | use Math::AnyNum qw(:overload as_dec); 20 | 21 | no warnings 'recursion'; 22 | 23 | memoize('pi_nu'); 24 | memoize('pi_de'); 25 | 26 | sub pi_nu { 27 | my ($n) = @_; 28 | $n < 2 29 | ? ($n == 0 ? 1 : 0) 30 | : (2 * $n - 1) * pi_nu($n - 1) + ($n - 1)**2 * pi_nu($n - 2); 31 | } 32 | 33 | sub pi_de { 34 | my ($n) = @_; 35 | $n < 2 36 | ? $n 37 | : (2 * $n - 1) * pi_de($n - 1) + ($n - 1)**2 * pi_de($n - 2); 38 | } 39 | 40 | my $prec = 1000; 41 | my $pi = as_dec(4 / (1 + pi_nu($prec) / pi_de($prec)), int($prec / 1.32)); 42 | say $pi; 43 | -------------------------------------------------------------------------------- /Math/gamma_function.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 17 November 2015 6 | # Website: https://github.com/trizen 7 | 8 | # The gamma function implemented as an improper integral 9 | # See: https://en.wikipedia.org/wiki/Gamma_function 10 | 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | sub gamma { 16 | my ($n) = @_; 17 | 18 | my $sum = 0; 19 | for my $t (0 .. 1000) { 20 | $sum += $t**($n - 1) * exp(-$t); 21 | } 22 | 23 | return $sum; 24 | } 25 | 26 | for my $n (1 .. 20) { 27 | printf "gamma(%2d) = %.24f\n", $n, gamma($n); 28 | } 29 | -------------------------------------------------------------------------------- /Math/goldbach_conjecture_2n_prime.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 04 September 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Goldbach conjecture as the sum of two primes 9 | # with one prime being in the range of (n, 2n) 10 | 11 | # Proving that always there is a prime number between 12 | # n and 2n which can be added with a smaller prime 13 | # such as the sum is 2n, would prove the conjecture. 14 | 15 | use 5.010; 16 | use strict; 17 | use warnings; 18 | 19 | use List::Util qw(sum); 20 | use ntheory qw(random_prime is_prime); 21 | 22 | my $max = 10000; 23 | 24 | my @counts; 25 | foreach my $i (2 .. $max) { 26 | my $n = 2 * $i; 27 | 28 | my $count = 0; 29 | while (1) { 30 | ++$count; 31 | last if is_prime($n - random_prime($i, $n)); 32 | } 33 | 34 | push @counts, $count; 35 | } 36 | 37 | say "Expected: ", log($max) / 2; 38 | say "Observed: ", sum(@counts) / @counts; 39 | 40 | __END__ 41 | -------------------------- 42 | Example for max=1000000 43 | -------------------------- 44 | Expected: 6.90775527898214 45 | Observed: 6.66289466289466 46 | -------------------------------------------------------------------------------- /Math/golomb_s_sequence.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 29 November 2016 5 | # https://github.com/trizen 6 | 7 | # A recursive function that represents the Golomb's sequence. 8 | 9 | # See also: 10 | # https://oeis.org/A001462 11 | # https://projecteuler.net/problem=341 12 | # https://en.wikipedia.org/wiki/Golomb_sequence 13 | 14 | use 5.020; 15 | use strict; 16 | use warnings; 17 | 18 | no warnings qw(recursion); 19 | 20 | use experimental qw(signatures); 21 | use Memoize qw(memoize); 22 | 23 | memoize('G'); # this will save time 24 | 25 | sub G($n) { 26 | $n == 1 ? 1 : 1 + G($n - G(G($n - 1))); 27 | } 28 | 29 | say "G(1000) = ", G(1000); 30 | -------------------------------------------------------------------------------- /Math/greatest_common_unitary_divisor.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # Date: 13 September 2023 5 | # https://github.com/trizen 6 | 7 | # Efficient algorithm for finding the greatest common unitary divisor of a list of integers. 8 | 9 | use 5.036; 10 | use ntheory qw(:all); 11 | 12 | sub gcud (@list) { 13 | 14 | my $g = gcd(@list); 15 | 16 | foreach my $n (@list) { 17 | next if ($n == 0); 18 | while (1) { 19 | my $t = gcd($g, divint($n, $g)); 20 | last if ($t == 1); 21 | $g = divint($g, $t); 22 | } 23 | last if ($g == 1); 24 | } 25 | 26 | return $g; 27 | } 28 | 29 | say gcud(); #=> 0 30 | say gcud(2); #=> 2 31 | say gcud(10, 20); #=> 5 32 | say gcud(factorial(9), 5040); #=> 35 33 | say gcud(factorial(9), 5040, 120); #=> 5 34 | say gcud(factorial(9), 5040, 0, 120); #=> 5 35 | say gcud(factorial(9), 5040, 1234); #=> 1 36 | -------------------------------------------------------------------------------- /Math/hamming_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Generate the generalized Hamming numbers below a certain limit, given a set of primes. 4 | 5 | use 5.020; 6 | use warnings; 7 | use experimental qw(signatures); 8 | 9 | sub hamming_numbers ($limit, $primes) { 10 | 11 | my @h = (1); 12 | foreach my $p (@$primes) { 13 | foreach my $n (@h) { 14 | if ($n * $p <= $limit) { 15 | push @h, $n * $p; 16 | } 17 | } 18 | } 19 | 20 | return \@h; 21 | } 22 | 23 | # Example: 5-smooth numbers below 100 24 | my $h = hamming_numbers(100, [2, 3, 5]); 25 | say join(', ', sort { $a <=> $b } @$h); 26 | -------------------------------------------------------------------------------- /Math/harmonic_numbers_from_powers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 29 July 2017 6 | # https://github.com/trizen 7 | 8 | # A high-level algorithm implementation for computing the nth-harmonic number, using perfect powers. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Math::AnyNum qw(:overload idiv); 15 | 16 | sub harmonic_numbers_from_powers { 17 | my ($n) = @_; 18 | 19 | my @seen; 20 | my $harm = $n <= 0 ? 0 : 1; 21 | 22 | foreach my $k (2 .. $n) { 23 | if (not exists $seen[$k]) { 24 | 25 | my $p = $k; 26 | 27 | do { 28 | $seen[$p] = undef; 29 | } while (($p *= $k) <= $n); 30 | 31 | my $g = idiv($p, $k); 32 | my $t = idiv($g - 1, $k - 1); 33 | 34 | $harm += $t / $g; 35 | } 36 | } 37 | 38 | return $harm; 39 | } 40 | 41 | foreach my $i (0 .. 30) { 42 | printf "%20s / %-20s\n", harmonic_numbers_from_powers($i)->nude; 43 | } 44 | -------------------------------------------------------------------------------- /Math/inverse_of_fibonacci.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Find the position of a Fibonacci number in the Fibonacci sequence. 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Fibonacci_number#Recognizing_Fibonacci_numbers 7 | 8 | use 5.020; 9 | use strict; 10 | use warnings; 11 | 12 | use experimental qw(signatures); 13 | use Math::AnyNum qw(:overload fibonacci is_square isqrt phi); 14 | 15 | sub fibonacci_inverse ($n) { 16 | 17 | my $m = 5 * $n * $n; 18 | 19 | if (is_square($m - 4)) { 20 | $m = isqrt($m - 4); 21 | } 22 | elsif (is_square($m + 4)) { 23 | $m = isqrt($m + 4); 24 | } 25 | else { 26 | return -1; # not a Fibonacci number 27 | } 28 | 29 | log(($n * sqrt(5) + $m) / 2) / log(phi); 30 | } 31 | 32 | say fibonacci_inverse(fibonacci(100)); #=> 100 33 | say fibonacci_inverse(fibonacci(101)); #=> 101 34 | -------------------------------------------------------------------------------- /Math/is_absolute_euler_pseudoprime.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Check if a given number is an absolute Euler pseudoprime. 4 | 5 | # These are composite n such that abs(a^((n-1)/2) mod n) = 1 for all a with gcd(a,n) = 1. 6 | 7 | # See also: 8 | # https://oeis.org/A033181 -- Absolute Euler pseudoprimes 9 | # https://en.wikipedia.org/wiki/Euler_pseudoprime 10 | 11 | use 5.014; 12 | use ntheory qw(:all); 13 | use experimental qw(signatures); 14 | 15 | sub is_absolute_euler_pseudoprime ($n) { 16 | is_carmichael($n) 17 | and vecall { (($n-1)>>1) % ($_-1) == 0 } factor($n); 18 | } 19 | 20 | foroddcomposites { 21 | say $_ if is_absolute_euler_pseudoprime($_); 22 | } 1e6; 23 | -------------------------------------------------------------------------------- /Math/is_perfect_power.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Algorithm for testing if a given number `n` is a perfect 4 | # power (i.e. can be expressed as: n = a^k with k > 1). 5 | 6 | # The value of k is returned when n is an exact k-th power, 1 otherwise. 7 | 8 | # Algorithm presented in the book: 9 | # 10 | # Modern Computer Arithmetic 11 | # - by Richard P. Brent and Paul Zimmermann 12 | # 13 | use 5.010; 14 | use strict; 15 | use warnings; 16 | 17 | use ntheory qw(logint rootint powint); 18 | use experimental qw(signatures); 19 | 20 | sub is_perfect_power ($n) { 21 | 22 | for (my $k = logint($n, 2) ; $k >= 2 ; --$k) { 23 | if (powint(rootint($n, $k), $k) == $n) { 24 | return $k; 25 | } 26 | } 27 | 28 | return 1; 29 | } 30 | 31 | say is_perfect_power(powint(1234, 14)); #=> 14 32 | -------------------------------------------------------------------------------- /Math/is_sum_of_two_cubes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Determine if a given integer can be represented as a sum of two nonnegative cubes. 4 | 5 | # See also: 6 | # https://oeis.org/A004999 -- Sums of two nonnegative cubes. 7 | # https://cs.uwaterloo.ca/journals/JIS/VOL6/Broughan/broughan25.pdf 8 | 9 | use 5.020; 10 | use warnings; 11 | 12 | use ntheory qw(:all); 13 | use experimental qw(signatures); 14 | 15 | sub is_sum_of_two_cubes($n) { 16 | 17 | my $L = rootint($n-1, 3) + 1; 18 | my $U = rootint(4*$n, 3); 19 | 20 | foreach my $m (divisors($n)) { 21 | if ($L <= $m and $m <= $U) { 22 | my $l = $m*$m - $n/$m; 23 | $l % 3 == 0 or next; 24 | $l /= 3; 25 | is_square($m*$m - 4*$l) && return 1; 26 | } 27 | } 28 | 29 | return; 30 | } 31 | 32 | foreach my $n (1 .. 1000) { 33 | if (is_sum_of_two_cubes($n)) { 34 | print($n, ", "); 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /Math/is_sum_of_two_squares.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 10 May 2016 5 | # https://github.com/trizen 6 | 7 | # Determine if a given number can be written as the sum of two squares. 8 | 9 | # See also: 10 | # https://wstein.org/edu/Fall2001/124/lectures/lecture21/lecture21/node2.html 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | use ntheory qw(factor_exp is_prime); 17 | 18 | sub is_sum_of_2_squares { 19 | my ($n) = @_; 20 | 21 | if (is_prime($n)) { 22 | return 1 if $n == 2; 23 | return $n % 4 == 1; 24 | } 25 | 26 | foreach my $p (factor_exp($n)) { 27 | $p->[0] % 4 == 3 28 | and $p->[1] % 2 != 0 29 | and return 0; 30 | } 31 | 32 | return 1; 33 | } 34 | 35 | for my $i (0 .. 50) { 36 | if (is_sum_of_2_squares($i)) { 37 | say $i; 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /Math/karatsuba_multiplication.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # A simple implementation of the Karatsuba multiplication. 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Karatsuba_algorithm 7 | 8 | use 5.020; 9 | use strict; 10 | use warnings; 11 | 12 | use experimental qw(signatures); 13 | 14 | use Math::AnyNum qw(:overload); 15 | use Math::AnyNum qw(divmod); 16 | 17 | sub karatsuba_multiplication ($x, $y, $n = 8) { 18 | 19 | if ($n <= 1) { 20 | return $x * $y; 21 | } 22 | 23 | my $m = ($n % 2 == 0) ? ($n >> 1) : (($n >> 1) + 1); 24 | 25 | my ($a, $b) = divmod($x, 1 << $m); 26 | my ($c, $d) = divmod($y, 1 << $m); 27 | 28 | my $e = __SUB__->($a, $c, $m); 29 | my $f = __SUB__->($b, $d, $m); 30 | my $g = __SUB__->($a - $b, $c - $d, $m); 31 | 32 | ($e << (2*$m)) + (($e + $f - $g) << $m) + $f; 33 | } 34 | 35 | say karatsuba_multiplication(122, 422); # 122 * 422 = 51484 36 | -------------------------------------------------------------------------------- /Math/lambert_W_function.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 27 December 2016 5 | # https://github.com/trizen 6 | 7 | # A simple implementation of Lambert's W function. 8 | 9 | # Example: x^x = 100 10 | # x = exp(lambert_w(log(100))) 11 | # x =~ 3.5972850235404... 12 | 13 | # See also: 14 | # https://en.wikipedia.org/wiki/Lambert_W_function 15 | 16 | use 5.010; 17 | use strict; 18 | use warnings; 19 | 20 | use Math::AnyNum qw(:overload approx_cmp); 21 | 22 | sub lambert_w { 23 | my ($c) = @_; 24 | 25 | my $x = sqrt($c) + 1; 26 | my $y = 0; 27 | 28 | while (approx_cmp(abs($x - $y), 0)) { 29 | $y = $x; 30 | $x = ($x + $c) / (1 + log($x)); 31 | } 32 | 33 | log($x); 34 | } 35 | 36 | say exp(lambert_w(log(100))); # 3.59728502354041750549765225178228606913554305489 37 | say exp(lambert_w(log(-100))); # 3.70202936660214594290193962952737102802777010583+1.34823128471151901327831464969872480416292147614i 38 | -------------------------------------------------------------------------------- /Math/length_of_shortest_addition_chain.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 17 August 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Length of shortest addition chain for n. 9 | # Equivalently, the minimal number of multiplications required to compute n-th power. 10 | 11 | # See also: https://oeis.org/A003313 12 | # https://projecteuler.net/problem=122 13 | 14 | # (this algorithm is not efficient for n >= 35) 15 | 16 | use 5.010; 17 | use strict; 18 | use warnings; 19 | 20 | use List::Util qw(min); 21 | 22 | sub mk { 23 | my ($n, $k, $pos, @nums) = @_; 24 | 25 | return 'inf' if $n > $k; 26 | return 'inf' if $pos > $#nums; 27 | return $#nums if $n == $k; 28 | 29 | min( 30 | mk($n, $k, $pos + 1, @nums), 31 | mk($n + $nums[$pos], $k, $pos, @nums, $n + $nums[$pos]) 32 | ); 33 | } 34 | 35 | for my $k (1 .. 10) { 36 | my $r = mk(1, $k, 0, 1); 37 | say "mk($k) = ", $r; 38 | } 39 | -------------------------------------------------------------------------------- /Math/logarithmic_integral_asymptotic_formula.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Very good asymptotic formula for Li(x), due to Cesaro. 4 | 5 | use 5.010; 6 | use strict; 7 | use warnings; 8 | 9 | use ntheory qw(factorial); 10 | 11 | my $x = 1e9; 12 | 13 | my $sum = 0; 14 | foreach my $n (1 .. log($x)) { 15 | $sum += factorial($n - 1) * $x / log($x)**$n; 16 | } 17 | say $sum; #=> 50849234.742179 18 | -------------------------------------------------------------------------------- /Math/logarithmic_root.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 17 July 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Logarithmic root of n. 9 | 10 | # Solves c = x^x, where "c" is known. 11 | # (based on Newton's method for the nth-root) 12 | 13 | # Example: 100 = x^x 14 | # x = lgrt(100) 15 | # x =~ 3.59728502354042 16 | 17 | use 5.010; 18 | use strict; 19 | use warnings; 20 | 21 | use Math::AnyNum qw(:overload); 22 | 23 | sub lgrt { 24 | my ($c) = @_; 25 | 26 | my $p = 1 / 10**($Math::AnyNum::PREC >> 2); 27 | my $d = log($c); 28 | 29 | my $x = 1; 30 | my $y = 0; 31 | 32 | while (abs($x - $y) > $p) { 33 | $y = $x; 34 | $x = ($x + $d) / (1 + log($x)); 35 | } 36 | 37 | $x; 38 | } 39 | 40 | say lgrt( 100); # 3.59728502354041750549765225178228606913554305489 41 | say lgrt(-100); # 3.70202936660214594290193962952737102802777010583+1.34823128471151901327831464969872480416292147614i 42 | -------------------------------------------------------------------------------- /Math/long_division.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 24 December 2012 6 | # https://github.com/trizen 7 | 8 | # Long division with arbitrary precision. 9 | 10 | use 5.016; 11 | use strict; 12 | use warnings; 13 | 14 | sub divide ($$$) { 15 | my ($x, $y, $f, $z) = @_; 16 | 17 | my $c = 0; 18 | sub { 19 | my $i = int($x / $y); 20 | 21 | $z .= $i; 22 | $x -= $y * $i; 23 | 24 | my $s = -1; 25 | until ($x >= $y) { $x *= 10; ++$s; $x || last } 26 | 27 | $z .= '.' if !$c; 28 | $z .= '0' x $s; 29 | $c += $s + 1; 30 | 31 | __SUB__->() if $c <= $f; 32 | } 33 | ->(); 34 | 35 | return $z; 36 | } 37 | 38 | say divide(634, 212, 64); 39 | say divide(9, 379, 64); 40 | say divide(42.5, 232.7, 64); 41 | 42 | say divide(7246,8743,64); 43 | -------------------------------------------------------------------------------- /Math/lucas-carmichael_numbers_from_multiple.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 08 March 2023 5 | # https://github.com/trizen 6 | 7 | # Generate Lucas-Carmichael numbers from a given multiple. 8 | 9 | # See also: 10 | # https://trizenx.blogspot.com/2020/08/pseudoprimes-construction-methods-and.html 11 | 12 | use 5.036; 13 | use Math::GMPz; 14 | use ntheory qw(:all); 15 | 16 | sub lucas_carmichael_from_multiple ($m, $callback) { 17 | 18 | is_square_free($m) || return; 19 | 20 | my $L = lcm(map { addint($_, 1) } factor($m)); 21 | my $v = mulmod(invmod($m, $L) // (return), -1, $L); 22 | 23 | for (my $p = $v ; ; $p += $L) { 24 | 25 | gcd($m, $p) == 1 or next; 26 | 27 | my @factors = factor_exp($p); 28 | (vecall { $_->[1] == 1 } @factors) || next; 29 | 30 | my $n = $m * $p; 31 | my $l = lcm(map { addint($_->[0], 1) } @factors); 32 | 33 | if (($n + 1) % $l == 0) { 34 | $callback->($n); 35 | } 36 | } 37 | } 38 | 39 | lucas_carmichael_from_multiple(11 * 17, sub ($n) { say $n }); 40 | -------------------------------------------------------------------------------- /Math/magic_3-gon_ring.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 08 August 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Solve a magic 3-gon ring. 9 | # See: https://projecteuler.net/problem=68 10 | 11 | use 5.014; 12 | use ntheory qw(forperm); 13 | 14 | my @nums = (1 .. 6); 15 | 16 | forperm { 17 | my @d = @nums[@_]; 18 | my $n = $d[0] + $d[1] + $d[2]; 19 | 20 | if ( $d[0] < $d[3] 21 | and $d[0] < $d[5] 22 | and $n == $d[3] + $d[2] + $d[4] 23 | and $n == $d[5] + $d[4] + $d[1]) { 24 | say "($d[0] $d[1] $d[2] | $d[3] $d[2] $d[4] | $d[5] $d[4] $d[1]) = $n"; 25 | } 26 | } scalar(@nums); 27 | -------------------------------------------------------------------------------- /Math/map_num.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # License: GPLv3 5 | # Date: 08th October 2013 6 | # https://trizenx.blogspot.com 7 | 8 | # Map an amount of numbers in a given interval 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | sub map_num { 15 | my ($amount, $from, $to) = @_; 16 | 17 | my $diff = $to - $from; 18 | my $step = $diff / $amount; 19 | 20 | return if $step == 0; 21 | 22 | my @nums; 23 | for (my $i = $from ; $i <= $to ; $i += $step) { 24 | push @nums, $i; 25 | } 26 | 27 | return @nums; 28 | } 29 | 30 | say join "\n", map_num(10, 4, 5); 31 | -------------------------------------------------------------------------------- /Math/maximum_square_remainder.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 31 August 2016 6 | # https://github.com/trizen 7 | 8 | # Find the maximum remainder of (a-1)^n + (a+1)^n when divided by a^2, for any positive integer n. 9 | 10 | # Example with a=7 and n=3: 11 | # 12 | # (7-1)^3 + (7+1)^3 = 42 (mod 7^2) 13 | # 14 | # In turns out that 42 is the maximum remainder when a=7. 15 | 16 | # See also: 17 | # https://oeis.org/A159469 18 | # https://projecteuler.net/problem=120 19 | 20 | use 5.020; 21 | use strict; 22 | use warnings; 23 | 24 | use experimental qw(signatures); 25 | 26 | sub max_square_remainder($n) { 27 | $n * ($n - (2 - ($n % 2))); 28 | } 29 | 30 | foreach my $n (3 .. 20) { 31 | say "R($n) = ", max_square_remainder($n); 32 | } 33 | 34 | __END__ 35 | R(3) = 6 36 | R(4) = 8 37 | R(5) = 20 38 | R(6) = 24 39 | R(7) = 42 40 | R(8) = 48 41 | R(9) = 72 42 | R(10) = 80 43 | R(11) = 110 44 | R(12) = 120 45 | R(13) = 156 46 | R(14) = 168 47 | R(15) = 210 48 | R(16) = 224 49 | R(17) = 272 50 | R(18) = 288 51 | R(19) = 342 52 | R(20) = 360 53 | -------------------------------------------------------------------------------- /Math/modular_bell_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # A fast algorithm for computing the n-th Bell number modulo a native integer. 4 | 5 | # See also: 6 | # https://oeis.org/A325630 -- Numbers k such that Bell(k) == 0 (mod k). 7 | # https://en.wikipedia.org/wiki/Bell_number 8 | 9 | use 5.020; 10 | use strict; 11 | use warnings; 12 | 13 | use Math::GMPz; 14 | use ntheory qw(addmod); 15 | use experimental qw(signatures); 16 | 17 | sub bell_number ($n, $m) { 18 | 19 | my @acc; 20 | 21 | my $t = 0; 22 | my $bell = 1; 23 | 24 | foreach my $k (1 .. $n) { 25 | 26 | $t = $bell; 27 | 28 | foreach my $j (@acc) { 29 | $t = addmod($t, $j, $m); 30 | $j = $t; 31 | } 32 | 33 | unshift @acc, $bell; 34 | $bell = $acc[-1]; 35 | } 36 | 37 | $bell; 38 | } 39 | 40 | say bell_number(35, 35); #=> 0 41 | say bell_number(35, 1234); #=> 852 42 | say bell_number(123, 4171); #=> 3567 43 | -------------------------------------------------------------------------------- /Math/modular_binomial.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 08 February 2017 6 | # Website: https://github.com/trizen 7 | 8 | # Algorithm for binomial(n, k) mod m. 9 | 10 | use 5.020; 11 | use strict; 12 | use warnings; 13 | 14 | use experimental qw(signatures); 15 | use ntheory qw(forprimes powmod vecsum todigits); 16 | 17 | sub factorial_power ($n, $p) { 18 | ($n - vecsum(todigits($n, $p))) / ($p - 1); 19 | } 20 | 21 | sub modular_binomial ($n, $k, $m) { 22 | 23 | my $j = $n - $k; 24 | my $prod = 1; 25 | 26 | forprimes { 27 | my $p = factorial_power($n, $_); 28 | 29 | if ($_ <= $k) { 30 | $p -= factorial_power($k, $_); 31 | } 32 | 33 | if ($_ <= $j) { 34 | $p -= factorial_power($j, $_); 35 | } 36 | 37 | if ($p > 0) { 38 | $prod *= ($p == 1) ? ($_ % $m) : powmod($_, $p, $m); 39 | $prod %= $m; 40 | } 41 | } $n; 42 | 43 | return $prod; 44 | } 45 | 46 | say modular_binomial(100, 50, 139); #=> 71 47 | say modular_binomial(124, 42, 1234567); #=> 395154 48 | -------------------------------------------------------------------------------- /Math/modular_binomial_ntheory.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 29 September 2017 5 | # https://github.com/trizen 6 | 7 | # Compute `binomial(n, k) % m`, using the `factorialmod(n, m)` function from ntheory. 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use ntheory qw(divmod factorialmod); 14 | 15 | sub modular_binomial { 16 | my ($n, $k, $m) = @_; 17 | divmod(divmod(factorialmod($n, $m), factorialmod($k, $m), $m), factorialmod($n - $k, $m), $m); 18 | } 19 | 20 | say modular_binomial(100, 50, 139); #=> 71 21 | say modular_binomial(124, 42, 1234567); #=> 395154 22 | -------------------------------------------------------------------------------- /Math/modular_fibonacci_anynum.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 19 June 2018 5 | # https://github.com/trizen 6 | 7 | # An efficient algorithm for computing the nth-Fibonacci number (mod m). 8 | 9 | use 5.020; 10 | use warnings; 11 | use experimental qw(signatures); 12 | use Math::AnyNum qw(:overload ilog2 getbit); 13 | 14 | sub fibonacci_number($n, $m) { 15 | 16 | my ($f, $g) = (0, 1); 17 | my ($a, $b) = (0, 1); 18 | 19 | foreach my $k (0 .. ilog2($n)||0) { 20 | ($f, $g) = (($f*$a + $g*$b)%$m, ($f*$b + $g*($a+$b))%$m) if getbit($n, $k); 21 | ($a, $b) = (($a*$a + $b*$b)%$m, ($a*$b + $b*($a+$b))%$m); 22 | } 23 | 24 | return $f; 25 | } 26 | 27 | # Last 20 digits of the 10^100-th Fibonacci number 28 | say fibonacci_number(10**100, 10**20); #=> 59183788299560546875 29 | -------------------------------------------------------------------------------- /Math/modular_inverse.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Algorithm for computing the modular inverse: 1/k mod n, with gcd(k, n) = 1. 4 | 5 | # Algorithm presented in the book: 6 | # 7 | # Modern Computer Arithmetic 8 | # - by Richard P. Brent and Paul Zimmermann 9 | # 10 | 11 | use 5.020; 12 | use strict; 13 | use warnings; 14 | 15 | use experimental qw(signatures); 16 | 17 | sub divmod ($n, $k) { 18 | (int($n / $k), $n % $k); 19 | } 20 | 21 | sub modular_inverse ($k, $n) { 22 | 23 | my ($u, $w) = (1, 0); 24 | my ($q, $r) = (0, 0); 25 | 26 | my $c = $n; 27 | 28 | while ($c != 0) { 29 | ($q, $r) = divmod($k, $c); 30 | ($k, $c) = ($c, $r); 31 | ($u, $w) = ($w, $u - $q*$w); 32 | } 33 | 34 | $u += $n if ($u < 0); 35 | 36 | return $u; 37 | } 38 | 39 | say modular_inverse(42, 2017); #=> 1969 40 | -------------------------------------------------------------------------------- /Math/multi_sqrt_nums.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | 5 | use 5.010; 6 | 7 | my $format = "%20s ** %-20s = %s\n"; 8 | 9 | for my $x (2 .. 10) { 10 | for my $y (2 .. 10) { 11 | my $num = $x**$y; 12 | 13 | printf($format, $x, $y, $num); 14 | 15 | my $sqrt = $num; 16 | for (1 .. $y - 1) { 17 | $sqrt = sqrt($sqrt); 18 | } 19 | my $pow = 2**int($y - 1) / $y; 20 | printf($format, $sqrt, $pow, $sqrt**$pow); 21 | say "-" x 80; 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /Math/multinomial_coefficient_from_binomial.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 04 February 2018 5 | # https://github.com/trizen 6 | 7 | # Identity for computing the multinomial coefficient using binomial coefficients. 8 | 9 | # See also: 10 | # https://mathworld.wolfram.com/MultinomialCoefficient.html 11 | # https://en.wikipedia.org/wiki/Multinomial_theorem 12 | 13 | use 5.020; 14 | use strict; 15 | use warnings; 16 | 17 | use experimental qw(signatures); 18 | use Math::AnyNum qw(:overload binomial); 19 | 20 | sub multinomial (@mset) { 21 | 22 | my $prod = 1; 23 | my $n = shift(@mset); 24 | 25 | foreach my $k (@mset) { 26 | $prod *= binomial($n += $k, $k); 27 | } 28 | 29 | return $prod; 30 | } 31 | 32 | say multinomial(7, 2, 5, 2, 12, 11); # 440981754363423854380800 33 | -------------------------------------------------------------------------------- /Math/multivariate_gamma_function.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 03 October 2017 5 | # https://github.com/trizen 6 | 7 | # A simple implementation of the multivariate gamma function. 8 | 9 | # See also: 10 | # https://en.wikipedia.org/wiki/Multivariate_gamma_function 11 | 12 | use 5.014; 13 | use warnings; 14 | 15 | use Math::AnyNum qw(pi gamma); 16 | 17 | sub multivariate_gamma { 18 | my ($n, $p) = @_; 19 | 20 | my $prod = 1; 21 | foreach my $j (1 .. $p) { 22 | $prod *= gamma($n + (1 - $j) / 2); 23 | } 24 | 25 | $prod * pi**($p * ($p - 1) / 4); 26 | } 27 | 28 | say multivariate_gamma(10, 5); # means: gamma_5(10) 29 | -------------------------------------------------------------------------------- /Math/newton_s_method.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 01 October 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Approximate nth-roots using Newton's method. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Math::AnyNum qw(:overload); 15 | 16 | sub nth_root { 17 | my ($n, $x) = @_; 18 | 19 | my $eps = 10**-($Math::AnyNum::PREC >> 2); 20 | 21 | my $r = 0.0; 22 | my $m = 1.0; 23 | 24 | while (abs($m - $r) > $eps) { 25 | $r = $m; 26 | $m = (($n - 1) * $r + $x / $r**($n - 1)) / $n; 27 | } 28 | 29 | $r; 30 | } 31 | 32 | say nth_root(2, 2); 33 | say nth_root(3, 125); 34 | say nth_root(7, 42**7); 35 | say nth_root(42, 987**42); 36 | -------------------------------------------------------------------------------- /Math/newton_s_method_recursive.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 18 July 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Newton's method -- recursive 9 | 10 | # x^(1/n) = f(k) ; with k -> infinity. 11 | 12 | # where f(k) is defined as: 13 | # | f(1) = 1 14 | # | f(k) = (f(k-1) * (n-1) + x / f(k-1)^(n-1)) / n 15 | 16 | # Alternatively, f(k) can be defined as: 17 | # | f(1) = 1 18 | # | f(k) = (1 - 1/n) * f(k-1) + x / (n * f(k-1)^(n-1)) 19 | 20 | use 5.016; 21 | 22 | sub nth_root { 23 | my ($n, $x, $k) = @_; 24 | 25 | my $p = $n - 1; 26 | 27 | sub { 28 | my $f = ( 29 | $_[0] > 1 30 | ? __SUB__->($_[0] - 1) 31 | : return 1 32 | ); 33 | 34 | ($f * $p + $x / $f**$p) / $n; 35 | } 36 | ->($k); 37 | } 38 | 39 | say nth_root(2, 2, 100); # square root of 2 40 | say nth_root(3, 27, 100); # third root of 27 41 | say nth_root(3, 125, 100); # third root of 125 42 | say nth_root(5, 3125, 100); # fifth root of 3125 43 | -------------------------------------------------------------------------------- /Math/next_power_of_two.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 25 December 2012 6 | # https://github.com/trizen 7 | 8 | sub next_power_of_two { 9 | return 2 << log($_[0]) / log(2); 10 | } 11 | 12 | for my $i (1, 31, 55, 129, 446, 9924) { 13 | print next_power_of_two($i), "\n"; 14 | } 15 | -------------------------------------------------------------------------------- /Math/nth_digit_of_fraction.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # An efficient formula for computing the n-th decimal digit of a given fraction expression x/y. 4 | 5 | # Formula from: 6 | # https://stackoverflow.com/questions/804934/getting-a-specific-digit-from-a-ratio-expansion-in-any-base-nth-digit-of-x-y 7 | 8 | # See also: 9 | # https://projecteuler.net/problem=820 10 | 11 | use 5.036; 12 | use ntheory qw(:all); 13 | 14 | sub nth_digit_of_fraction($n, $x, $y, $base = 10) { 15 | divint($base * powmod($base, $n - 1, $y) * $x, $y) % $base; 16 | } 17 | 18 | say vecsum(map { nth_digit_of_fraction(7, 1, $_) } 1 .. 7); #=> 10 19 | say vecsum(map { nth_digit_of_fraction(100, 1, $_) } 1 .. 100); #=> 418 20 | -------------------------------------------------------------------------------- /Math/nth_root_recurrence_constant.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 10 May 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Compute the nth root recurrence constant (n * (n * (n * (n * ...)^(1/4))^(1/3))^(1/2)) 9 | # See also: https://en.wikipedia.org/wiki/Somos%27_quadratic_recurrence_constant 10 | 11 | use 5.010; 12 | use strict; 13 | 14 | sub root_const { 15 | my ($n, $limit) = @_; 16 | $limit > 0 ? ($n * root_const($n+1, $limit-1))**(1/$n) : 1; 17 | } 18 | 19 | say root_const(1, 30000); 20 | -------------------------------------------------------------------------------- /Math/nth_smooth_number.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Generate the n-th smooth number that is the product of a given subset of primes. 4 | 5 | # See also: 6 | # https://en.wikipedia.org/wiki/Smooth_number 7 | 8 | use 5.020; 9 | use warnings; 10 | 11 | use ntheory qw(vecmin); 12 | use experimental qw(signatures); 13 | 14 | sub smooth_generator ($primes) { 15 | 16 | my @s = map { [1] } @$primes; 17 | 18 | sub { 19 | my $n = vecmin(map { $_->[0] } @s); 20 | 21 | for my $i (0..$#$primes) { 22 | shift(@{$s[$i]}) if ($s[$i][0] == $n); 23 | push(@{$s[$i]}, $n*$primes->[$i]); 24 | } 25 | return $n; 26 | }; 27 | } 28 | 29 | sub nth_smooth_number($n, $primes) { 30 | my $g = smooth_generator($primes); 31 | $g->() for (1..$n-1); 32 | $g->(); 33 | } 34 | 35 | say nth_smooth_number( 12, [2,7,13,19]); 36 | say nth_smooth_number( 25, [2,5,7,11,13,23,29,31,53,67,71,73,79,89,97,107,113,127,131,137]); 37 | say nth_smooth_number(500, [7,19,29,37,41,47,53,59,61,79,83,89,101,103,109,127,131,137,139,157,167,179,181,199,211,229,233,239,241,251]); 38 | -------------------------------------------------------------------------------- /Math/number_of_partitions_into_2_distinct_positive_squares.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Count the number of partitions of n into 2 distinct nonzero squares. 4 | 5 | # See also: 6 | # https://oeis.org/A025441 7 | # https://mathworld.wolfram.com/SumofSquaresFunction.html 8 | # https://en.wikipedia.org/wiki/Fermat%27s_theorem_on_sums_of_two_squares 9 | 10 | use 5.020; 11 | use warnings; 12 | use experimental qw(signatures); 13 | 14 | use ntheory qw(:all); 15 | 16 | # Number of solutions to `n = a^2 + b^2, with 0 < a < b. 17 | sub r2_positive_distinct ($n) { 18 | 19 | my $B = 1; 20 | 21 | foreach my $p (factor_exp($n)) { 22 | 23 | my $r = $p->[0] % 4; 24 | 25 | if ($r == 3) { 26 | $p->[1] % 2 == 0 or return 0; 27 | } 28 | 29 | if ($r == 1) { 30 | $B *= $p->[1] + 1; 31 | } 32 | } 33 | 34 | return ($B >> 1); 35 | } 36 | 37 | foreach my $n(1..100) { 38 | print(r2_positive_distinct($n), ", "); 39 | } 40 | -------------------------------------------------------------------------------- /Math/pascal_s_triangle_multiples.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 29 November 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Pascal's triangle with the multiples of a given integer highlighted. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use ntheory qw(binomial); 15 | use Term::ANSIColor qw(colored); 16 | 17 | my $div = 3; # highlight multiples of this integer 18 | my $size = 80; # the size of the triangle 19 | 20 | sub pascal { 21 | my ($rows) = @_; 22 | 23 | for my $n (1 .. $rows - 1) { 24 | say ' ' x ($rows - $n), join "", 25 | map { $_ % $div == 0 ? colored('.', 'red') : '*' } 26 | map { binomial(2*$n, $_) } 0 .. 2*$n; 27 | } 28 | } 29 | 30 | pascal(int($size / 2)); 31 | -------------------------------------------------------------------------------- /Math/pollard_rho_factorization.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Simple implementation of Pollard's rho integer factorization algorithm. 4 | 5 | # See also: 6 | # https://facthacks.cr.yp.to/rho.html 7 | # https://en.wikipedia.org/wiki/Pollard%27s_rho_algorithm 8 | 9 | use 5.020; 10 | use strict; 11 | use warnings; 12 | 13 | use experimental qw(signatures); 14 | use Math::AnyNum qw(:overload powmod gcd); 15 | 16 | sub rho_factor ($n, $tries = 50000) { 17 | 18 | my sub f($x) { 19 | powmod($x, 2, $n) + 1; 20 | } 21 | 22 | my $x = f(2); 23 | my $y = f($x); 24 | 25 | for (1 .. $tries) { 26 | 27 | $x = f($x); 28 | $y = f(f($y)); 29 | 30 | my $g = gcd($x - $y, $n); 31 | 32 | $g <= 1 and next; 33 | $g >= $n and last; 34 | 35 | return $g; 36 | } 37 | 38 | return 1; 39 | } 40 | 41 | say rho_factor(503 * 863); #=> 863 42 | say rho_factor(33670570905491953); #=> 36169843 43 | say rho_factor(314159265358979323); #=> 317213509 44 | say rho_factor(242363923520394591022973); #=> 786757556719 45 | -------------------------------------------------------------------------------- /Math/power_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 17 August 2021 5 | # https://github.com/trizen 6 | 7 | # Generate all the k-th power divisors of a given number. 8 | 9 | use 5.036; 10 | use ntheory qw(:all); 11 | 12 | sub power_divisors ($n, $k=1) { 13 | 14 | my @d = (1); 15 | my @pp = grep { $_->[1] >= $k } factor_exp($n); 16 | 17 | foreach my $pp (@pp) { 18 | my ($p, $e) = @$pp; 19 | 20 | my @t; 21 | for (my $i = $k ; $i <= $e ; $i += $k) { 22 | my $u = powint($p, $i); 23 | push @t, map { mulint($_, $u) } @d; 24 | } 25 | 26 | push @d, @t; 27 | } 28 | 29 | sort { $a <=> $b } @d; 30 | } 31 | 32 | say join(', ', power_divisors(3628800, 2)); # square divisors 33 | say join(', ', power_divisors(3628800, 3)); # cube divisors 34 | say join(', ', power_divisors(3628800, 4)); # 4th power divisors 35 | -------------------------------------------------------------------------------- /Math/power_of_factorial_ramanujan.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 15 November 2017 5 | # https://github.com/trizen 6 | 7 | # Given a prime `p` and number `n`, the highest power of `p` dividing `n!` equals: 8 | # N = Sum_{k>=1} floor(n/p^k) 9 | 10 | # In his third notebook, Ramanujan wrote the following inequalities: 11 | # n/(p-1) - log(n+1)/log(p) <= N <= (n-1)/(p-1) 12 | 13 | # By writing `n` in base `p` (n = Sum_{j=0..m} (b_j * p^j), we can see that: 14 | # N = (n - Sum_{j=0..m} b_j) / (p-1) 15 | 16 | use 5.020; 17 | use strict; 18 | use warnings; 19 | 20 | use ntheory qw(todigits vecsum); 21 | use experimental qw(signatures); 22 | 23 | sub power_of_factorial_ramanujan ($n, $p) { 24 | ($n - vecsum(todigits($n, $p))) / ($p - 1); 25 | } 26 | 27 | say power_of_factorial_ramanujan(100, 2); #=> 97 28 | say power_of_factorial_ramanujan(100, 3); #=> 48 29 | 30 | say power_of_factorial_ramanujan(123456, 7); #=> 20573 31 | say power_of_factorial_ramanujan(123456, 127); #=> 979 32 | -------------------------------------------------------------------------------- /Math/power_unitary_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # Date: 13 September 2023 5 | # https://github.com/trizen 6 | 7 | # Generate the k-th power unitary divisors of n. 8 | 9 | # See also: 10 | # https://oeis.org/A056624 11 | 12 | use 5.036; 13 | use ntheory qw(:all); 14 | 15 | sub power_udivisors ($n, $k = 1) { 16 | 17 | my @d = (1); 18 | 19 | foreach my $pp (factor_exp($n)) { 20 | my ($p, $e) = @$pp; 21 | 22 | if ($e % $k == 0) { 23 | my $u = powint($p, $e); 24 | push @d, map { mulint($_, $u) } @d; 25 | } 26 | } 27 | 28 | sort { $a <=> $b } @d; 29 | } 30 | 31 | say join(', ', power_udivisors(3628800, 1)); # unitary divisors 32 | say join(', ', power_udivisors(3628800, 2)); # square unitary divisors 33 | say join(', ', power_udivisors(3628800, 3)); # cube unitary divisors 34 | say join(', ', power_udivisors(3628800, 4)); # 4th power unitary divisors 35 | 36 | __END__ 37 | 1, 7, 25, 81, 175, 256, 567, 1792, 2025, 6400, 14175, 20736, 44800, 145152, 518400, 3628800 38 | 1, 25, 81, 256, 2025, 6400, 20736, 518400 39 | 1 40 | 1, 81, 256, 20736 41 | -------------------------------------------------------------------------------- /Math/powerfree_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # Date: 13 September 2023 5 | # https://github.com/trizen 6 | 7 | # Generate the k-powerfree divisors of a given number. 8 | 9 | # See also: 10 | # https://oeis.org/A048250 11 | 12 | use 5.036; 13 | use ntheory qw(:all); 14 | 15 | sub powerfree_divisors ($n, $k = 2) { 16 | 17 | my @d = (1); 18 | 19 | foreach my $pp (factor_exp($n)) { 20 | my ($p, $e) = @$pp; 21 | 22 | $e = vecmin($e, $k - 1); 23 | 24 | my @t; 25 | my $r = 1; 26 | for (1 .. $e) { 27 | $r = mulint($r, $p); 28 | push @t, map { mulint($r, $_) } @d; 29 | } 30 | push @d, @t; 31 | } 32 | 33 | return sort { $a <=> $b } @d; 34 | } 35 | 36 | say join(', ', powerfree_divisors(5040, 2)); # squarefree divisors 37 | say join(', ', powerfree_divisors(5040, 3)); # cubefree divisors 38 | 39 | __END__ 40 | 1, 2, 3, 5, 6, 7, 10, 14, 15, 21, 30, 35, 42, 70, 105, 210 41 | 1, 2, 3, 4, 5, 6, 7, 9, 10, 12, 14, 15, 18, 20, 21, 28, 30, 35, 36, 42, 45, 60, 63, 70, 84, 90, 105, 126, 140, 180, 210, 252, 315, 420, 630, 1260 42 | -------------------------------------------------------------------------------- /Math/powers_of_primes_in_factorial.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 25 August 2016 6 | # Website: https://github.com/trizen 7 | 8 | # A simple function that returns the power of a given prime in the factorial of a number. 9 | 10 | # For example: 11 | # 12 | # factorial_power(100, 3) = 48 13 | # 14 | # because 100! contains 48 factors of 3. 15 | 16 | use 5.010; 17 | use strict; 18 | use warnings; 19 | 20 | sub factorial_power { 21 | my ($n, $p) = @_; 22 | 23 | my $count = 0; 24 | my $ppow = $p; 25 | 26 | while ($ppow <= $n) { 27 | $count += int($n / $ppow); 28 | $ppow *= $p; 29 | } 30 | 31 | return $count; 32 | } 33 | 34 | say factorial_power(100, 3); #=> 48 35 | -------------------------------------------------------------------------------- /Math/prime_count_smooth_sum.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 25 October 2016 6 | # Website: https://github.com/trizen 7 | 8 | # sum(PI(n) - PI(n - sqrt(n)), {n=1, k}) 9 | 10 | # Interestingly, 11 | # 12 | # PI(n) - PI(n - sqrt(n)) = 0 13 | # 14 | # only for n={1, 125, 126}, tested with n <= 10^6. 15 | 16 | use 5.010; 17 | use strict; 18 | use warnings; 19 | 20 | use ntheory qw(prime_count); 21 | 22 | my $limit = shift(@ARGV) || 20; 23 | 24 | my $sum = 0; 25 | foreach my $n (1 .. $limit) { 26 | my $count = prime_count($n) - prime_count(int($n - sqrt($n))); 27 | $sum += $count; 28 | say $sum; 29 | } 30 | 31 | __END__ 32 | 0 33 | 1 34 | 3 35 | 4 36 | 6 37 | 7 38 | 9 39 | 10 40 | 11 41 | 12 42 | 13 43 | 14 44 | 16 45 | 18 46 | 19 47 | 20 48 | 22 49 | 23 50 | 25 51 | 27 52 | -------------------------------------------------------------------------------- /Math/prime_factors_of_binomial_coefficients.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 25 August 2016 6 | # Website: https://github.com/trizen 7 | 8 | # An efficient algorithm for prime factorization of binomial coefficients. 9 | 10 | use 5.020; 11 | use strict; 12 | use warnings; 13 | 14 | use experimental qw(signatures); 15 | use ntheory qw(forprimes todigits vecsum); 16 | 17 | sub factorial_power ($n, $p) { 18 | ($n - vecsum(todigits($n, $p))) / ($p - 1); 19 | } 20 | 21 | # 22 | # Example for: 23 | # binomial(100, 50) 24 | # 25 | # which is equivalent with: 26 | # 100! / (100-50)! / 50! 27 | # 28 | 29 | my $n = 100; 30 | my $k = 50; 31 | my $j = $n - $k; 32 | 33 | my @factors; 34 | 35 | forprimes { 36 | my $p = factorial_power($n, $_); 37 | 38 | if ($_ <= $k) { 39 | $p -= factorial_power($k, $_); 40 | } 41 | 42 | if ($_ <= $j) { 43 | $p -= factorial_power($j, $_); 44 | } 45 | 46 | if ($p > 0) { 47 | push @factors, ($_) x $p; 48 | } 49 | } $n; 50 | 51 | say "Prime factors of binomial($n, $k) = (@factors)"; 52 | -------------------------------------------------------------------------------- /Math/prime_formulas.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 03 July 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Generate a top list of prime formulas (in the form of: n^2 - n ± m) 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use ntheory qw(is_prime); 15 | 16 | my %top; 17 | my $n_limit = 1e4; 18 | my $m_limit = 1e2; 19 | 20 | for (my $m = 1 ; $m <= $m_limit ; $m += 2) { 21 | foreach my $n (0 .. $n_limit) { 22 | is_prime($n**2 - $n + $m) && ++$top{$m}; 23 | is_prime(abs($n**2 - $n - $m)) && ++$top{-$m}; 24 | } 25 | } 26 | 27 | foreach my $key (sort { $top{$b} <=> $top{$a} } keys %top) { 28 | printf("[%5d] n^2 - n %s %s\n", $top{$key}, $key > 0 ? ('+', $key) : ('-', abs($key))); 29 | } 30 | -------------------------------------------------------------------------------- /Math/prime_numbers_generator.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.014; 4 | 5 | OUTER: for (my $i = 3 ; ; $i += 2) { 6 | foreach my $j (2 .. sqrt($i)) { 7 | $i % $j || next OUTER; 8 | } 9 | say $i; 10 | } 11 | -------------------------------------------------------------------------------- /Math/prime_summation.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 28 October 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Count how many times an even number can be written as the sum of two or more sub-primes 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | no warnings 'recursion'; 15 | 16 | use ntheory qw(primes); 17 | use Memoize qw(memoize); 18 | 19 | my $limit = 1000; 20 | my $primes = primes(0, $limit); 21 | 22 | my %primes; 23 | @primes{@{$primes}} = (); 24 | 25 | sub sum_prime { 26 | my ($n) = @_; 27 | 28 | my $sum = 0; 29 | foreach my $prime (@{$primes}) { 30 | last if ($prime > ($n / 2)); 31 | my $diff = $n - $prime; 32 | if (exists $primes{$diff}) { 33 | $sum += 1 + sum_prime($diff); 34 | } 35 | } 36 | 37 | $sum; 38 | } 39 | 40 | memoize('sum_prime'); # cache the function to improve performance 41 | 42 | for (my $i = 2 ; $i <= $limit ; $i += 2) { 43 | say "$i\t", sum_prime($i); 44 | } 45 | -------------------------------------------------------------------------------- /Math/prime_zeta.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 16 November 2015 6 | # Website: https://github.com/trizen 7 | 8 | # zeta(s) = sum(1 / k^s) from k=1 to Infinity 9 | # zeta(s) = product(1 / (1 - prime(k)^(-s))) from k=1 to Infinity 10 | 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | use ntheory qw(nth_prime); 16 | 17 | sub prime_zeta { 18 | my ($s) = @_; 19 | 20 | my $p = 1; 21 | for my $i (1 .. 10000) { 22 | $p *= 1 / (1 - 1 / nth_prime($i)**$s); 23 | } 24 | return $p; 25 | } 26 | 27 | say sqrt(prime_zeta(2) * 6); 28 | -------------------------------------------------------------------------------- /Math/primes_sum_of_pair_product.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 07 April 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Sum of product of pair of primes that differ by a given constant. 9 | # ∞ 10 | # --- 11 | # \ 1 1 12 | # / --- * --- 13 | # --- p p+c 14 | # p 15 | # p+c 16 | 17 | use 5.010; 18 | use strict; 19 | 20 | use ntheory qw(is_prime forprimes); 21 | 22 | my $C = 2; # 2 is for twin primes 23 | my $j = 0; 24 | my $S = 0.0; 25 | 26 | forprimes { 27 | is_prime($j = $_ + $C) && ( 28 | $S += 1 / ($_ * $j) 29 | ); 30 | } 1, 1000000000; 31 | 32 | say $S; 33 | -------------------------------------------------------------------------------- /Math/ramanujan_sum_fast.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Efficient implementation of Ramanujan's sum. 4 | 5 | use 5.010; 6 | use strict; 7 | use warnings; 8 | 9 | use ntheory qw(gcd euler_phi moebius); 10 | 11 | sub ramanujan_sum { 12 | my ($n, $k) = @_; 13 | 14 | my $g = $k / gcd($n, $k); 15 | my $m = moebius($g); 16 | 17 | $m * euler_phi($k) / euler_phi($g); 18 | } 19 | 20 | foreach my $n (1 .. 30) { 21 | say ramanujan_sum($n, $n**2); 22 | } 23 | -------------------------------------------------------------------------------- /Math/random_carmichael_fibonacci_pseudoprimes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Generate random Carmichael numbers of the form: 4 | # `n = p * (2*p - 1) * (3*p - 2) * (6*p - 5)`. 5 | 6 | # About half of this numbers are also Fibonacci pseudoprimes, satisfying: 7 | # `Fibonacci(n - kronecker(n, 5)) = 0 (mod n)`. 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use Math::GMPz; 14 | use ntheory qw(is_prob_prime random_nbit_prime); 15 | 16 | my $bits = 50; # bits of p 17 | 18 | foreach my $n (1 .. 1e6) { 19 | my $p = Math::GMPz->new(random_nbit_prime($bits)); 20 | 21 | if (is_prob_prime(2 * $p - 1) && is_prob_prime(3 * $p - 2) && is_prob_prime(6 * $p - 5)) { 22 | say $p * ($p * 2 - 1) * ($p * 3 - 2) * ($p * 6 - 5); 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /Math/random_integer_factorization.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 19 May 2017 6 | # https://github.com/trizen 7 | 8 | # A very simple random integer factorization algorithm. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use ntheory qw(random_prime); 15 | 16 | my $n = 1355533 * 3672541; 17 | my $r = int(sqrt($n)); 18 | 19 | my $x = $r; 20 | my $y = $r; 21 | 22 | while (1) { 23 | my $p = $x * $y; 24 | 25 | last if $p == $n; 26 | 27 | $x = random_prime(2, $r); 28 | $y = int($n / $x); 29 | } 30 | 31 | say "$n = $x * $y"; 32 | -------------------------------------------------------------------------------- /Math/random_miller-rabin_pseudoprimes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Generate random probable Miller-Rabin pseudoprimes of the form: 4 | # 5 | # `n = p * (2*p - 1)` 6 | # 7 | # where `2*p - 1` is also prime. 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use Math::GMPz; 14 | use ntheory qw(:all); 15 | 16 | my @bases = (2, 3, 5); # Miller-Rabin pseudoprimes to these bases 17 | my $bits = 50; # bits of p 18 | 19 | foreach my $n (1 .. 1e6) { 20 | my $p = Math::GMPz->new(random_nbit_prime($bits)); 21 | 22 | if (is_prob_prime(2 * $p - 1)) { 23 | my $n = $p * ($p * 2 - 1); 24 | 25 | if (is_strong_pseudoprime($n, @bases)) { 26 | say $n; 27 | } 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /Math/range_map.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Map a given value from a given range into another range. 4 | 5 | use 5.010; 6 | use strict; 7 | use warnings; 8 | 9 | sub range_map { 10 | my ($value, $in_min, $in_max, $out_min, $out_max) = @_; 11 | ($value - $in_min) * ($out_max - $out_min) / ($in_max - $in_min) + $out_min; 12 | } 13 | 14 | say range_map(5, 1, 10, 0, 4); #=> 1.777... (maps the value 5 from range [1, 10] to range [0, 4]) 15 | say range_map(9, 1, 10, 1, 5); #=> 4.555... (maps the value 9 from range [1, 10] to range [1, 5]) 16 | -------------------------------------------------------------------------------- /Math/rational_prime_product.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 17 June 2017 6 | # https://github.com/trizen 7 | 8 | # Prime product, related to the zeta function. 9 | 10 | # ___ 11 | # | | (p^(2n) - 1) / (p^(2n) + 1) = {2/5, 6/7, 691/715, 7234/7293, 523833/524875, ...} 12 | # p 13 | 14 | # Example: 15 | # Product_{n >= 1} (prime(n)^2 - 1)/(prime(n)^2 + 1) = 2/5 16 | 17 | use 5.010; 18 | use strict; 19 | use warnings; 20 | 21 | use ntheory qw(forprimes); 22 | 23 | my $n = 2; 24 | 25 | { 26 | my $prod = 1; 27 | forprimes { 28 | $prod *= ($_**$n + 1) / ($_**$n - 1); 29 | } 1e7; 30 | 31 | say $prod; 32 | } 33 | 34 | { 35 | my $prod = 1; 36 | forprimes { 37 | $prod *= ($_**$n + 1) / ($_**$n - 1); 38 | } 1e8; 39 | 40 | say $prod; 41 | say 1 / $prod; 42 | } 43 | 44 | __END__ 45 | 2.49999997066443 46 | 2.49999999690776 47 | 0.400000000494758 48 | -------------------------------------------------------------------------------- /Math/rectangle_sides_from_area_and_diagonal.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 22 January 2018 5 | # https://github.com/trizen 6 | 7 | # Formula for finding the length of the sides of a rectangle 8 | # when only its area and the length of its diagonal are known. 9 | 10 | # See also: 11 | # https://en.wikipedia.org/wiki/Fermat%27s_factorization_method 12 | 13 | use 5.010; 14 | use strict; 15 | use warnings; 16 | 17 | sub extract_rectangle_sides { 18 | my ($n, $h) = @_; 19 | 20 | my $s = (2 * $n + $h); 21 | 22 | my $x = sqrt($s - 4 * $n) / 2; 23 | my $y = sqrt($s) / 2; 24 | 25 | return ($y - $x, $x + $y); 26 | } 27 | 28 | my $p = 43; 29 | my $q = 97; 30 | 31 | my $n = $p * $q; # rectangle area 32 | my $h = $p**2 + $q**2; # diagonal length, squared 33 | 34 | say join(' ', extract_rectangle_sides($n, $h)); 35 | -------------------------------------------------------------------------------- /Math/rectangle_sides_from_one_diagonal_angle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 22 January 2018 5 | # https://github.com/trizen 6 | 7 | # Formula for finding the smallest integer sides of a rectangle, given one internal angle of its diagonal. 8 | 9 | use 5.020; 10 | use strict; 11 | use warnings; 12 | 13 | use experimental qw(signatures); 14 | use Math::AnyNum qw(:trig :overload); 15 | 16 | sub rectangle_sides_from_angle ($theta) { 17 | tan($theta)->rat_approx->nude; 18 | } 19 | 20 | my $x = 43; # side 1 21 | my $y = 97; # side 2 22 | 23 | my $theta = atan2($x, $y); 24 | 25 | say "A rectangle internal diagonal angle:"; 26 | say ' ', rad2deg($theta); #=> 23.9076604941725008122467915166209997324000412946 27 | 28 | say "\nThe smallest integer sides matching the internal angle:"; 29 | say join(' ', rectangle_sides_from_angle($theta)); #=> 43 97 30 | -------------------------------------------------------------------------------- /Math/rest_calc.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 14 January 2013 6 | # https://github.com/trizen 7 | 8 | # Calculates how to give back some amount of money. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | my @steps = (500, 200, 100, 50, 10, 5, 1, 0.5, 0.1, 0.05, 0.01); 15 | 16 | my $rest = shift // 9999.99; 17 | 18 | foreach my $i (@steps) { 19 | my $x = 0; 20 | while ($rest >= $i) { 21 | ++$x; 22 | $rest -= $i; 23 | } 24 | if ($x) { 25 | say "$x x $i"; 26 | last if $rest == 0; 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /Math/reversed_number_triangle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 26 July 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Generate a "reversed" number triangle. 9 | 10 | my $rows = 6; 11 | my @arr = ([1]); 12 | 13 | my $n = 1; 14 | foreach my $i (1 .. $rows) { 15 | 16 | foreach my $j (reverse 0 .. $#arr) { 17 | push @{$arr[$j]}, ++$n; 18 | unshift @{$arr[$j]}, ++$n; 19 | } 20 | 21 | unshift @arr, [++$n]; 22 | } 23 | 24 | foreach my $row (@arr) { 25 | print " " x (3 * $rows--); 26 | print map { sprintf "%3d", $_ } @{$row}; 27 | print "\n"; 28 | } 29 | -------------------------------------------------------------------------------- /Math/riemann_s_J_function.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Riemann's J function 4 | # J(x) = Σ 1/k π(⌊x^(1/k)⌋) 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use ntheory qw(prime_count); 10 | 11 | sub J { 12 | my ($x) = @_; 13 | 14 | my $sum = 0; 15 | 16 | my $k = 1; 17 | while (1) { 18 | my $pi = prime_count(int($x**(1 / $k))); 19 | last if $pi == 0; 20 | $sum += 1 / $k++ * $pi; 21 | } 22 | 23 | $sum; 24 | } 25 | 26 | foreach my $k (1 .. 99) { 27 | printf("J(%2d) = %s\n", $k, J($k)); 28 | } 29 | -------------------------------------------------------------------------------- /Math/secant_numbers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Algorithm for computing the secant numbers (also known as Euler numbers): 4 | # 5 | # 1, 1, 5, 61, 1385, 50521, 2702765, 199360981, 19391512145, 2404879675441, 370371188237525, ... 6 | # 7 | 8 | # Algorithm presented in the book: 9 | # 10 | # Modern Computer Arithmetic 11 | # - by Richard P. Brent and Paul Zimmermann 12 | # 13 | 14 | # See also: 15 | # https://oeis.org/A000364 16 | # https://en.wikipedia.org/wiki/Euler_number 17 | 18 | use 5.010; 19 | use strict; 20 | use warnings; 21 | 22 | use Math::GMPz; 23 | 24 | sub secant_numbers { 25 | my ($n) = @_; 26 | 27 | my @S = (Math::GMPz::Rmpz_init_set_ui(1)); 28 | 29 | foreach my $k (1 .. $n) { 30 | Math::GMPz::Rmpz_mul_ui($S[$k] = Math::GMPz::Rmpz_init(), $S[$k - 1], $k); 31 | } 32 | 33 | foreach my $k (1 .. $n) { 34 | foreach my $j ($k + 1 .. $n) { 35 | Math::GMPz::Rmpz_addmul_ui($S[$j], $S[$j - 1], ($j - $k + 2) * ($j - $k)); 36 | } 37 | } 38 | 39 | return @S; 40 | } 41 | 42 | say join(', ', secant_numbers(10)); 43 | -------------------------------------------------------------------------------- /Math/sieve_of_eratosthenes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 18 May 2017 6 | # https://github.com/trizen 7 | 8 | # A simple implementation of the sieve of Eratosthenes for prime numbers. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | sub sieve_primes { 15 | my ($n) = @_; 16 | 17 | my @composite; 18 | foreach my $i (2 .. CORE::sqrt($n)) { 19 | if (!$composite[$i]) { 20 | for (my $j = $i**2 ; $j <= $n ; $j += $i) { 21 | $composite[$j] = 1; 22 | } 23 | } 24 | } 25 | 26 | my @primes; 27 | foreach my $p (2 .. $n) { 28 | $composite[$p] // push(@primes, $p); 29 | } 30 | 31 | return @primes; 32 | } 33 | 34 | my $n = shift(@ARGV) // 100; 35 | my @primes = sieve_primes($n); 36 | say join(' ', @primes); 37 | say "PI($n) = ", scalar(@primes); 38 | -------------------------------------------------------------------------------- /Math/sigma0_of_factorial.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 25 July 2017 5 | # https://github.com/trizen 6 | 7 | # An efficient algorithm for computing sigma0(n!). 8 | 9 | use 5.020; 10 | use strict; 11 | use warnings; 12 | 13 | use experimental qw(signatures); 14 | use ntheory qw(forprimes todigits vecsum); 15 | 16 | sub factorial_power ($n, $p) { 17 | ($n - vecsum(todigits($n, $p))) / ($p - 1); 18 | } 19 | 20 | sub sigma0_of_factorial { 21 | my ($n) = @_; 22 | 23 | my $sigma0 = 1; 24 | 25 | forprimes { 26 | $sigma0 *= 1 + factorial_power($n, $_); 27 | } $n; 28 | 29 | return $sigma0; 30 | } 31 | 32 | say sigma0_of_factorial(10); # 270 33 | say sigma0_of_factorial(100); # 39001250856960000 34 | -------------------------------------------------------------------------------- /Math/sigma_function.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 18 August 2017 5 | # https://github.com/trizen 6 | 7 | # Efficient implementation of the `sigma_k(n)` function, where k > 0. 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use ntheory qw(factor_exp); 14 | 15 | sub sigma { 16 | my ($n, $k) = @_; 17 | 18 | my $sigma = 1; 19 | 20 | foreach my $p (factor_exp($n)) { 21 | $sigma *= (($p->[0]**($k * ($p->[1] + 1)) - 1) / ($p->[0]**$k - 1)); 22 | } 23 | 24 | return $sigma; 25 | } 26 | 27 | say sigma(10, 1); #=> 18 28 | say sigma(100, 1); #=> 217 29 | say sigma(3628800, 2); #=> 20993420690550 30 | -------------------------------------------------------------------------------- /Math/sigma_of_factorial.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 25 July 2017 5 | # https://github.com/trizen 6 | 7 | # An efficient algorithm for computing sigma_k(n!), where k > 0. 8 | 9 | use 5.020; 10 | use strict; 11 | use warnings; 12 | 13 | use experimental qw(signatures); 14 | use ntheory qw(forprimes vecsum todigits); 15 | 16 | sub factorial_power ($n, $p) { 17 | ($n - vecsum(todigits($n, $p))) / ($p - 1); 18 | } 19 | 20 | sub sigma_of_factorial { 21 | my ($n, $a) = @_; 22 | 23 | my $sigma = 1; 24 | 25 | forprimes { 26 | my $p = $_; 27 | my $k = factorial_power($n, $p); 28 | $sigma *= (($p**($a * ($k + 1)) - 1) / ($p**$a - 1)); 29 | } $n; 30 | 31 | return $sigma; 32 | } 33 | 34 | say sigma_of_factorial(10, 1); # sigma_1(10!) = 15334088 35 | say sigma_of_factorial(10, 2); # sigma_2(10!) = 20993420690550 36 | say sigma_of_factorial( 8, 3); # sigma_3( 8!) = 78640578066960 37 | -------------------------------------------------------------------------------- /Math/smallest_number_with_at_least_n_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 15 May 2021 5 | # https://github.com/trizen 6 | 7 | # Generate the smallest number that has at least n divisors. 8 | 9 | # See also: 10 | # https://oeis.org/A061799 -- Smallest number with at least n divisors. 11 | 12 | use 5.020; 13 | use warnings; 14 | use experimental qw(signatures); 15 | 16 | use ntheory qw(nth_prime); 17 | use Math::AnyNum qw(:overload); 18 | 19 | sub smallest_number_with_at_least_n_divisors ($threshold, $least_solution = Inf, $k = 1, $max_a = Inf, $sigma0 = 1, $n = 1) { 20 | 21 | if ($sigma0 >= $threshold) { 22 | return $n; 23 | } 24 | 25 | my $p = nth_prime($k); 26 | 27 | for (my $a = 1 ; $a <= $max_a ; ++$a) { 28 | $n *= $p; 29 | last if ($n > $least_solution); 30 | $least_solution = __SUB__->($threshold, $least_solution, $k + 1, $a, $sigma0 * ($a + 1), $n); 31 | } 32 | 33 | return $least_solution; 34 | } 35 | 36 | say smallest_number_with_at_least_n_divisors(60); #=> 5040 37 | say smallest_number_with_at_least_n_divisors(1000); #=> 245044800 38 | -------------------------------------------------------------------------------- /Math/solve_congruence_equation_example.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # Date: 24 August 2016 5 | # License: GPLv3 6 | # Website: https://github.com/trizen 7 | 8 | # An example for how to solve a linear congruence equation. 9 | 10 | # Solving for x in: 11 | # (10^5)x + 19541 = 0 (mod 19543) 12 | # 13 | # which is equivalent with: 14 | # (10^5)x = -19541 (mod 19543) 15 | 16 | use 5.010; 17 | use strict; 18 | use warnings; 19 | 20 | use ntheory qw(invmod); 21 | 22 | my $k = 10**5; # coefficient of x 23 | my $r = -19541; # congruent to this 24 | my $m = 19543; # modulo this number 25 | 26 | say "x = ", (invmod($k, $m) * $r) % $m; 27 | -------------------------------------------------------------------------------- /Math/sphere_volume.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | 5 | # OLD: V = (4/3) * PI * r^3 6 | # NEW: V = r^4 * PI / (r * 0.75) 7 | # 8 | # V = r^2 * PI * (r * 0.75^(-1)) 9 | # 0.75^(-1) = 1.33333 10 | # 11 | # r^2 * r = r^3 12 | # 1.33333 = 4/3 13 | # V = r^3 * PI * (4/3) 14 | 15 | use 5.010; 16 | 17 | say sprintf('%.32f', ($ARGV[0] || die "usage: $0 \n")**4 * atan2('inf', 0) * 2 / ($ARGV[0] * 0.75)) =~ /^(.+?\.\d+?)(?=0*$)/; 18 | -------------------------------------------------------------------------------- /Math/square_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 30 July 2018 5 | # https://github.com/trizen 6 | 7 | # Generate all the square divisors of a given number. 8 | 9 | use 5.036; 10 | use ntheory qw(:all); 11 | 12 | sub square_divisors($n) { 13 | 14 | my @d = (1); 15 | my @pp = grep { $_->[1] > 1 } factor_exp($n); 16 | 17 | foreach my $pp (@pp) { 18 | my ($p, $e) = @$pp; 19 | 20 | my @t; 21 | for (my $i = 2 ; $i <= $e ; $i += 2) { 22 | my $u = powint($p, $i); 23 | push @t, map { mulint($_, $u) } @d; 24 | } 25 | 26 | push @d, @t; 27 | } 28 | 29 | return sort { $a <=> $b } @d; 30 | } 31 | 32 | say join(', ', square_divisors(3628800)); 33 | -------------------------------------------------------------------------------- /Math/square_root_method.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 01 October 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Approximate the square root of a number. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use Math::AnyNum qw(:overload); 15 | 16 | sub square_root { 17 | my ($n) = @_; 18 | 19 | my $eps = 10**-($Math::AnyNum::PREC >> 2); 20 | 21 | my $m = $n; 22 | my $r = 0.0; 23 | 24 | while (abs($m - $r) > $eps) { 25 | $m = ($m + $r) / 2; 26 | $r = $n / $m; 27 | } 28 | 29 | $r; 30 | } 31 | 32 | say square_root(1234); 33 | -------------------------------------------------------------------------------- /Math/stern_brocot_sequence.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Coded by Trizen 4 | # Date: 14 May 2015 5 | # https://github.com/trizen 6 | 7 | use 5.010; 8 | use strict; 9 | use warnings; 10 | 11 | # Inspired from: https://www.youtube.com/watch?v=DpwUVExX27E 12 | 13 | # 14 | ## Create and return the sequence as an array 15 | # 16 | sub stern_brocot { 17 | my ($n) = @_; 18 | 19 | my @fib = (1, 1); 20 | foreach my $i (1 .. $n) { 21 | push @fib, $fib[$i] + $fib[$i - 1], $fib[$i]; 22 | } 23 | return @fib; 24 | } 25 | 26 | say join(" ", stern_brocot(15)); 27 | 28 | # 29 | ## Print the sequence as it is generated 30 | # 31 | sub stern_brocot_realtime(&$) { 32 | my ($callback, $n) = @_; 33 | 34 | my @fib = (1, 1); 35 | foreach my $i (1 .. $n) { 36 | push @fib, $fib[0] + $fib[1], $fib[1]; 37 | $callback->($fib[0]); 38 | shift @fib; 39 | } 40 | $callback->($_) for @fib; 41 | } 42 | 43 | { 44 | local $| = 1; 45 | my $i = 0; 46 | stern_brocot_realtime { 47 | my ($n) = @_; 48 | print "$n "; 49 | } 15; 50 | } 51 | print "\n"; 52 | -------------------------------------------------------------------------------- /Math/sum_factorial.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 13th October 2013 6 | # https://trizenx.blogspot.com 7 | 8 | # This script generates sums of consecutive numbers for factorial numbers. 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | sub sum_x { 15 | my ($x, $y, $z) = @_; 16 | ($x + $y) * (($y - $x) / $z + 1) / 2; 17 | } 18 | 19 | sub factorial { 20 | my ($n) = @_; 21 | 22 | my $fact = 1; 23 | $fact *= $_ for 2 .. $n; 24 | 25 | $fact; 26 | } 27 | 28 | foreach my $i (1 .. 9) { 29 | my $fact = factorial($i); 30 | 31 | O: for (my $o = 1 ; $o <= int sqrt($fact) ; $o++) { 32 | N: for (my $n = 1 ; $n <= $fact ; $n++) { 33 | M: for (my $m = $n ; $m <= $fact ; $m++) { 34 | 35 | my $sum = sum_x($n, $m, $o); 36 | 37 | if ($sum == $fact) { 38 | printf "%2d. %10d:%5d %10d .. %d\n", $i, $fact, $o, $n, $m; 39 | } 40 | } 41 | } 42 | 43 | last if $o >= 1; 44 | } 45 | 46 | say ''; 47 | } 48 | -------------------------------------------------------------------------------- /Math/sum_of_digits.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 12 May 2018 5 | # https://github.com/trizen 6 | 7 | # Two algorithms for computing the sum of the digits of an integer, in a given base. 8 | 9 | use 5.020; 10 | use strict; 11 | use warnings; 12 | 13 | use experimental qw(signatures); 14 | use Math::AnyNum qw(idiv divmod irand sumdigits ipow2); 15 | 16 | sub sumdigits_1 ($n, $k) { 17 | 18 | my $N = $n; 19 | my $S = 0; 20 | 21 | while ($n >= 1) { 22 | $n = idiv($n, $k); 23 | $S += $n; 24 | } 25 | 26 | return ($N - $S * ($k - 1)); 27 | } 28 | 29 | sub sumdigits_2 ($n, $k) { 30 | 31 | my $m = 0; 32 | my $S = 0; 33 | 34 | while ($n >= 1) { 35 | ($n, $m) = divmod($n, $k); 36 | $S += $m; 37 | } 38 | 39 | return $S; 40 | } 41 | 42 | my $n = irand(2, ipow2(100000)); 43 | my $k = irand(2, 1000); 44 | 45 | say sumdigits($n, $k); # provided by Math::AnyNum 46 | say sumdigits_1($n, $k); 47 | say sumdigits_2($n, $k); 48 | -------------------------------------------------------------------------------- /Math/sum_of_natural_powers_in_constant_base.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 17 September 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Sum of increasing powers in constant base. 9 | 10 | # Example: 11 | # ∑b^i for 0 ≤ i ≤ n == cf(b, n) 12 | # 13 | # where `b` can be any real number != 1. 14 | 15 | use 5.010; 16 | use strict; 17 | use warnings; 18 | 19 | sub cf { 20 | my ($base, $n) = @_; 21 | ($base ** ($n+1) - 1) / ($base-1); 22 | } 23 | 24 | say cf(3, 13); 25 | say cf(-10.5, 4); 26 | say cf(3.1415926535897932384626433832795, 10); 27 | -------------------------------------------------------------------------------- /Math/sum_of_the_number_of_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 18 August 2017 5 | # https://github.com/trizen 6 | 7 | # Sum of the number of divisors, `d(k)`, for 1 <= k <= n. 8 | 9 | # Formula with O(sqrt(n)) complexity: 10 | # Sum_{k=1..n} d(k) = (2 * Sum_{k=1..floor(sqrt(n))} floor(n/k)) - floor(sqrt(n))^2 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | sub sum_of_sigma0 { 17 | my ($n) = @_; 18 | 19 | my $s = int(sqrt($n)); 20 | 21 | my $sum = 0; 22 | foreach my $k (1 .. $s) { 23 | $sum += int($n / $k); 24 | } 25 | 26 | $sum *= 2; 27 | $sum -= $s**2; 28 | 29 | return $sum; 30 | } 31 | 32 | say sum_of_sigma0(100); #=> 482 33 | say sum_of_sigma0(1234); #=> 8979 34 | say sum_of_sigma0(98765); #=> 1151076 35 | -------------------------------------------------------------------------------- /Math/sum_of_the_sum_of_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 19 August 2017 5 | # https://github.com/trizen 6 | 7 | # Sum of the sum of divisors, `sigma(k)`, for 1 <= k <= n. 8 | 9 | # Algorithm due to Peter Polm (August 18, 2014) (see: A024916). 10 | 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | sub sum_of_sigma { 16 | my ($n) = @_; 17 | 18 | my $s = 0; 19 | my $d = 1; 20 | my $q = $n; 21 | 22 | for (; $d < $q ; ++$d, $q = int($n / $d)) { 23 | $s += $q * (2 * $d + $q + 1) >> 1; 24 | } 25 | 26 | $s - $d * ($d * ($d - 1) >> 1) + ($q * ($q + 1) >> 1); 27 | } 28 | 29 | say sum_of_sigma(13); #=> 141 30 | say sum_of_sigma(64); #=> 3403 31 | say sum_of_sigma(1234); #=> 1252881 32 | say sum_of_sigma(10**8); #=> 8224670422194237 33 | -------------------------------------------------------------------------------- /Math/sum_of_two_primes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 20 August 2015 6 | # Website: https://github.com/trizen 7 | 8 | # This script counts the numbers which CANNOT be written as the sum of two primes 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | use ntheory qw(primes); 15 | 16 | my $primes = primes(10000); 17 | unshift @{$primes}, 1; # consider 1 as being prime 18 | 19 | my %seen; 20 | for my $i (0 .. $#{$primes}) { 21 | for my $j ($i .. $#{$primes}) { 22 | undef $seen{$primes->[$i] + $primes->[$j]}; 23 | } 24 | } 25 | 26 | my $count = 0; 27 | foreach my $n (1 .. 2 * $primes->[-1]) { 28 | exists($seen{$n}) || ++$count; 29 | } 30 | 31 | say "$count numbers, from a total of ", 2 * $primes->[-1], ", CANNOT be written as the sum of two primes."; 32 | 33 | __END__ 34 | 8772 numbers, from a total of 19946, CANNOT be written as the sum of two primes. 35 | -------------------------------------------------------------------------------- /Math/triangle_hyperoperation.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 16 October 2016 6 | # Website: https://github.com/trizen 7 | 8 | # Efficient implementation of the triangle hyperoperation, modulo some n. 9 | 10 | # For definition, see: 11 | # https://www.youtube.com/watch?v=sW_IkMQEAwo 12 | 13 | # See also: 14 | # https://www.youtube.com/watch?v=9DeOnCKfSuY 15 | 16 | use strict; 17 | use integer; 18 | use warnings; 19 | 20 | use ntheory qw(powmod forprimes); 21 | 22 | sub triangle { 23 | my ($n, $k, $mod) = @_; 24 | return $n if $k == 1; 25 | powmod($n, triangle($n, $k - 1, $mod), $mod); 26 | } 27 | 28 | # let z = triangle(10, 10) + 23 29 | # Question: what are the prime factors of z? 30 | 31 | forprimes { 32 | my $r = (triangle(10, 10, ${_}) + 23) % ${_}; 33 | print "$_ divides z\n" if $r == 0; 34 | } 1e5; 35 | -------------------------------------------------------------------------------- /Math/triangle_interior_angles.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 22 January 2018 5 | # https://github.com/trizen 6 | 7 | # Formula for finding the interior angles of a triangle, given its side lengths. 8 | 9 | use 5.010; 10 | use strict; 11 | use warnings; 12 | 13 | use Math::AnyNum qw(acos rad2deg); 14 | 15 | my $x = 3; 16 | my $y = 4; 17 | my $z = 5; 18 | 19 | say rad2deg(acos(($y**2 + $z**2 - $x**2) / (2 * $y * $z))); # 36.869... 20 | say rad2deg(acos(($x**2 - $y**2 + $z**2) / (2 * $x * $z))); # 53.130... 21 | say rad2deg(acos(($x**2 + $y**2 - $z**2) / (2 * $x * $y))); # 90 22 | -------------------------------------------------------------------------------- /Math/trip2mars.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # License: GPLv3 5 | # Date: 15 October 2013 6 | # https://trizenx.blogspot.com 7 | 8 | # This program solves the "Trip to Mars" problem 9 | # See: https://www.youtube.com/watch?v=k-zrgRv9tFU 10 | 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | my %max = ( 16 | hours => 0, 17 | games => 0, 18 | movies => 0, 19 | ); 20 | 21 | foreach my $x (0 .. 200) { 22 | foreach my $y (0 .. 200 - $x) { 23 | 24 | next if 8 * $x + 3 * $y > 1200; 25 | next if 0.2 * $x + 0.8 * $y > 130; 26 | 27 | my $hours = 4 * $x + 2 * $y; 28 | 29 | if ($hours > $max{hours}) { 30 | $max{hours} = $hours; 31 | $max{games} = $x; 32 | $max{movies} = $y; 33 | } 34 | } 35 | } 36 | 37 | say "To maximize the time on breaks, you need to buy $max{games} games and $max{movies} movies."; 38 | -------------------------------------------------------------------------------- /Math/unitary_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 01 July 2018 5 | # https://github.com/trizen 6 | 7 | # A simple algorithm for generating the unitary divisors of a given number. 8 | 9 | # See also: 10 | # https://en.wikipedia.org/wiki/Unitary_divisor 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | use ntheory qw(forcomb factor_exp vecprod powint); 17 | 18 | # This algorithm nicely illustrates the identity: 19 | # 20 | # 2^n = Sum_{k=0..n} binomial(n, k) 21 | # 22 | # which is the number of divisors of a squarefree number that is the product of `n` primes. 23 | 24 | sub udivisors { 25 | my ($n) = @_; 26 | 27 | my @pp = map { powint($_->[0], $_->[1]) } factor_exp($n); 28 | my $len = scalar(@pp); 29 | 30 | my @d; 31 | foreach my $k (0 .. $len) { 32 | forcomb { 33 | push @d, vecprod(@pp[@_]); 34 | } $len, $k; 35 | } 36 | 37 | return sort { $a <=> $b } @d; 38 | } 39 | 40 | say join(' ', udivisors(5040)); 41 | -------------------------------------------------------------------------------- /Math/unitary_divisors_fast.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 01 July 2018 5 | # https://github.com/trizen 6 | 7 | # A simple algorithm for generating the unitary divisors of a given number. 8 | 9 | # See also: 10 | # https://en.wikipedia.org/wiki/Unitary_divisor 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | use ntheory qw(factor_exp powint mulint); 17 | 18 | sub udivisors { 19 | my ($n) = @_; 20 | 21 | my @d = (1); 22 | my @pp = map { powint($_->[0], $_->[1]) } factor_exp($n); 23 | 24 | foreach my $p (@pp) { 25 | push @d, map { mulint($_, $p) } @d; 26 | } 27 | 28 | return sort { $a <=> $b } @d; 29 | } 30 | 31 | say join(' ', udivisors(5040)); 32 | -------------------------------------------------------------------------------- /Math/unitary_squarefree_divisors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 27 June 2018 5 | # https://github.com/trizen 6 | 7 | # Generate the unitary squarefree divisors of a given number. 8 | 9 | # See also: 10 | # https://oeis.org/A092261 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | use ntheory qw(factor_exp); 17 | 18 | sub unitary_squarefree_divisors { 19 | my ($n) = @_; 20 | 21 | my @d = (1); 22 | my @pp = map { $_->[0] } grep { $_->[1] == 1 } factor_exp($n); 23 | 24 | foreach my $p (@pp) { 25 | push @d, map { $_ * $p } @d; 26 | } 27 | 28 | return sort { $a <=> $b } @d; 29 | } 30 | 31 | foreach my $n (1 .. 30) { 32 | my @d = unitary_squarefree_divisors($n); 33 | say "a($n) = [@d]"; 34 | } 35 | -------------------------------------------------------------------------------- /Math/wilson_prime_formula.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 27 September 2014 5 | # Edit: 15 May 2021 6 | # https://github.com/trizen 7 | 8 | # See also: 9 | # https://en.wikipedia.org/wiki/Wilson's_theorem 10 | 11 | use 5.020; 12 | use strict; 13 | use warnings; 14 | 15 | use Math::AnyNum qw(factorial); 16 | use experimental qw(signatures); 17 | 18 | sub is_wilson_prime($n) { 19 | factorial($n-1) % $n == $n-1; 20 | } 21 | 22 | for my $n (2..100) { 23 | if (is_wilson_prime($n)) { 24 | print($n, ", "); 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /Math/yahtzee.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # One-Roll Yahtzee Fever 4 | 5 | # https://www.youtube.com/watch?v=dXGhzY2p2ug 6 | 7 | my (@list) = (0) x 5; 8 | my $count = 0; 9 | 10 | do { 11 | foreach my $num (@list) { 12 | $num = int(rand 6) + 1; 13 | } 14 | ++$count; 15 | } until ((grep { $_ == $list[0] } @list) == @list); 16 | 17 | print "Rolls: $count\tNumber: $list[0]\n"; 18 | -------------------------------------------------------------------------------- /Math/zeta_for_primes.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 22 September 2015 6 | # Website: https://github.com/trizen 7 | 8 | # Zeta-prime formula 9 | # Sum of 1/P(n)^p 10 | # where P(n) is a prime number and p is a positive integer. 11 | 12 | use 5.010; 13 | use strict; 14 | use warnings; 15 | 16 | use ntheory qw(nth_prime); 17 | 18 | my @sums; 19 | foreach my $i (1 .. 100000) { 20 | foreach my $p (1 .. 10) { 21 | $sums[$p - 1] += 1 / nth_prime($i)**$p; 22 | } 23 | } 24 | 25 | foreach my $p (0 .. $#sums) { 26 | printf("zp(%d) = %s\n", $p + 1, $sums[$p]); 27 | } 28 | 29 | __END__ 30 | # 31 | ## From i=1..1000000 32 | # 33 | zp(1) = 3.06821904805445 34 | zp(2) = 0.452247416351722 35 | zp(3) = 0.174762639299271 36 | zp(4) = 0.0769931397642436 37 | zp(5) = 0.035755017483924 38 | zp(6) = 0.0170700868506365 39 | zp(7) = 0.00828383285613359 40 | zp(8) = 0.00406140536651783 41 | zp(9) = 0.00200446757496245 42 | zp(10) = 0.00099360357443698 43 | -------------------------------------------------------------------------------- /Math/zeta_function.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.010; 4 | use strict; 5 | use warnings; 6 | 7 | sub zeta { 8 | my ($n) = @_; 9 | my $sum = 0; 10 | 11 | foreach my $i (1 .. 1000000) { 12 | $sum += (1 / $i**$n); 13 | } 14 | 15 | $sum; 16 | } 17 | 18 | say zeta(2); 19 | -------------------------------------------------------------------------------- /Other/concatenation_weirdness.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Weird order of concatenation of variables, when the variables are mutated during concatenation. 4 | 5 | # In older versions of Perl, the first statement correctly returns "abc". 6 | # In newer versions of Perl, both statements return incorrect values. 7 | 8 | use 5.010; 9 | use strict; 10 | use warnings; 11 | 12 | my $x = 'a'; 13 | my $y = 'b'; 14 | 15 | say ($x . $y . ++$y); #=> expected "abc", but got "acc" 16 | say ($x . ++$x); #=> expected "ab", but got "bb" 17 | -------------------------------------------------------------------------------- /Other/lexical_subs_recursion_bug.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Perl bug when using recursion in a `my sub {}` with a parent function. 4 | 5 | use 5.014; 6 | use strict; 7 | use warnings; 8 | 9 | # Discovered by catb0t: 10 | # https://github.com/catb0t/multifactor/commit/d2a8ad217704182f3b71557aa81a1a62f0ea2414 11 | 12 | sub factorial { 13 | my ($n) = @_; 14 | 15 | my sub my_func { 16 | my ($n) = @_; 17 | $n <= 1 ? 1 : $n * factorial($n - 1); 18 | } 19 | 20 | my_func($n); 21 | } 22 | 23 | say factorial(5); 24 | 25 | __END__ 26 | Can't undef active subroutine at bug.pl line 17. 27 | -------------------------------------------------------------------------------- /Other/tail_recursion.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 04 January 2017 6 | # https://github.com/trizen 7 | 8 | # A simple example for tail-recursion in Perl. 9 | 10 | use 5.016; 11 | use strict; 12 | use warnings; 13 | 14 | sub factorial { 15 | my ($n, $fac) = @_; 16 | return $fac if $n == 0; 17 | @_ = ($n-1, $n*$fac); 18 | goto __SUB__; 19 | } 20 | 21 | say factorial(5, 1); 22 | -------------------------------------------------------------------------------- /Other/yafu_factorization.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Factorize a given number, using the `YAFU` tool, and parse the output into an array of `Math::GMPz` objects. 4 | 5 | # See also: 6 | # https://sourceforge.net/projects/yafu/ 7 | 8 | use 5.020; 9 | use strict; 10 | use warnings; 11 | use Math::GMPz; 12 | 13 | use experimental qw(signatures); 14 | use File::Spec::Functions qw(rel2abs curdir tmpdir); 15 | 16 | sub yafu_factor ($n) { 17 | 18 | $n = Math::GMPz->new($n); # validate the number 19 | 20 | my $dir = rel2abs(curdir()); 21 | 22 | chdir(tmpdir()); 23 | my $output = qx(yafu 'factor($n)'); 24 | chdir($dir); 25 | 26 | my @factors; 27 | 28 | while ($output =~ /^P\d+ = (\d+)/mg) { 29 | push @factors, Math::GMPz->new($1); 30 | } 31 | 32 | return sort { $a <=> $b } @factors; 33 | } 34 | 35 | my $n = shift() || die "usage: $0 [n]\n"; 36 | 37 | my @factors = yafu_factor($n); 38 | say "$n = [", join(', ', @factors), ']'; 39 | -------------------------------------------------------------------------------- /Regex/positive-negative_matching.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 30 May 2013 6 | # https://github.com/trizen 7 | 8 | # Returns true in a positive check 9 | # if a string doesn't matches a regex. 10 | 11 | my $string = 'This is a TOP 10 string.'; 12 | 13 | if ($string =~ m{^(?(?{/top/i})(?!))}) { 14 | print "Doesn't contains the 'top' word.\n"; 15 | } 16 | else { 17 | print "Contains the 'top' word.\n"; 18 | } 19 | -------------------------------------------------------------------------------- /Regex/prime_regexp.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | $\ = "\n"; 4 | my $prime = 0; 5 | my $limit = shift() || 100; 6 | 7 | while ($prime++ < $limit) { 8 | $_ .= 0; 9 | 10 | print $prime if $prime > 1 and not /^(00+?)\1+$/; 11 | 12 | # How it works? 13 | # When length(${^MATCH}) is not equal to length($_), then is a prime number 14 | # Uncomment the following lines to see how it actually works... 15 | 16 | # if(/^(00+?)\1+$/p){ 17 | # print "number = $prime\ndolar1 = $1 (",length($1),")\n\$& = $& (",length(${^MATCH}),")\n\$_ = $_ (",length($_),")\n\n"; 18 | # }elsif(!/^(00+?)\1+$/p){ 19 | # print "number = $prime\ndolar1 = $1 (",length($1),")\n\$& = $& (",length(${^MATCH}),")\n\$_ = $_ (",length($_),")\n\n"; 20 | # } 21 | 22 | } 23 | -------------------------------------------------------------------------------- /Regex/regex_pair_factors.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 14 April 2014 6 | # Website: https://github.com/trizen 7 | 8 | # Get the pair factors for a number (using a regex) 9 | 10 | use 5.010; 11 | use strict; 12 | use warnings; 13 | 14 | my $prod = $ARGV[0] // 36; 15 | my $msg = 'a' x $prod; 16 | 17 | for my $i (2 .. $prod / 2) { 18 | for my $j ($i .. $prod / $i) { 19 | if ($msg =~ /^(?:a{$i}){$j}\z/) { 20 | say "$j * $i == $prod"; 21 | } 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /Search/binary_search.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # Date: 10 July 2019 5 | # https://github.com/trizen 6 | 7 | # The binary search algorithm. 8 | 9 | # See also: 10 | # https://en.wikipedia.org/wiki/Binary_search_algorithm 11 | 12 | use 5.020; 13 | use strict; 14 | use warnings; 15 | 16 | use experimental qw(signatures); 17 | 18 | sub bsearch ($left, $right, $callback) { 19 | 20 | while ($left <= $right) { 21 | 22 | my $mid = int(($left + $right) / 2); 23 | my $cmp = $callback->($mid) || return $mid; 24 | 25 | if ($cmp > 0) { 26 | $right = $mid - 1; 27 | } 28 | else { 29 | $left = $mid + 1; 30 | } 31 | } 32 | 33 | return undef; 34 | } 35 | 36 | say bsearch(0, 202, sub ($x) { $x * $x <=> 49 }); #=> 7 (7*7 = 49) 37 | say bsearch(3, 1000, sub ($x) { $x**$x <=> 3125 }); #=> 5 (5**5 = 3125) 38 | -------------------------------------------------------------------------------- /Subtitle/srt_fix.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Fix subtitles translated with Google Translate 4 | 5 | use strict; 6 | use warnings; 7 | 8 | use Tie::File; 9 | 10 | my $filename = shift(@ARGV); 11 | 12 | tie my @lines, 'Tie::File', $filename 13 | or die "Can't tie into file `$filename': $!"; 14 | 15 | for (@lines) { 16 | s/(?/-->/g; 17 | /\h-->\h/ 18 | ? do { 19 | s/[0-9]{2}\K:\h+(?=[0-9]{2})/:/g; 20 | } 21 | : do { 22 | s{(@cache); 22 | } 23 | 24 | return; 25 | } 26 | 27 | all_substrings("abcdefg", sub { say for @_ }); 28 | -------------------------------------------------------------------------------- /Text/levenshtein_distance_iter.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 12 December 2016 6 | # https://github.com/trizen 7 | 8 | # Levenshtein distance (iterative implementation). 9 | 10 | # See also: 11 | # https://en.wikipedia.org/wiki/Levenshtein_distance 12 | 13 | use 5.010; 14 | use strict; 15 | use warnings; 16 | 17 | use List::Util qw(min); 18 | 19 | sub leven { 20 | my ($s, $t) = @_; 21 | 22 | my $tl = length($t); 23 | my $sl = length($s); 24 | 25 | my @d = ([0 .. $tl], map { [$_] } 1 .. $sl); 26 | 27 | foreach my $i (0 .. $sl - 1) { 28 | foreach my $j (0 .. $tl - 1) { 29 | $d[$i + 1][$j + 1] = 30 | substr($s, $i, 1) eq substr($t, $j, 1) 31 | ? $d[$i][$j] 32 | : 1 + min($d[$i][$j + 1], $d[$i + 1][$j], $d[$i][$j]); 33 | } 34 | } 35 | 36 | $d[-1][-1]; 37 | } 38 | 39 | say leven('rosettacode', 'raisethysword'); 40 | -------------------------------------------------------------------------------- /Text/levenshtein_distance_rec.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 12 December 2016 6 | # https://github.com/trizen 7 | 8 | # Levenshtein distance (recursive implementation). 9 | 10 | # See also: 11 | # https://en.wikipedia.org/wiki/Levenshtein_distance 12 | 13 | use 5.010; 14 | use strict; 15 | use warnings; 16 | 17 | use List::Util qw(min); 18 | use Memoize qw(memoize); 19 | 20 | memoize('leven'); 21 | 22 | sub leven { 23 | my ($s, $t) = @_; 24 | 25 | return length($t) if $s eq ''; 26 | return length($s) if $t eq ''; 27 | 28 | my ($s1, $t1) = (substr($s, 1), substr($t, 1)); 29 | 30 | (substr($s, 0, 1) eq substr($t, 0, 1)) 31 | ? leven($s1, $t1) 32 | : min( 33 | leven($s1, $t1), 34 | leven($s, $t1), 35 | leven($s1, $t ), 36 | ) + 1; 37 | } 38 | 39 | say leven('rosettacode', 'raisethysword'); 40 | -------------------------------------------------------------------------------- /Text/orthogonal_text_scrambling.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 29 July 2017 6 | # https://github.com/trizen 7 | 8 | # An interesting text scrambling algorithm, invented by the author in ~2008. 9 | 10 | use utf8; 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | sub scramble { 16 | my ($str) = @_; 17 | 18 | my $i = length($str); 19 | $str =~ s/(.{$i})(.)/$2$1/sg while (--$i > 0); 20 | return $str; 21 | } 22 | 23 | sub unscramble { 24 | my ($str) = @_; 25 | 26 | my $i = 0; 27 | my $l = length($str); 28 | $str =~ s/(.)(.{$i})/$2$1/sg while (++$i < $l); 29 | return $str; 30 | } 31 | 32 | my $abc = "abcdefghijklmnopqrstuvwxyz"; 33 | 34 | say scramble($abc); #=> "fvjnabdsgrpzxqeholmictyuwk" 35 | say unscramble(scramble($abc)); #=> "abcdefghijklmnopqrstuvwxyz" 36 | -------------------------------------------------------------------------------- /Text/orthogonal_text_scrambling_double.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Daniel "Trizen" Șuteu 4 | # License: GPLv3 5 | # Date: 29 July 2017 6 | # https://github.com/trizen 7 | 8 | # An interesting text scrambling algorithm, invented by the author in ~2008. 9 | 10 | use utf8; 11 | use 5.010; 12 | use strict; 13 | use warnings; 14 | 15 | sub scramble { 16 | my ($str) = @_; 17 | 18 | my $i = my $l = length($str); 19 | 20 | $str =~ s/(.{$i})(.)/$2$1/sg while (--$i > 0); 21 | $str =~ s/(.{$i})(.)/$2$1/sg while (++$i < $l); 22 | 23 | return $str; 24 | } 25 | 26 | sub unscramble { 27 | my ($str) = @_; 28 | 29 | my $i = my $l = length($str); 30 | 31 | $str =~ s/(.)(.{$i})/$2$1/sg while (--$i > 0); 32 | $str =~ s/(.)(.{$i})/$2$1/sg while (++$i < $l); 33 | 34 | return $str; 35 | } 36 | 37 | my $abc = "abcdefghijklmnopqrstuvwxyz"; 38 | 39 | say scramble($abc); #=> "ckytmliqzrbjwuexhogpdsanvf" 40 | say unscramble(scramble($abc)); #=> "abcdefghijklmnopqrstuvwxyz" 41 | -------------------------------------------------------------------------------- /Visualisators/binview.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Author: Trizen 4 | # License: GPLv3 5 | # Date: 09 October 2013 6 | # https://trizenx.blogspot.com 7 | 8 | # Prints bits and bytes (or byte values) from a binary file. 9 | 10 | use 5.010; 11 | use strict; 12 | use autodie; 13 | use warnings; 14 | 15 | sub usage { 16 | print STDERR "usage: $0 file [cols]\n"; 17 | exit 1; 18 | } 19 | 20 | my $file = shift() // usage(); 21 | my $cols = shift() // 1; 22 | 23 | sysopen my $fh, $file, 0; 24 | while (sysread($fh, (my $chars), $cols) > 0) { 25 | foreach (split //, $chars) { 26 | printf "%10s%4s", unpack("B*"), /[[:print:]]/ ? $_ : sprintf("%03d", ord); 27 | } 28 | print "\n"; 29 | } 30 | close $fh; 31 | --------------------------------------------------------------------------------