2010年05月17日 月曜日

2010年05月17日月曜日

■ [文法]基本文法(getCPUTime1) 02:53

import System.CPUTime (cpuTimePrecision, getCPUTime)
import System.Win32.Time (getTickCount)
import Control.Concurrent (threadDelay)
import System.Win32 (sleep)
import Data.List (sort)
import Text.Printf

-- getCPUTimeの単位はpicosecond(10 ^ (-12))
-- threadDelayの単位はmicrosecond(10 ^ (-6))
-- sleep、getTickCountの単位はmillisecond(10 ^ (-3))
-- getCPUTimeはスレッドが実行されている時間の合計
-- getTickCountはスレッドが停止している時間も含む...らしい...
main = do
  n  <- getCPUTime
  n' <- getTickCount
  print $ last $ reverse $ sort [0 .. 9999]
  sleep 1000
  threadDelay $ 10 ^ 6
  m  <- getCPUTime
  m' <- getTickCount
  printf "cpuTimePrecision:           %d\n" cpuTimePrecision
  printf "Running time(getCPUTime):   %.4f\n"
    $ (fromIntegral (m  - n ) / 10 ^ 12 :: Double)
  printf "Running time(getTickCount): %.4f\n"
    $ (fromIntegral (m' - n') / 10 ^ 3  :: Double)

-- $> main
-- 0
-- cpuTimePrecision:           1000000000
-- Running time(getCPUTime):   0.0469
-- Running time(getTickCount): 2.0470
-- (0.05 secs, 5256396 bytes)

■ [重要]GHCのライセンス 04:00

たまにソースコード参照しそうだから貼っとく...

The Glasgow Haskell Compiler License

Copyright 2004, The University Court of the University of Glasgow. 
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
 
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
 
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission. 

THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.

■ [文法]基本文法(getCPUTime2) 04:23

import System.CPUTime (getCPUTime)
import System.Win32.Time (queryPerformanceCounter, queryPerformanceFrequency)
import Control.Concurrent (threadDelay)
import System.Win32 (sleep)
import Data.List (sort)
import Text.Printf

-- getCPUTimeは、内部でgetrusage()を読んでいたが、Windowsでは使えないらしい...
-- QueryPerformanceCounter(Win32API)は使える...
main = do
  f  <- queryPerformanceFrequency
  n  <- getCPUTime
  n' <- queryPerformanceCounter
  print $ last $ reverse $ sort [0 .. 9999]
  sleep 1000
  threadDelay $ 10 ^ 6
  m  <- getCPUTime
  m' <- queryPerformanceCounter
  printf "Running time(getCPUTime):              %.4f\n"
    $ (fromIntegral (m  - n ) / 10 ^ 12 :: Double)
  printf "Running time(queryPerformanceCounter): %.4f\n"
    $ (fromIntegral (m' - n') / fromIntegral f  :: Double)


-- $> main
-- 0
-- Running time(getCPUTime):              0.0156
-- Running time(queryPerformanceCounter): 2.0206
-- (0.19 secs, 5262412 bytes)

あんまり意味なかった...

因みにGHCのソースを見ると、GetProcessTimes()を使っていた。カーネルモードでの実行時間とユーザーモードでの実行時間をFILETIMEにして返してくれるらしい(詳細はMSDNにて)。これでC/C++と比較できる。Unix/Linuxユーザーの方はgetrusage()で事足りるからいいですね...

以下のコードはGHCコンパイラのソースコードの一部の引用です。一応、ライセンスは(GHCのライセンス - Haskell卒業! - haskell)となっています...

