Сравнение производительности языков на примере простейшего классификатора

Решил поиграться с Haskell.

Платформа: Fedora 21 x64
Входная выборка получена генератором с параметром `100000`.

DMD 2.067.1: 2.85267 s
GHC 7.8.4 (обычный бекэнд): 2.462 s
GHC 7.8.4 (llvm): 2.382 s

Main.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE BangPatterns, MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-}
module Main where 

import Criterion
import Criterion.Main
import Control.DeepSeq
import GHC.Generics (Generic)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector.Unboxed as V
import Data.ByteString.Read
import Data.Maybe

import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as M
import Control.Monad 

data Measure = Measure {-# UNPACK #-} !Float {-# UNPACK #-} !Float
  deriving (Generic)

instance NFData Measure 

instance Num Measure where 
  (Measure x1 y1) + (Measure x2 y2) = Measure (x1+x2) (y1+y2)
  (Measure x1 y1) - (Measure x2 y2) = Measure (x1-x2) (y1-y2)
  (Measure x1 y1) * (Measure x2 y2) = Measure (x1*x2) (y1*y2)
  abs = undefined
  signum = undefined
  fromInteger i = Measure (fromIntegral i) (fromIntegral i)

instance Fractional Measure where 
  (Measure x1 y1) / (Measure x2 y2) = Measure (x1/x2) (y1/y2)
  fromRational = undefined

sqr :: Float -> Float 
sqr x = x*x

dist :: Measure -> Measure -> Float 
dist (Measure x1 y1) (Measure x2 y2) = sqrt $ sqr (x1 - x2) + sqr (y1 - y2)

data Class = Class !Measure !Int 
  deriving (Generic)

instance NFData Class 

instance Show Class where
  show (Class (Measure x y) i) = "[" ++ show x ++ ", " ++ show y ++ "]: " ++ show i 

newClass :: Measure -> Class 
newClass m = Class m 1 

append :: Class -> Measure -> Class
append (Class mean n) m = Class newMean (n+1)
  where newMean = ( mean * fromIntegral n + m ) / fromIntegral ( n + 1 )

merge :: Class -> Class -> Class 
merge (Class mean1 n1) (Class mean2 n2) = Class mean3 (n1+n2)
  where mean3 =  ( mean1 * fromIntegral n1 + mean2 * fromIntegral n2 ) / fromIntegral ( n1 + n2 );

classificate :: Float -> V.Vector Measure -> V.Vector Class
classificate nclsDist ms = V.foldl' go V.empty ms 
  where 
    go :: V.Vector Class -> Measure -> V.Vector Class
    go acc m 
      | V.null acc = V.singleton $ newClass m
      | otherwise = if minDist < nclsDist
        then newCls
        else (newClass m) `V.cons` newCls
      where 
        newCls = acc `V.unsafeUpd` [(nearClsI, nearCls `append` m)]
        (nearCls, nearClsI, minDist) = sortByDist acc m

    sortByDist :: V.Vector Class -> Measure -> (Class, Int, Float)
    sortByDist cs m = out $ V.ifoldl' checkDist (0, maxFloat) cs 
      where 
        maxFloat :: Float 
        maxFloat = 1/0

        out :: (Int, Float) -> (Class, Int, Float)
        out (i, d) = (V.unsafeIndex cs i, i, d)

        checkDist :: (Int, Float) -> Int -> Class -> (Int, Float)
        checkDist acc@(_, mdist) i (Class mean _) = if curDist < mdist 
          then (i, curDist)
          else acc
          where curDist = dist m mean

readMeasures :: BS.ByteString -> V.Vector Measure
readMeasures = V.fromList . catMaybes . fmap (go . BS.words) . BS.lines
  where go [a, b] = do
          (x, _) <- signed fractional a
          (y, _) <- signed fractional b 
          return $!! Measure x y
        go _ = Nothing
        
main :: IO ()
main = defaultMain [
    env (fmap readMeasures $ BS.readFile "data") $ \measures ->
      bench "classificate" $ nf (classificate 3) measures
  ]

-- | Алтернативная main функция для проверки правильности реализации
main2 :: IO ()
main2 = do 
  measures <- fmap readMeasures $ BS.readFile "data"
  print $ measures `deepseq` V.length measures
  let classes = classificate 3 measures
  print $ classes `deepseq` V.length classes 
  putStrLn $ unlines $ fmap show $ V.toList classes

-- | Далее идет boilerplate для реализации Unboxed векторов для кастомных типов

newtype instance V.MVector s Measure = MV_Measure (V.MVector s (Float,Float))
newtype instance V.Vector    Measure = V_Measure  (V.Vector    (Float,Float))

instance V.Unbox Measure

instance M.MVector V.MVector Measure where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicUnsafeReplicate #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength (MV_Measure v) = M.basicLength v
  basicUnsafeSlice i n (MV_Measure v) = MV_Measure $ M.basicUnsafeSlice i n v
  basicOverlaps (MV_Measure v1) (MV_Measure v2) = M.basicOverlaps v1 v2
  basicUnsafeNew n = MV_Measure `liftM` M.basicUnsafeNew n
  basicUnsafeReplicate n (Measure x y) = MV_Measure `liftM` M.basicUnsafeReplicate n (x,y)
  basicUnsafeRead (MV_Measure v) i = uncurry Measure `liftM` M.basicUnsafeRead v i
  basicUnsafeWrite (MV_Measure v) i (Measure x y) = M.basicUnsafeWrite v i (x,y)
  basicClear (MV_Measure v) = M.basicClear v
  basicSet (MV_Measure v) (Measure x y) = M.basicSet v (x,y)
  basicUnsafeCopy (MV_Measure v1) (MV_Measure v2) = M.basicUnsafeCopy v1 v2
  basicUnsafeMove (MV_Measure v1) (MV_Measure v2) = M.basicUnsafeMove v1 v2
  basicUnsafeGrow (MV_Measure v) n = MV_Measure `liftM` M.basicUnsafeGrow v n

instance G.Vector V.Vector Measure where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze (MV_Measure v) = V_Measure `liftM` G.basicUnsafeFreeze v
  basicUnsafeThaw (V_Measure v) = MV_Measure `liftM` G.basicUnsafeThaw v
  basicLength (V_Measure v) = G.basicLength v
  basicUnsafeSlice i n (V_Measure v) = V_Measure $ G.basicUnsafeSlice i n v
  basicUnsafeIndexM (V_Measure v) i
                = uncurry Measure `liftM` G.basicUnsafeIndexM v i
  basicUnsafeCopy (MV_Measure mv) (V_Measure v)
                = G.basicUnsafeCopy mv v
  elemseq _ (Measure x y) z = G.elemseq (undefined :: V.Vector Float) x
                       $ G.elemseq (undefined :: V.Vector Float) y z



newtype instance V.MVector s Class = MV_Class (V.MVector s (Float, Float, Int))
newtype instance V.Vector    Class = V_Class  (V.Vector    (Float, Float, Int))

instance V.Unbox Class

instance M.MVector V.MVector Class where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicUnsafeReplicate #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength (MV_Class v) = M.basicLength v
  basicUnsafeSlice i n (MV_Class v) = MV_Class $ M.basicUnsafeSlice i n v
  basicOverlaps (MV_Class v1) (MV_Class v2) = M.basicOverlaps v1 v2
  basicUnsafeNew n = MV_Class `liftM` M.basicUnsafeNew n
  basicUnsafeReplicate n (Class (Measure x y) ni) = MV_Class `liftM` M.basicUnsafeReplicate n (x,y,ni)
  basicUnsafeRead (MV_Class v) i = (\(x,y,ni)->Class (Measure x y) ni) `liftM` M.basicUnsafeRead v i
  basicUnsafeWrite (MV_Class v) i (Class (Measure x y) ni) = M.basicUnsafeWrite v i (x,y, ni)
  basicClear (MV_Class v) = M.basicClear v
  basicSet (MV_Class v) (Class (Measure x y) ni) = M.basicSet v (x,y,ni)
  basicUnsafeCopy (MV_Class v1) (MV_Class v2) = M.basicUnsafeCopy v1 v2
  basicUnsafeMove (MV_Class v1) (MV_Class v2) = M.basicUnsafeMove v1 v2
  basicUnsafeGrow (MV_Class v) n = MV_Class `liftM` M.basicUnsafeGrow v n

instance G.Vector V.Vector Class where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze (MV_Class v) = V_Class `liftM` G.basicUnsafeFreeze v
  basicUnsafeThaw (V_Class v) = MV_Class `liftM` G.basicUnsafeThaw v
  basicLength (V_Class v) = G.basicLength v
  basicUnsafeSlice i n (V_Class v) = V_Class $ G.basicUnsafeSlice i n v
  basicUnsafeIndexM (V_Class v) i
                = (\(x,y,ni)->Class (Measure x y) ni) `liftM` G.basicUnsafeIndexM v i
  basicUnsafeCopy (MV_Class mv) (V_Class v)
                = G.basicUnsafeCopy mv v
  elemseq _ (Class (Measure x y) ni) z = G.elemseq (undefined :: V.Vector Float) x
                       $ G.elemseq (undefined :: V.Vector Float) y 
                       $ G.elemseq (undefined :: V.Vector Int) ni z 

Cabal файл

name:                cls-bench
version:             0.1.0.0
license:             BSD3
license-file:        LICENSE
author:              Anton Gushcha
maintainer:          [e-mail]
build-type:          Simple
cabal-version:       >=1.10

executable cls-bench
  main-is:             Main.hs
  build-depends:       base >= 4.7, criterion >= 1.1, deepseq, bytestring >= 0.10, bytestring-read >= 0.3, vector
  default-language:    Haskell2010
  ghc-options:         -O2 -threaded

DlangUI — кросплатформенный GUI для D (Часть 1)

На данный момент открытого проекта нет, основной, к сожалению, проприетарный и очень тяжеловесный.

DlangUI — кросплатформенный GUI для D (Часть 1)

> Возможность отрисовки виджетов поверх OpenGL сцены (например, для UI в игре)

Хотелось бы туториала именно про этому пункту. Мы давно приглядываемся к DlangUI, чтобы не городить очередных велосипедов.

У нас используется DSFML для создания контекста, а внутрях репозитория находили только адаптеры для SDL. Насколько сложно реализовать обертку для DSFML?

Учебник по языку программирования D. Часть 3

Спасибо, что продолжили дело, которое я не осилил. Предлагаю создавать пост сразу из нескольких глав (например, из трех). А после окончания всего перевода опубликовать его на сайте автора оригинала.

Сравнение D и C++ и Rust на примерах

Сейчас можно создавать объекты на стеке с помощью scope, также используется библиотечное unsafe решение std.typecons.scoped.

Книга Александреску немного устарела и многие новые фичи и изменения в языке там просто не отражены. Из свежих могу посоветовать D Cookbook.

Сравнение D и C++ и Rust на примерах

Стандартное поведение, ассоциативные массивы, реализованные в рантайме, всегда размещается в куче.

Compile-time функциональное программирование в D

У меня устаревшие сведения, полгода назад не мог делать параметризированные alias:

/// Alias for vector of 2 elements
alias vec2(T) = Vector!(T, 2);
/// Alias for vector of 3 elements
alias vec3(T) = Vector!(T, 3);

Compile-time функциональное программирование в D

struct Predmet { int x; }

Predmet globalPredmet = Predmet(15);

unittest
{
    std.stdio.writeln(globalPredmet);
}

Или, если нужны сложные вычисления для создания структуры, то можно через конструктор модуля:

struct Predmet { int x; }

Predmet globalPredmet;

static this()
{
    globalPredmet = Predmet(15);
}

unittest
{
    std.stdio.writeln(globalPredmet);
}

Compile-time функциональное программирование в D

Стоящее предложение. Почему бы тогда не сделать alias с параметрами доступными не только в шаблонах?

Compile-time функциональное программирование в D

Тогда пока вместо Pack буду использовать StrictList. С обучающими примерами сложнее: нельзя же пока использовать Pack, так как, если пользователь попробует скомпилировать пример, то сразу наткнется на эту проблему.

Compile-time функциональное программирование в D

В std.typetuple уже есть private Pack и он не является по смыслу 'StrictTuple', итого dmd не позволяет мне использовать название Pack.

Compile-time функциональное программирование в D

Думал, что SDC заглох. Меня он привлекает в первую очередь как compiler as a library, можно было бы использовать D как встраиваемый скриптовый язык.

Compile-time функциональное программирование в D

Спасибо, List и Pack действительно лучше. Переведу код на них.

P.S. Меня никогда не смущало наличие второго «Tuple» в std.typecons, т.к. все попытки его использовать разбивались о плохую поддержку IDE и проблемы с сериализацией, а еще он не работает с immutable.

Compile-time функциональное программирование в D

Нужно заметить, что сложные грамматики не запихнешь в compile-time, не хватает памяти. Распарсить D код с модификациями не получится без серьезной доработки эффективности CTFE.

Compile-time функциональное программирование в D

Ни разу не видел эту рекомендацию. Называть их «TemplateArgumentList» — ужасное решение, весь код разбухнет раза в 3-4, а делать alias на тот же Tuple (или другое короткое имя, мб ETuple) — костыль.

Compile-time функциональное программирование в D

Я был неправ, AST макросы давно обсуждаются DIP50, но пока не реализованы (первое упомнинание как о «запланированной» фиче это 2010 г.).

Compile-time функциональное программирование в D

Можно пояснить, что именно вы имели ввиду? Я познал Haskell на среднем уровне и не помню там меты, кроме банальных вычислений на типах (Nat и вектора на них) и TH, который требует отдельного прогона компилятора, оперирует AST и с легкостью получает невалидный код.

Тем более, почему бы императивным языкам не иметь элементы функционального подхода в мете, если это удобно и zero-cost для производительности? На Haskell нужно специально затачивать код под производительность, зачастую теряя в читаемости.

Compile-time функциональное программирование в D

Через alias параметры можно передавать символы, это, конечно, не целое AST, но уже его часть. Разработчики заняли довольно принципиальную позицию о том, что вместо операций над AST удобнее собирать строки и примешивать. Максимум, что можно ожидать в будущих версиях — расширение traits возможностью получать AST в виде списка-дерева из строк и работать с ним через compile-time функции.

Compile-time функциональное программирование в D

А что вы имеете в виду под «разделение типов и значений»?

Если аргумент значение, то используется enum, если тип, то alias. Осталось совсем немного, чтобы оперировать с типами как с значениями. На словах это будет все равно непонятно, вот пример из Idris:

(++) : Vect n a -> Vect m a -> Vect (n + m) a
(++) Nil ys = ys
(++) (x :: xs) ys = x :: xs ++ ys

Главная мысль — в сигнатуре вектора используется значение его длины, поэтому тип как бы «зависит» от своих значений, добавил новый элемент в вектор — тип изменился. Также видно, что даже в сигнатуре функции происходят некие вычисления. Возможно, это самый органичный способ вписать мету в язык. Увы я знаю о зависимых типах не так уж много, чтобы делать какие-то выводы.

Там есть «макросы» — специальные функции, начинающиеся с ключевого слова «macro». По сути это функции, выполняющиеся во время компиляции. В них можно обычным императивным способом выполнять код, который имеет доступ к API компилятора. Этим функциям можно передать объекты кода в виде AST-деревьев. С одной стороны, никаких строк — с другой стороны, никакой шаблонной магии.

Но это же получается boilerplate код, от D подхода при генерации через compile-time function evaluation не отличается (нужно заметить, что в D не полностью строковой подход, можно примешивать только целые expressions или объявления).

Compile-time функциональное программирование в D

Мне не нравится разделение типов и значений, но если их приравнивать, то получается система с зависимыми типами. Развитие в эту сторону мне кажется логичным.

Также напрягают шероховатости при получении информации от компилятора, она просто нетипизирована, пока не обернута в список. Есть другой подход через вызов обычных функций во время компиляций, но он не может оперировать типами напрямую, только строками. Шаблонный подход более элегантный.

Знаком еще с Template Haskell, там оперируешь с AST, это по мощности где-то посередине между примесями и шаблонами. Я бы его не назвал удобным, опасность чуть ниже примесей, а удобства не прибавляет.