always one step forward

トップ > it > 「"土/日/月が5日ずつある月"は823/824年に一度？」をperlで調べた

「"土/日/月が5日ずつある月"は823/824年に一度？」をperlで調べた

it daily

一部で話題になっている「今月は土曜・日曜・月曜が5日ずつあり、824年に1度しかない『金袋』というチャンスだと中国の風水師が語っている‥」という文章。直感的にそんなはずはない（もっとあるはず）と思いつつ、「けどそういうからには意外とそうなのかも」と perl の勉強をかねて調べてみた。結果＝デマ

2016/10追記）

2016/10は該当する月だった。次は2017/7なのでその頃再登場するコンテンツだろう。デマであることを忘れられたちょうどよい頃合いなのかもしれない

「823年に一度」「824年に一度」‥この手の文章に合わせて書かれているのは「金運UP」「風水」 - 言い換えれば、このようなコンテンツであれば常に一定のアクセスが得られるようである

スクリプトの構成

カレンダー上の構成からは

  • 1日が土曜日である
  • 31日まである

を満たせば、その31日が月曜日になり、自動的に土日月が5日ずつになる。という構成でごちゃごちゃ末尾のように書いた。

結果＝わりとすぐ昔にもあります

とりあえず 1999-2030 年の間だけでも↓のようにたくさん（前回は昨年10月、次は再来年の3月）：

1999/5 2000/1 2000/7 2001/12 2003/3 2004/5 2005/1 2005/10 2006/7 2007/12 2008/3 2009/8 2010/5 2011/1 2011/10 2012/12 2014/3 2015/8 2016/10 2017/7 2018/12 2020/8 2021/5 2022/1 2022/10 2023/7 2025/3 2026/8 2027/5 2028/1 2028/7 2029/12

まあ、こんなことをしなくても、カレンダーを1年前までめくればすぐわかるはずで、デマにしてはわかりやすすぎるなと。万が一、中国、とあるので、「天地明察」がヒットした年でもあるし、授時暦（か何かの太陰暦）をベースにした計算かもしれない。暦のソースが見つかったら調べるかもしれないけど、とりあえずまあ、単に perl の勉強になったのでよかった

# $year 年 $mon 月 $mday 日の曜日を求める getwday
sub getwday {
    my( $year, $mon, $mday ) = @_;

    if ($mon == 1 or $mon == 2) {
        $year--;
        $mon += 12;
    }
    int( $year + int( $year / 4 ) - int( $year / 100 ) + int( $year / 400 )
        + int( ( 13 * $mon + 8 ) / 5 ) + $mday ) % 7;
}

# テスト
# $wday = getwday($year, $mon, $mday); # 日曜0月曜1‥土曜6
# $wday_string = (qw(日 月 火 水 木 金 土))[$wday]; # 曜日漢字へ変換


# $year 年 $month 月 が何日まであるか求める Days_in_Month( $year, $month )
use Date::Calc qw( Today Days_in_Month );

# テスト
# my ( $year, $month, $day ) = Today;
# $days = Days_in_Month( $year, $month ); # 今月は何日まで？


# 1日が土曜、31日が月曜である月をさがす
for ($xx = 1999; $xx <= 2030; $xx++) {
    for ($yy = 1; $yy <= 12; $yy++) {

        $w_firstday = getwday($xx, $yy, 1);   # 1日は何曜日？
        $w_lastday = getwday($xx, $yy, Days_in_Month( $xx, $yy ) );  # その月最終日は何曜日？

        # 1日が土曜日、31日まであり、（一応追加）31日が月曜である月は？
        if( ( $w_firstday == 6 ) && ( Days_in_Month( $xx, $yy ) == 31 ) && ($w_lastday == 1 ) )
            { print $xx , "/", $yy, "\t"; }
    }
}
print "\n";