<commit_before>{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Main where

import Fractals

import Prelude hiding (replicate, writeFile)
import Prelude as P

-- import Obsidian
import Obsidian.Run.CUDA.Exec

-- import qualified Data.Vector.Storable as V
import Control.Monad.State

-- Autotuning framework 
-- import Auto.Score
import System.Random (mkStdGen, random)
import GA (Entity(..), GAConfig(..), evolve)

-- -- timing
import Data.Time.Clock

-- import Criterion.Main
-- import Criterion.Types 
-- import Criterion.Monad
-- import Criterion.Internal

--exception
import Control.Exception

-- parameters
-- threads   = 256
blocks, imageSize, identity, count, maxNum :: Int
blocks    = 64
imageSize = 1024
identity  = 256
count     = 10
maxNum    = 512

type Number = Int

-- genetic algorithm
instance Entity Number Double () () IO where

  -- Generate a random starting number between 0 and maxNum.
  genRandom _ seed = return $ 1 + ((fst $ random $ mkStdGen seed) `mod` maxNum)

  -- Ideally we'd be working with a bit neighborhood here for the Int,
  -- rather than just having a few bits of arithmetic.
  crossover _ _ seed e1 e2 = return $ Just $ case seed `mod` 3 of
                                                  0 -> (e1+e2) `mod` maxNum
                                                  1 -> (abs (e1-e2)) `mod` maxNum
                                                  2 -> (e1+e2) `div` 2
                                                  _ -> error "crossover: unknown case"

  -- Dumb mutation function. Should be smarter, see above.
  mutation _ _ seed e = return $ Just $ if seed `mod` 2 == 0
                                        then e +(1 + seed `mod` 10)
                                        else abs (e - (1 + seed `mod` 10))

  -- Return a number denoting a score. Lower is better.
  score _ threads = do

    putStrLn $ "Trying with threads = " ++ (show threads)

    ctx <- initialise

    kern <- captureIO ("kernel" ++ show identity)
            (props ctx)
            (fromIntegral threads)
            (mandel (fromIntegral imageSize))

    let runIt = withCUDA' ctx $ do 
          allocaVector (fromIntegral (imageSize*imageSize)) $ \o -> do
            forM_ [0..count] $ \_ -> do
              o <== (fromIntegral imageSize,kern)
              syncAll
              copyOut o
    catch
      ( do
           -- This could be criterion instead, but it was complicated
           t0   <- getCurrentTime
           runIt >> return ()
           t1   <- getCurrentTime
           return $ Just $ realToFrac $ diffUTCTime t1 t0           
      )
      (\e -> do putStrLn (show (e :: SomeException))
                return Nothing)

main = do
  let cfg = GAConfig 
            5 -- population size
            100 -- archive size (best entities to keep track of)
            5 -- maximum number of generations
            0.8 -- crossover rate (% of entities by crossover)
            0.2 -- mutation rate (% of entities by mutation)
            0.0 -- parameter for crossover (not used here)
            0.2 -- parameter for mutation (% of replaced letters)
            False -- whether or not to use checkpointing
            False -- don't rescore archive in each generation
  
  currTime <- getCurrentTime
  let timed = floor $ utctDayTime currTime :: Int
  let g = mkStdGen timed -- random generator

  es <- evolve g cfg () ()
  let e = snd $ P.head es :: Int
  putStrLn $ "best entity: " ++ (show e)
  
  


-- -- Vary number of threads/block and image size  
-- main = do
--   putStrLn "Autotuning Mandelbrot fractal kernel"

--   ctx <- initialise

  
--   kern <- captureIO ("kernel" ++ show identity)
--           (props ctx)
--           threads
--           (mandel image_size)
  
 
--   let runIt = withCUDA' ctx $
--         allocaVector (fromIntegral (image_size*image_size)) $ \o -> 
--           do
--             -- threads here means blocks.
--             o <== (blocks,kern)
--             syncAll
--             copyOut o 

 
--   report <- catch
--     (
--       do<commit_msg>Print more info<commit_after>{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Main where

import Fractals

import Prelude hiding (replicate, writeFile)
import Prelude as P

-- import Obsidian
import Obsidian.Run.CUDA.Exec

-- import qualified Data.Vector.Storable as V
import Control.Monad.State

-- Autotuning framework 
-- import Auto.Score
import System.Random (mkStdGen, random)
import GA (Entity(..), GAConfig(..), evolveVerbose)

-- -- timing
import Data.Time.Clock

-- import Criterion.Main
-- import Criterion.Types 
-- import Criterion.Monad
-- import Criterion.Internal

--exception
import Control.Exception

-- parameters
-- threads   = 256
blocks, imageSize, identity, count, maxNum :: Int
blocks    = 64
imageSize = 1024
identity  = 256
count     = 10
maxNum    = 512

type Number = Int

-- genetic algorithm
instance Entity Number Double () () IO where

  -- Generate a random starting number between 0 and maxNum.
  genRandom _ seed = return $ 1 + ((fst $ random $ mkStdGen seed) `mod` maxNum)

  -- Ideally we'd be working with a bit neighborhood here for the Int,
  -- rather than just having a few bits of arithmetic.
  crossover _ _ seed e1 e2 = return $ Just $ case seed `mod` 3 of
                                                  0 -> (e1+e2) `mod` maxNum
                                                  1 -> (abs (e1-e2)) `mod` maxNum
                                                  2 -> (e1+e2) `div` 2
                                                  _ -> error "crossover: unknown case"

  -- Dumb mutation function. Should be smarter, see above.
  mutation _ _ seed e = return $ Just $ if seed `mod` 2 == 0
                                        then e +(1 + seed `mod` 10)
                                        else abs (e - (1 + seed `mod` 10))

  -- Return a number denoting a score. Lower is better.
  score _ threads = do

    putStrLn $ "Trying with threads = " ++ (show threads)

    ctx <- initialise

    kern <- captureIO ("kernel" ++ show identity)
            (props ctx)
            (fromIntegral threads)
            (mandel (fromIntegral imageSize))

    let runIt = withCUDA' ctx $ do 
          allocaVector (fromIntegral (imageSize*imageSize)) $ \o -> do
            forM_ [0..count] $ \_ -> do
              o <== (fromIntegral imageSize,kern)
              syncAll
              copyOut o
    catch
      ( do
           -- This could be criterion instead, but it was complicated
           t0   <- getCurrentTime
           runIt >> return ()
           t1   <- getCurrentTime
           let timed = realToFrac $ diffUTCTime t1 t0
           putStrLn $ "Time for " ++ (show threads) ++ " was " ++ (show timed)
           return $ Just timed
      )
      (\e -> do putStrLn (show (e :: SomeException))
                return Nothing)

main = do
  let cfg = GAConfig 
            5 -- population size
            100 -- archive size (best entities to keep track of)
            5 -- maximum number of generations
            0.8 -- crossover rate (% of entities by crossover)
            0.2 -- mutation rate (% of entities by mutation)
            0.0 -- parameter for crossover (not used here)
            0.2 -- parameter for mutation (% of replaced letters)
            False -- whether or not to use checkpointing
            False -- don't rescore archive in each generation
  
  currTime <- getCurrentTime
  let timed = floor $ utctDayTime currTime :: Int
  let g = mkStdGen timed -- random generator

  es <- evolveVerbose g cfg () ()
  let e = snd $ P.head es :: Int
  putStrLn $ "best entity: " ++ (show e)
  
  


-- -- Vary number of threads/block and image size  
-- main = do
--   putStrLn "Autotuning Mandelbrot fractal kernel"

--   ctx <- initialise

  
--   kern <- captureIO ("kernel" ++ show identity)
--           (props ctx)
--           threads
--           (mandel image_size)
  
 
--   let runIt = withCUDA' ctx $
--         allocaVector (fromIntegral (image_size*image_size)) $ \o -> 
--           do
--             -- threads here means blocks.
--             o <== (blocks,kern)
--             syncAll
--             copyOut o 

 
--   report <- catch
--     (
--       do
{'fraction_non_alphanumeric': 0.10005991611743559, 'fraction_numerical': 0.013900539245056921, 'mean_word_length': 1.6698656429942418, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 23, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 24, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '910679', 'n_tokens_mistral': 2475, 'n_tokens_neox': 2285, 'n_words': 832}