All streams
Search
Write a publication
Pull to refresh
0
Karma
0
Global rating
@dbrnix

User

Send message
ProfileArticlesPostsNewsComments6
«Дело было вечером, делать было нечего» или краткая история о сравнении производительности языков программирования

Да, не знаю даже что и думать. Асм совпадает один-в-один, так что если только какое-нибудь выравнивание влияет, но я что-то сомневаюсь что этим можно объяснить такую огромную разницу.


Если Вам все это еще не надоело, было бы интересно посмотреть что сделает llvm бекенд, и как будет вести себя мой слегка оптимизированный код выше.


llvm можно поставить аптом,


RUN apt install -y llvm-10

И запускать как-то так:


docker build -t benchmark . > /dev/null && \
docker run --rm benchmark ghc --version && echo '' && echo '' && \
docker run --rm --volume $(pwd):/app benchmark ghc -O2 /app/prime-number/haskell/cmd.hs -o /app/prime-number/haskell/cmd.hs_bin -fllvm -pgmlo=opt-10 -pgmlc=llc-10 -optlo="-O3" -optlc="-O3" > /dev/null && \
docker run --rm --volume $(pwd):/app benchmark bash -c 'time /app/prime-number/haskell/cmd.hs_bin 7000'

PS: Было бы неплохо если кто-нибудь еще прогнал бенчи у себя на машине, а то мне уже начинает казаться что у меня какой-то специальный процессор для хаскеля стоит

This comment wasn’t rated yet0
Look
«Дело было вечером, делать было нечего» или краткая история о сравнении производительности языков программирования

