スキップしてメイン コンテンツに移動

Project Euler - Problem 3

問題

  • 原文

    What is the largest prime factor of the number 600851475143 ?

  • 日本語訳

    600851475143 の素因数のうち最大のものを求めよ。

解答

いきなり難易度が上がりました。素因数分解の問題です。 結局のところ片っ端から割ってみるしかないのですが、探索範囲を狭めることはできます。

正の整数の範囲で考えると、l = m * nかつm >= nであれば、floor(sqrt(l)) >= nであることが直感的に分かります。ここでfloorは実数を0の方向に丸めて整数にする関数、sqrtは平方根を返す実数関数です。 nが分かれば、mは除算で求められます。つまりlが与えられた時、それを2つの因数に分解するのに探索する範囲は高々2 .. floor(sqrt(l))で十分ということです。 2つに分けられたならこっちのもの、得られたmとnを再帰的に分解して、その結果を合わせれば素因数分解の結果が得られます。 アルゴリズムを書き下すと次のようになります:

  1. n <- floor(sqrt(l))とする。
  2. n = 1なら、これ以上は分解できない(lは素数である)のでlをそのまま返す。
  3. nがlの因数なら、m <- l / nとし、mとnに対してこのアルゴリズムを再帰的に適用し、その結果を連結して返す。
  4. 因数でないなら、n <- n - 1とし、2.から繰り返す。

これで計算は可能です。しかしもう少し最適化を検討してみましょう。

偶数は一般に2mの形で表せます。同様に奇数は2m + 1と書けます。 偶数同士の積は2m * 2n = 4mnとなり、l = 2mnとおけば2lなのでこれも偶数です。 奇数同士の積は(2m + 1)(2n + 1) = 4mn + 2(m + n) + 1であり、l = 2mn + m + nとすると2l + 1なのでこれも奇数です。 偶数と奇数の積は2m(2n + 1) = 4mn + 2mなので、l = 2mn + mとおいて2lなので偶数です。 つまり、奇数の因数は必ず奇数のみから成るということが分かります。先ほどのアルゴリズムでは、4.のステップでn <- n - 1としていました。これではlとnが両方とも奇数の時、1回不要な繰り返しが生じることになります。つまりこの場合を特別扱いして、n <- n - 2とすれば繰り返しを減らすことができます。 幸い、問題で与えられた600851475143という数値は奇数なので、この最適化の恩恵を十分に受けることができます。

この最適化を施したところ、40%ほど高速化しました。上の考察におけるlはn、nはdivという名前になっています。

(define (divisor-of? n m) (zero? (modulo m n)))
(define (factorize n)
  (define div (inexact->exact (floor (sqrt n))))
  (define (factorize-1 n div)
    (cond
     ((= div 1) (list n))
     ((and (odd? n) (even? div)) (factorize-1 n (- div 1)))
     ((divisor-of? div n) (append (factorize (/ n div)) (factorize div)))
     ((odd? n) (factorize-1 n (- div 2)))
     (else (factorize-1 n (- div 1)))))
  (factorize-1 n div))
(define (solve)
  (apply max (factorize 600851475143)))
(define (main argv)
  (display (solve))
  (newline))

追記

コメントの匿名氏のコードを基にしたところ500倍高速になりました。よって上記の議論は忘れて手続き的に書いた方が良さげ。 多値を扱うのにSRFI-8のreceiveマクロを使っています。