...
#else /* win32 */
     -- NOTE: GetProcessTimes() is only supported on NT-based OSes.
     -- The counts reported by GetProcessTimes() are in 100-ns (10^-7) units.
    allocaBytes (#const sizeof(FILETIME)) $ \ p_creationTime -> do
    allocaBytes (#const sizeof(FILETIME)) $ \ p_exitTime -> do
    allocaBytes (#const sizeof(FILETIME)) $ \ p_kernelTime -> do
    allocaBytes (#const sizeof(FILETIME)) $ \ p_userTime -> do
    pid <- getCurrentProcess
    ok <- getProcessTimes pid p_creationTime p_exitTime p_kernelTime p_userTime
    if toBool ok then do
      ut <- ft2psecs p_userTime
      kt <- ft2psecs p_kernelTime
      return (ut + kt)
     else return 0
  where 
        ft2psecs :: Ptr FILETIME -> IO Integer
        ft2psecs ft = do
          high <- (#peek FILETIME,dwHighDateTime) ft :: IO Word32
          low  <- (#peek FILETIME,dwLowDateTime)  ft :: IO Word32
            -- Convert 100-ns units to picosecs (10^-12) 
            -- => multiply by 10^5.
          return (((fromIntegral high) * (2^(32::Int)) + (fromIntegral low)) * 100000)
...

■ [検証][fromC/C++]単純ループ1 13:34

Smoking fast Haskell code using GHC’s new LLVM codegen « Control.Monad.Writerで、Haskellの最適化の検証とかしてる...

C/C++との比較も当初の目的に入っているので簡単に調べてみる。WindowsなのでC++はMS製のコンパイラ(VS2008)、HaskellはGHCの6.12.1かな...

とりあえず、C++のコードから...

#include <windows.h>
#include <iostream>
#include <iomanip>
#include <limits>

inline double get_cpu_time()
{
	FILETIME temp, kernel_time, user_time;
	// DBL_MAX使いたいだけなのだが。それにしても、C++の自由度の高さときたら...
#ifdef max
#pragma push_macro ("max")
#define POPME_
#undef max
#endif
	if(!::GetProcessTimes(::GetCurrentProcess(), &temp, &temp, &kernel_time, &user_time)){
		__debugbreak();
		return -std::numeric_limits<double>::max();
	}
#ifdef POPME_
#undef POPME_
#pragma pop_macro ("max")
#endif

#ifndef max
#error "Maybe, above macros are invalid ... orz"
#endif
	ULONGLONG high((static_cast<ULONGLONG>(kernel_time.dwHighDateTime) + user_time.dwHighDateTime) << 32);
	ULONGLONG low(static_cast<ULONGLONG>(kernel_time.dwLowDateTime) + user_time.dwLowDateTime);
	return static_cast<double>((high + low) / 1000) / 10000;
}

// 使いにくい。しかも、使えてない...
inline void init(){using namespace std; cout << setprecision(2) << setiosflags(ios_base::showpoint);}
template <typename T> inline void print_time(const T& t){using namespace std; cout << setw(6) << t << " secs" << endl;}

int main(int argc, char* argv[])
{
	using namespace std;
	double times[5]; unsigned int i;

	init();
	times[0] = get_cpu_time();
	::Sleep(1000);
	times[1] = get_cpu_time();
	for(i = 0; i < 1 << 16; ++i); cout << i << endl;
	times[2] = get_cpu_time();
	for(i = 0; i < 1 << 20; ++i); cout << i << endl;
	times[3] = get_cpu_time();
	for(i = 0; i < 1 << 24; ++i); cout << i << endl;
	times[4] = get_cpu_time();

	cout << "----- (test1)" << endl;
	for(int n(1); n < _countof(times); ++n)
		print_time(times[n] - times[n - 1]);
	cout << "-----" << endl;

	return 0;
}

結果は...

// Debugビルド
65536
1048576
16777216
----- (test1)
  0.00 secs
  0.00 secs
  0.00 secs
 0.047 secs
-----

// Releaseビルド(最適化)
65536
1048576
16777216
----- (test1)
  0.00 secs
  0.00 secs
  0.00 secs
  0.00 secs
-----

余裕ありすぎ。負荷になってない...

■ [検証][fromC/C++]単純ループ2 13:47

ほぼ、同等のコードをHaskellで書いてみる...

{-# OPTIONS_GHC -O2 -fvia-C -optc-O3 -fglasgow-exts -XBangPatterns #-}

import System.CPUTime (getCPUTime)
import Control.Concurrent (threadDelay)
import Text.Printf
import GHC.Prim
import GHC.Types

getCPUTime' :: IO Double
getCPUTime' = fmap ((/ 10000) . fromIntegral . (`quot` 100000000)) getCPUTime

printTime :: Int -> [Double] -> IO ()
printTime i xs =
  printf "----- (test%d)\n%s-----\n" i
    (unlines $ map (printf "%-6.2f secs") (zipWith subtract xs (tail xs)))

test1 = do
  a <- getCPUTime'
  threadDelay $ 10 ^ 6
  b <- getCPUTime'
  print $ last ([1 .. 65536]    :: [Int])
  c <- getCPUTime'
  print $ last ([1 .. 1048576]  :: [Int])
  d <- getCPUTime'
  print $ last ([1 .. 16777216] :: [Int])
  e <- getCPUTime'
  printTime 1 [a, b, c, d, e]

test2 = do
  a <- getCPUTime'
  threadDelay $ 10 ^ 6
  b <- getCPUTime'
  print $ (until (>= 65536   ) (+ 1) 0 :: Int)
  c <- getCPUTime'
  print $ (until (>= 1048576 ) (+ 1) 0 :: Int)
  d <- getCPUTime'
  print $ (until (>= 16777216) (+ 1) 0 :: Int)
  e <- getCPUTime'
  printTime 2 [a, b, c, d, e]

test3 = do
  a <- getCPUTime'
  threadDelay $ 10 ^ 6
  b <- getCPUTime'
  print $ (loop 65536#   )
  c <- getCPUTime'
  print $ (loop 1048576# )
  d <- getCPUTime'
  print $ (loop 16777216#)
  e <- getCPUTime'
  printTime 3 [a, b, c, d, e]
  where
    loop !x = loop' 0# where
      loop' !i | i <# x    = loop' (i +# 1#)
               | otherwise = I# i

main = test1 >> test2 >> test3

GHCiでの実行結果は...

$> main
65536
1048576
16777216
----- (test1)
0.00   secs
0.00   secs
0.05   secs
0.67   secs
-----
65536
1048576
16777216
----- (test2)
0.00   secs
0.05   secs
0.75   secs
12.88  secs
-----
65536
1048576
16777216
----- (test3)
0.00   secs
0.08   secs
1.64   secs
25.55  secs
-----

インタラクティブな環境だし、速度は気にしないがtest3は速くするつもりで書いたのに遅いのが気になる。２５秒って勘弁して欲しいのだが...

因みに最適化コンパイル(フラグはコード内に記述済)して実行してみると...

$> :! ghc --make Loop.hs
[1 of 1] Compiling Main ...
Linking Loop.exe ...
$> :! Loop.exe
65536
1048576
16777216
----- (test1)
0.00   secs
0.02   secs
0.03   secs
0.45   secs
-----
65536
1048576
16777216
----- (test2)
0.00   secs
0.00   secs
0.03   secs
0.39   secs
-----
65536
1048576
16777216
----- (test3)
0.00   secs
0.00   secs
0.00   secs
0.02   secs

test3が最速になった。C/C++には負けるけど...

■ [検証][fromC/C++]Map大好き1 21:47

次はMap...

因みにC++の確認コードは以下。std::mapに４００万要素突っ込んで、４００万要素をルックアップして、ルックアップできた数を表示するだけ...

#include <windows.h>
#include <iostream>
#include <iomanip>
#include <limits>
#include <map>

inline double get_cpu_time()
{
	FILETIME temp, kernel_time, user_time;
#ifdef max
#pragma push_macro ("max")
#define POPME_
#undef max
#endif
	if(!::GetProcessTimes(::GetCurrentProcess(), &temp, &temp, &kernel_time, &user_time)){
		__debugbreak();
		return -std::numeric_limits<double>::max();
	}else{
		ULONGLONG high((static_cast<ULONGLONG>(kernel_time.dwHighDateTime) + user_time.dwHighDateTime) << 32);
		ULONGLONG low(static_cast<ULONGLONG>(kernel_time.dwLowDateTime) + user_time.dwLowDateTime);
		return static_cast<double>((high + low) / 1000) / 10000;
	}
#ifdef POPME_
#undef POPME_
#pragma pop_macro ("max")
#endif
}

inline void init(){using namespace std; cout << setprecision(2) << setiosflags(ios_base::showpoint);}
template <typename T> inline void print_time(const T& t){using namespace std; cout << setw(6) << t << " secs" << endl;}
template <typename T> inline void print(const T& t){std::cout << t << std::endl;}

int main(int argc, char* argv[])
{
	typedef std::map<int, int> intmap; typedef std::pair<int, int> intpair;
	const int N(1 << 22);
	intmap m;
	const double start(get_cpu_time());
	int sum(0);

	for(int i(0) ; i < N; ++i)
		m.insert(intpair(i, i));
	for(int i(0) ; i < N; ++i)
		sum += m.find(i) == m.end() ? 0 : 1;

	print(sum);
	print_time(get_cpu_time() - start);

	return 0;
}

結果は、標準のリリースビルド(デフォールトの最適化オプションを適用という意味)で以下になった...

4194304
13.4062 secs

１３秒...

■ [検証][fromC/C++]Map大好き2 21:55

Haskellではどうか...

検証コードは以下。Intに特化したIntMapを使ってるけど、それくらいハンデがないとC/C++には勝てないので許して...

{-# OPTIONS_GHC -cpp -O2 -fvia-C -optc-O3 -fglasgow-exts -XBangPatterns #-}

import System.CPUTime (getCPUTime)
import qualified Data.IntMap as Map
import Control.Monad (forM_)
import Data.List
import Data.Foldable (foldr')
import Text.Printf

getCPUTime' :: IO Double
getCPUTime' = fmap ((/ 10000) . fromIntegral . (`quot` 100000000)) getCPUTime

printTime :: Double -> IO ()
printTime d = printf "%-6.2f secs\n" d

-- test1から遅延、正格評価版のfoldを利用してみた。意外と差が出た...

-- 普通のfoldl。使うことあるのかな...
test1 = foldl f 0 [1 .. 4194304] where
  f acc i = acc + (maybe 0 (const 1) $ Map.lookup i m)
  m = foldl g Map.empty [1 .. 4194304] where
    g m' i = Map.insert i i m'

-- foldl'はなんとなく使いにくいが、計算は速い...
test2 = foldl' f 0 [1 .. 4194304] where
  f acc i = acc + (maybe 0 (const 1) $ Map.lookup i m)
  m = foldl' g Map.empty [1 .. 4194304] where
    g m' i = Map.insert i i m'

-- foldrが一番使いやすいのだが、式が複雑だとスタックオーバーフローするかも...
test3 = foldr ((+) . (maybe 0 (const 1) . (`Map.lookup` m))) 0 [1 .. 4194304] where
  m = foldr f Map.empty [1 .. 4194304] where
    f i m'' = Map.insert i i m''

-- 前回の調査では、意外とfoldr'が速かったのだが...
test4 = foldr' ((+) . (maybe 0 (const 1) . (`Map.lookup` m))) 0 [1 .. 4194304] where
  m = foldr' f Map.empty [1 .. 4194304] where
    f i m'' = Map.insert i i m''

main = do
  let ts = [test1, test2, test3, test4]
  forM_ [0 .. 3] $ \i -> do
    a <- getCPUTime'
    print $ ts !! i
    b <- getCPUTime'
    printTime (b - a)

普通にやるとfoldrがスタックオーバーフローしたので、スタックのサイズを１００メガ(でいいですよね？)にした。結果は以下...

$> :! ghc --make Map.hs
[1 of 1] Compiling Main             ( Map.hs, Map.o )
Linking Map.exe ...
$> :! Map.exe +RTS -K100M -RTS
4194304
4.97   secs
4194304
3.05   secs
4194304
80.03  secs
4194304
4.64   secs

なんで、Haskellの方が速いの？。正直、驚いた。私のコードに何か抜けがあるかもしれないけど(入力値が単純だから、たまたまMapの構築が上手くいっただけかもしれない)...

正格評価系が速いのはわかるが、foldrが突出して遅い。普段気が付かないけど、値が大きくなると差が出てくるな...

C++がこんなに遅いのはおかしい。どっか間違えてる気がする...

■ [検証][fromC/C++]フィボナッチ数列 23:07

とりあえず、今回の検証はこれで終わりにするつもり。また、色々と検証していきたい。最後に、Haskellで有名なフィボナッチ数列を逆にC/C++に移植してみる...

有名なのは、多分、下の定義(1 : 2で始まるべきなのか、よくわからないけど)...

fibs = 1 : 1 : zipWith (:) fibs (tail fibs)

言語拡張を使うと、遅いけど、もっとエレガント(？)に書ける...

{-# LANGUAGE ParallelListComp #-}

fibs@(_:fibs') = 1 : 1 : [x + y | x <- fibs | y <- fibs']

簡単なので、Cで書いてみると...

#include <stdlib.h>
#include <stdio.h>

int main(int argc, char* argv[])
{
	typedef unsigned long long ull_t;
	ull_t buf[50];
	ull_t *f_2 = &buf[0], *f_1 = f_2 + 1, *f = f_1 + 1;
	const ull_t* const f_end = &buf[_countof(buf)];

	*f_2 = *f_1 = 1;
	while(f < f_end) 
		printf("%I64u\n", *f++ = *f_1++ + *f_2++);

	return 0;
}

多倍長整数が使えないのでアレだけど、Haskell勉強してなかったら、こういう書き方(考え方？)はできなかったと思う...

Haskell卒業!

Haskellの勉強 -> 演習 -> 卒業 Haskell＆プログラミング卒業しました。その他サイコなことは「route150の日記」に書いています。