Спасибо, но это только вывод выполнения, а тут самое интересное — дампы компилятора. Вы похоже их по привычке отправили в /dev/null (

This comment wasn’t rated yet0
Look
«Дело было вечером, делать было нечего» или краткая история о сравнении производительности языков программирования

Хм, меня наоборот удивляет всего трехкратное ускорение. У меня под рукой только ноутбучный райзен, для бенчмарков такое себе, но на нем после этого изменения хаскель выполняется в районе c++/asm.


Результаты на моем железе 
> docker build -t benchmark . > /dev/null && \
> docker run --rm benchmark ghc --version && echo '' && echo '' && \
> docker run --rm --volume $(pwd):/app benchmark ghc -O /app/prime-number/haskell/cmd.hs -o /app/prime-number/haskell/cmd.hs_bin > /dev/null && \
> docker run --rm --volume $(pwd):/app benchmark bash -c 'time /app/prime-number/haskell/cmd.hs_bin 7000'

The Glorious Glasgow Haskell Compilation System, version 8.6.5

The latest prime number: 70657

real    0m9.872s
user    0m9.863s
sys     0m0.003s

> docker build -t benchmark . > /dev/null && \
> docker run --rm benchmark nasm --version && echo '' && echo '' && \
> docker run --rm --volume $(pwd):/app benchmark nasm -f elf -Ox /app/prime-number/assembler/cmd.asm && \
> docker run --rm --volume $(pwd):/app benchmark ld -O3 -m elf_i386 /app/prime-number/assembler/cmd.o -o /app/prime-number/assembler/cmd.asm_bin && \
> docker run --rm --volume $(pwd):/app benchmark bash -c 'time /app/prime-number/assembler/cmd.asm_bin 7000'

NASM version 2.14.02

The latest prime number: 000070657

real    0m9.867s
user    0m9.860s
sys     0m0.001s

> docker build -t benchmark . > /dev/null && \
> docker run --rm benchmark g++ --version && echo '' && echo '' && \
> docker run --rm --volume $(pwd):/app benchmark g++ -O0 /app/prime-number/c++/cmd.cpp -o /app/prime-number/c++/cmd.cpp_bin && \
> docker run --rm --volume $(pwd):/app benchmark bash -c 'time /app/prime-number/c++/cmd.cpp_bin 7000'

g++ (Ubuntu 9.3.0-17ubuntu1~20.04) 9.3.0
Copyright (C) 2019 Free Software Foundation, Inc.
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

The latest prime number: 70657

real    0m9.850s
user    0m9.841s
sys     0m0.002s

Если у Вас все еще "дело вечером, делать нечего", не могли бы Вы приложить вывод


ghc -O /app/prime-number/haskell/cmd.hs -o /app/prime-number/haskell/cmd.hs_bin -ddump-simpl -ddump-stg -ddump-cmm -ddump-asm -fforce-recomp -dsuppress-all -dno-suppress-idinfo -dno-suppress-type-signatures
/app/prime-number/haskell/cmd.hs_bin 7000 +RTS -s

Было бы интересно попробовать разобраться, в чем там дело.


Неплохо бы на всякий случай попробовать компилировать с -O2 вместо -O, хотя у меня это вроде ни на что не влияет.


Еще можно вместо возврата j из getJ сразу сравнивать j с двойкой и вызывать getNumber. Этим убирается нехвостовой вызов getJ из getNumber, ассемблер становится куда красивее, но разницы по времени у себя я опять же не заметил. Ну и не знаю, не слишком ли это оптимизация под конкретный язык. Хотя как вообще определять что тут оптимизированная версия, а что нет, если обе серьезно отличаются от оригинала, так как циклов нет.


Оптимизираовнный код 
import System.Environment ( getArgs )

getNumber :: Int -> Int -> Int
getNumber primeNumberCount number = if primeNumberCount == 0 then number else calcJAndRecurse 0 1
  where
    numberInc = number + 1

    calcJAndRecurse :: Int -> Int -> Int
    calcJAndRecurse j i
      | i > numberInc          = getNumber (primeNumberCount - if j == 2 then 1 else 0) numberInc
      | numberInc `rem` i == 0 = calcJAndRecurse (j + 1) (i + 1)
      | otherwise              = calcJAndRecurse j       (i + 1)

main :: IO ()
main = do
  args <- getArgs
  let primeNumberCount = if null args then 100 else read $ head args
  putStrLn $ "The latest prime number: " <> show (getNumber primeNumberCount 0)
This comment wasn’t rated yet0
Look
«Дело было вечером, делать было нечего» или краткая история о сравнении производительности языков программирования

Поправьте, пожалуйста, этот код. Так как вы нигде не указали ни одного типа, все числа дефолтятся до Integer aka BigInt, что абсолютно убивает производительность.


ghc c -Wall предупреждает о дефолтинге:


PrimesSlow.hs:24:16: warning: [-Wtype-defaults]
    • Defaulting the following constraints to type ‘Integer’
    <...>
   |
24 |             if j == 2
   |                ^^^^^^

PrimesSlow.hs:31:28: warning: [-Wtype-defaults]
    • Defaulting the following constraints to type ‘Integer’
    <...>
   |
31 |     let primeNumberCount = firstOrDefault args 100
   |                            ^^^^^^^^^^^^^^^^^^^^^^^

PrimesSlow.hs:34:47: warning: [-Wtype-defaults]
    • Defaulting the following constraints to type ‘Integer’
    <...>
   |
34 |     putStrLn ("The latest prime number: " ++ (show number))
   |                                               ^^^^^^^^^^^

Поправить можно просто написав сигнатуры с Int


Исправленный код 
import System.Environment (getArgs)

firstOrDefault :: [String] -> Int -> Int
firstOrDefault args defaultValue =
    if length args == 1
        then read (head args)
        else defaultValue

getJ :: Int -> Int -> Int -> Int
getJ j i number =
    if i > number
        then j
        else if number `rem` i == 0
                then getJ (j + 1) (i + 1) number
                else getJ j (i + 1) number

getNumber :: Int -> Int -> Int
getNumber primeNumberCount number =
    if primeNumberCount == 0
        then number
        else do
            let numberInc = number + 1
            let j = getJ 0 1 numberInc
            if j == 2
                then getNumber (primeNumberCount - 1) numberInc
                else getNumber primeNumberCount numberInc

main :: IO ()
main = do
    args <- getArgs
    let primeNumberCount = firstOrDefault args 100

    let number = getNumber primeNumberCount 0
    putStrLn ("The latest prime number: " ++ (show number))
This comment wasn’t rated yet0
Look
Типобезопасные матрицы на Haskell

Зависимых типов в хаскелле конечно нет, но при большом желании (и наличии в хабах поста хаба ненормальное программирование) в по крайней мере некотрых случаях их можно эмулировать с помощью синглтонов. Например, в строке 


transposeMatrix Nil = _

нам действительно нужно вернуть вектор Nilов длины n, и n действительно стирается в рантайме. Однако мы можем "удержать" ее, проиндексировав ею GADT и сохранив этот GADT в Matrix. 


data Nat = Zero | Succ Nat 
data SNat s where
  SZero :: SNat 'Zero
  SSucc :: SNat n -> SNat ('Succ n)

-- Библиотека singletons умеет автоматически генерировать SNat из Nat с помощью template haskell, но для наглядности изобретаю велосипед

Здесь SNat — тип-синглтон (т.е для каждого n существует только одно значение SNat n), проиндексированный типом Nat. Теперь если мы паттерн-матчим значение n типа SNat n с SZero, мы убеждаем тайпчекер в том, что в этой ветке n ~ 'Zero. Аналогично если n является SSucc (n1 :: SNat n1), то тайпчекер выводит n ~ Succ n1. Проверить можно с помощью holes:


q :: SNat n -> ()
q SZero = _zero
q (SSucc n1) = _succ

Сокращенный вывод ghc:


Found hole: _zero :: ()
Constraints include
  n ~ 'Zero

Found hole: _succ :: ()
Relevant bindings include
  n1 :: SNat n1
Constraints include
  n ~ 'Succ n1

Таким образом мы не только сохраняем тип в рантайм значение, но и можем "поднять" его обратно в тип.


Теперь мы можем сохранить n и m в виде SNat в Matrix:


data Matrix (m :: Nat) (n :: Nat) a = Matrix (SNat m) (SNat n) (Vector m (Vector n a))

Функция transposeMatrix тогда может выглядеть так:


transposeMatrix :: Matrix m n a -> Matrix n m a
transposeMatrix (Matrix m' n' vv) = Matrix n' m' (go m' n' vv)
  where
    go :: SNat m -> SNat n -> Vector m (Vector n a) -> Vector n (Vector m a)
    go SZero n Nil = replicateVec n Nil
    go _ SZero _ = Nil
    go m (SSucc n1) ((x :| xs) :| xss) = (x :| fmap headVec xss) :| go m n1 (xs :| fmap tailVec xss)

    replicateVec :: SNat n -> a -> Vector n a
    replicateVec SZero _ = Nil
    replicateVec (SSucc n) a = a :| replicateVec n a

Здесь replicateVec строит вектор длины n заданной SNat n, повторяя a. Паттерн матчингом по SNat n мы убеждаем тайпчекер в том, что мы действительно строим вектор длины n.


В функции go:


  • в первом кейсе внешний вектор Nil, поэтому m ~ 'Zero, вызываем replicateVec с длиной n, чтобы создать Vector n (Vector 'Zero a),
  • в втором кейсе n матчится с SZero, из этого n ~ Zero, достаточно вернуть Nil :: Vector 'Zero (Vector m a),
  • в третьем кейсе матрица имеет тип Vector m (Vector ('Succ n1) a), паттерн матчингом n с (SSucc n1) мы получаем SNat n1, дальше единственное изменение — передача m и n1 в рекурсивный вызов go

Собственно на этом все.


Чтобы не прописывать при конструировании Matrix длины руками, можно сделать что-то вроде такого:


class Promote (n :: Nat) where
  promote :: Proxy n -> SNat n

instance Promote 'Zero where
  promote _ = SZero

instance Promote n => Promote ('Succ n) where
  promote _ = SSucc (promote $ Proxy @n)

matrix :: (Promote n, Promote m) => Vector n (Vector m a) -> Matrix n m a
matrix = Matrix (promote Proxy) (promote Proxy)

Пример:


> transposeMatrix $ matrix ( (1 :| 2 :| 3 :| Nil) :| (4 :| 5 :| 6 :| Nil) :| Nil )

Matrix (SSucc (SSucc (SSucc SZero))) (SSucc (SSucc SZero)) ((1 :| (4 :| Nil)) :| ((2 :| (5 :| Nil)) :| ((3 :| (6 :| Nil)) :| Nil)))

Полный код 
{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeApplications,
  DerivingStrategies, StandaloneDeriving, ScopedTypeVariables #-}

import Prelude (IO, Integer, print, Show, Functor(fmap), ($), (<$>))
import Data.Proxy (Proxy(Proxy))

data Nat = Zero | Succ Nat

data SNat s where
  SZero :: SNat 'Zero
  SSucc :: SNat n -> SNat ('Succ n)

deriving stock instance Show (SNat s)

infixr 3 :|
data Vector (n :: Nat) a where
  (:|) :: a -> Vector n a -> Vector ('Succ n) a
  Nil  :: Vector 'Zero a

deriving stock instance Show a => Show (Vector n a)

data Matrix (m :: Nat) (n :: Nat) a = Matrix (SNat m) (SNat n) (Vector m (Vector n a))
  deriving stock Show

instance Functor (Vector n) where
  fmap f (v :| vs) = f v :| fmap f vs
  fmap _ Nil = Nil

instance Functor (Matrix m n) where
  fmap f (Matrix m n vs) = Matrix m n $ fmap f <$> vs

headVec :: Vector ('Succ n) a -> a
headVec (a :| _) = a

tailVec :: Vector ('Succ n) a -> Vector n a
tailVec (_ :| a) = a

transposeMatrix :: Matrix m n a -> Matrix n m a
transposeMatrix (Matrix m' n' vv) = Matrix n' m' (go m' n' vv)
  where
    go :: SNat m -> SNat n -> Vector m (Vector n a) -> Vector n (Vector m a)
    go SZero n Nil = replicateVec n Nil
    go _ SZero _ = Nil
    go m (SSucc n1) ((x :| xs) :| xss) = (x :| fmap headVec xss) :| go m n1 (xs :| fmap tailVec xss)

    replicateVec :: SNat n -> a -> Vector n a
    replicateVec SZero _ = Nil
    replicateVec (SSucc n) a = a :| replicateVec n a

class Promote (n :: Nat) where
  promote :: Proxy n -> SNat n

instance Promote 'Zero where
  promote _ = SZero

instance Promote n => Promote ('Succ n) where
  promote _ = SSucc (promote $ Proxy @n)

matrix :: (Promote n, Promote m) => Vector n (Vector m a) -> Matrix n m a
matrix = Matrix (promote Proxy) (promote Proxy)

main :: IO ()
main = print $ transposeMatrix $ matrix ( ( (1 :: Integer) :| 2 :| 3 :| Nil) :| (4 :| 5 :| 6 :| Nil) :| Nil )
Total votes 10: ↑10 and ↓0+10
Look
Сколько воды утекло? Решаем задачу лунной походкой на Haskell
А почему не использовать для поиска максимума scanl и scanr? 
highestLeft :: [Height] -> [Height]
highestLeft [] = []
highestLeft l = scanl1 max l

highestRight :: [Height] -> [Height]
highestRight [] = []
highestRight l = scanr1 max l
This comment wasn’t rated yet0
Look

Information

Rating
Does not participate
Registered
Activity

Your account

Sections

Information

Services

Support
© 2006–2025, Habr