(define (divisor-of? m n) (zero? (modulo n m)))
(define (factorize n)
  (define (factorize-1 n i result)
    (cond
     ((< n (* i i)) (reverse (if (= n 1) result (cons n result))))
     ((divisor-of? i n) (factorize-1 (/ n i) i (cons i result)))
     (else (factorize-1 n (+ i 2) result))))
  (receive (n result)
           (let prepare-loop ((n n) (result '()))
             (if (divisor-of? 2 n) (prepare-loop (/ n 2) (cons 2 result))
                 (values n result)))
           (factorize-1 n 3 result)))
(define (solve)
  (apply max (factorize 600851475143)))
(define (main argv)
  (display (solve))
  (newline))

コメント

  1. (define factorize
       (lambda (n)
     
          (define result '()
     
          (define check
             (lambda (n i)
                (let loop ([n n] [c 0])
                   (if [zero? (remainder n i)]
                         (loop (/ n i) (+ c 1))
                         (begin
                            (if [> c 0] (set! result (cons (cons i c) result)))
                            n)))))
     
          (let loop ([n (check n 2)] [i 3])
             (cond
                ([= n 1] (reverse result))
                ([> (* i i) n] (reverse (cons (cons n 1) result)))
                (else (loop (check n i) (+ i 2)))))))
     
    (caar (reverse (factorize 600851475143)))

    返信削除
  2. 速い!当社比400倍ですね。
    checkが何をしているのか少し悩みました。乗数をカウントして連想リストにしているのか。
    副作用を使ったコードは避けたいのですが、ここまで違うと参るなあ。参考にさせてもらいます。

    返信削除

コメントを投稿

このブログの人気の投稿

Perl 5 to 6 - コンテキスト

2011-02-27: コメント欄で既に改訂された仕様の指摘がありました ので一部補足しました。 id:uasi に感謝します。 これはMoritz Lenz氏のWebサイト Perlgeek.de で公開されているブログ記事 "Perl 5 to 6" Lesson 06 - Contexts の日本語訳です。 原文は Creative Commons Attribution 3.0 Germany に基づいて公開されています。 本エントリには Creative Commons Attribution 3.0 Unported を適用します。 Original text: Copyright© 2008-2010 Moritz Lenz Japanese translation: Copyright© 2011 SATOH Koichi NAME "Perl 5 to 6" Lesson 06 - コンテキスト SYNOPSIS my @a = <a b c> my $x = @a; say $x[2]; # c say (~2).WHAT # Str() say +@a; # 3 if @a < 10 { say "short array"; } DESCRIPTION 次のように書いたとき、 $x = @a Perl5では $x は @a より少ない情報—— @a の要素数だけ——しか持ちません。 すべての情報を保存しておくためには明示的にリファレンスを取る必要があります: $x = \@a Perl6ではこれらは反対になります: デフォルトでは何も失うことなく、スカラ変数は配列を単に格納します。 これは一般要素コンテキスト(Perl5で scalar と呼ばれていたもの)及びより特化された数値、整数、文字列コンテキストの導入によって可能となりました。無効コンテキストとリストコンテキストは変更されていません。 特別な構文でコンテキストを強制できます。 構文 コンテキスト ~stuff 文字列 ?stuff 真理値 +stuff ...

Perl 5 to 6 - ツイジル

これはMoritz Lenz氏のWebサイト Perlgeek.de で公開されているブログ記事 "Perl 5 to 6" Lesson 15 - Twigils の日本語訳です。 原文は Creative Commons Attribution 3.0 Germany に基づいて公開されています。 本エントリには Creative Commons Attribution 3.0 Unported を適用します。 Original text: Copyright© 2008-2010 Moritz Lenz Japanese translation: Copyright© 2011 SATOH Koichi NAME "Perl 5 to 6" Lesson 15 - ツイジル SYNOPSIS class Foo { has $.bar; has $!baz; } my @stuff = sort { $^b[1] <=> $^a[1]}, [1, 2], [0, 3], [4, 8]; my $block = { say "This is the named 'foo' parameter: $:foo" }; $block(:foo<bar>); say "This is file $?FILE on line $?LINE" say "A CGI script" if %*ENV.exists('DOCUMENT_ROOT'); DESCRIPTION いくつかの変数にはツイジルという第2のシジルがあります。これは基本的にはその変数が「普通」ではないということです。違いはいくつかあり、例えばスコープの違いなどです。 オブジェクトのパブリックな属性とプライベートな属性がそれぞれ . と ! というツイジルを持つことは既に紹介しました; それらは通常の変数ではなく self に結びつけられています。 ツイジル ^ はPerl5で例外的に扱われていたケースを一般化します。次のように書けます # 注意: Perl5のコードです sort ...

多分週刊チラシの裏 (Sep 28 - Oct 04, 2020)

Chrome Web Store が有料 Chrome 拡張の取扱を終了 Chrome Web Store で提供されている有料 Chrome 拡張及びアプリ内課金 API の両方が 2021 年 1 月いっぱいで廃止される。 開発者はそれまでに代替となるサードパーティの課金 API に移行し、購入済ライセンスの移行手段も用意する必要がある。 この決定の発表時点で新規の有料ないしアプリ内課金のある Chrome 拡張の新規登録は終了している。実際のところ 2020 年 3 月時点で既に「一時的に」停止されており、その措置が恒久化されただけとの由。 シェルスクリプティングには長いオプションを使え 「短いオプション (e.g., -x ) はコマンドライン上での略記である。スクリプトにおいては自分や将来の同僚のためにも長いオプション (e.g., ---do-something ) を与える方が理解が容易だろう」という主張。 異論の余地なく正論である。 CobWeb - COBOL to WebAssembly Compiler COBOL から WebAssembly へのコンパイラ。いやマジで。 Cloudflare が何を思ったか同社のサーバレス環境である Workers に COBOL 対応を追加した際 の成果物である。 COBOL から C へのトランスレータである GNU COBOL と C コードをコンパイルして WebAssembly を出力する Emscripten から成っており、他の言語に比べて軽量なバイナリを生成するとのこと。 「ウチではそんな風にはやらないんだ (“We don’t do that here”)」 昨今ソフトウェア開発のコミュニティでも Code of Conduct を用意するところが増えてきたが、コミュニティの文化を明文化するのは難しい。 長大な「べからず集」は息苦しいし、肯定的なガイドラインは時に抽象的で実効的に使えない。問題となるようなふるまいの動機が善意であった場合は特にそうだ。 仮に優れたガイドラインがあっても、それに基いて人を実際に咎めるのは骨が折れることである。初中やればコミュニティ内でも疎まれる。 話の分かる相手ならそれでもまだ説得する意義もあるが、Web 上の対話で当事者双方が納得し合っ...

LIBLINEAR 2.41 で One-class SVM が使えるようになったので Perl から触ってみよう

改訂 (Sep 15, 2020): 必要のない手順を含んでいたのでサンプルコードと記述を修正しました。 CPAN に Algorithm::LibLinear 0.22 がリリースされました (しました。) 高速な線形 SVM およびロジスティック回帰による複数の機械学習アルゴリズムを実装したライブラリである LIBLINEAR への Perl バインディングです。 利用している LIBLINEAR のバージョンが LIBLINEAR 2.30 から LIBLINEAR 2.41 に上がったことで新しいソルバが追加され、One-class SVM (OC-SVM) による一値分類が利用可能になっています (しました。) OC-SVM って何 一値分類を SVM でやること。 一値分類って何 ある値が学習したクラスに含まれるか否かを決定する問題。 HBO の「シリコンバレー」に出てきた「ホットドッグ」と「ホットドッグ以外」を識別するアプリが典型。「ホットドッグ以外」の方は犬でも神でも一つの指輪でも何でも含まれるのがミソ。 二値分類の場合正反両者のデータを集める必要があるのに対して、一値分類の学習器は正例データのみしか要求しない (ものが多い。) 主な用途は外れ値検出で、もちろんホットドッグやホットドッグ様のものを検出したりもできる。 使い方 手順自体は他の二値ないし多値分類問題と同じです。つまり、 訓練パラメータを決めて 訓練データセットで訓練して テストデータセットで確度を検証して 十分良くなったらモデルを保存する といういつもの流れ。 訓練パラメータ use 5.032 ; use Algorithm::LibLinear ; my $learner = Algorithm::LibLinear ->new( epsilon => 0.01 , nu => 0.75 , solver => ' ONECLASS_SVM ' , ); solver => 'ONECLASS_SVM' が一値分類用のソルバです。LIBLINEAR の train コマンドで言うところの -s 21 。 OC-SVM の良いところは (ハイパー)...

Perl 5 to 6 - Perl5の演算子に対する変更

これはMoritz Lenz氏のWebサイト Perlgeek.de で公開されているブログ記事 "Perl 5 to 6" Lesson 11 - Changes to Perl 5 Operators の日本語訳です。 原文は Creative Commons Attribution 3.0 Germany に基づいて公開されています。 本エントリには Creative Commons Attribution 3.0 Unported を適用します。 Original text: Copyright© 2008-2010 Moritz Lenz Japanese translation: Copyright© 2011 SATOH Koichi NAME "Perl 5 to 6" Lesson 11 - Perl5の演算子に対する変更 SYNOPSIS # ビット演算子 5 +| 3; # 7 6 +^ 3 # 6 5 +& 3; # 1 "b" ~| "d" # 'f' # 文字列連結 'a' ~ 'b' # 'ab' # ファイルテスト if '/etc/passwd' ~~ :e { say "exists" } # 繰り返し 'a' x 3 # 'aaa' 'a' xx 3 # 'a', 'a', 'a' # 3項演算子 $a == $b ?? 2 * $a !! $b - $a # 連結比較 if 0 <= $angle < 2 * pi { ... } DESCRIPTION 数値演算子( + , - , / , * , ** , % )はすべて元のままです。 | 、 ^ 、 & はジャンクションの生成に使われるので、ビット演算子は構文が変更されました。 それらはデータプレフィクスを伴い、例えば ...