Генерация всех возможных функций Тьюринга типа в Haskell - PullRequest
Новая
       19

Генерация всех возможных функций Тьюринга типа в Haskell

0 голосов
/ 17 октября 2019

Я хочу перебить некоторые машины Тьюринга в Хаскеле. Эти машины Тьюринга имеют дельта-функцию типа: 

type Delta state alphabetSymbol
   = (state -> alphabetSymbol -> (alphabetSymbol, Direction, state))

, где 

data Direction
= L
| R
deriving (Eq, Show, Enum)

В конкретном примере, который я хочу описать, мои состояния и типы символов представляют собой следующие перечисления: 

data State
= Q0
| Q1
| QF
deriving (Show, Eq, Enum)

data Symbol
= Zero
| One
| Blank
deriving (Show, Eq, Enum)

Я хочу сгенерировать (почти) все возможные дельта-функции с этими типами сумм эффективно. Почти, потому что функция никогда не будет вызываться с QF как state, поэтому мне не нужно беспокоиться о QF на входе.

Я уже написал глупую функцию более высокого уровня, котораягенерирует их на основе инструкций, но в списке это выглядит просто так, что делает его довольно неэффективным. Кроме того, я хочу сделать это красиво!

1 Ответ

0 голосов
/ 19 октября 2019

Я думаю, вам следует добавить тег [turing-machines] к вашему вопросу.

Типы для машины Тьюринга:

Систему типов, вовлеченных в проблему, можно сделать более детальной. : 

import qualified  Data.List   as  L
import qualified  Data.Map    as  M
import qualified  Data.Maybe  as  Mb
import qualified  Data.Tuple  as  T


type Delta state symbol direction
    = ( state -> symbol -> (state, symbol, direction) )


data State     = Q0 | Q1 | QF        deriving (Show, Eq, Enum, Ord, Bounded)

data Symbol    = Zero | One | Blank  deriving (Show, Eq, Enum, Ord, Bounded)

data Direction = L | R               deriving (Eq, Show, Enum, Ord, Bounded)

stateList     = [minBound .. maxBound] :: [State]
symbolList    = [minBound .. maxBound] :: [Symbol]
directionList = [minBound .. maxBound] :: [Direction]

type DeltaTable =
    M.Map  (State, Symbol)   (State, Symbol, Direction)

type DeltaFunc = Delta  State Symbol Direction

tmInpList :: [ (State, Symbol) ]
tmInpList = do 
              st <- filter  (/= QF)  stateList  -- cannot start from state QF
              sy <- symbolList
              return (st, sy)

tmInpListSize = length tmInpList

tmMapInpList :: M.Map Int (State, Symbol)
tmMapInpList = M.fromList $ zip  [ 0 .. (tmInpListSize-1) ]  tmInpList

tmOutList :: [ (State, Symbol, Direction) ]
tmOutList = do 
              st  <- stateList
              sy  <- symbolList
              dir <- directionList
              return (st, sy, dir)

tmOutListSize = length tmOutList

tmMapOutList :: M.Map Int (State, Symbol, Direction)
tmMapOutList = M.fromList $ zip  [ 0 .. (tmOutListSize-1) ]  tmOutList

Приведенный выше код имеет дело с входными (State, Symbol) парами и выходными (State, Symbol, Direction) тройками. Он предоставляет списки всех возможных пар и триплетов, tmInpList и tmOutList. Таблица переходов Тьюринга отображает пары в триплеты.

Код также предоставляет вспомогательные объекты карты индексации tmMapInpList и tmMapOutList, которые отображают целочисленные ранги в пары и триплеты в соответствующих лексикографически упорядоченных списках. Причина использования целочисленной индексации заключается в том, что даже если есть возможность зацикливать триплеты напрямую, это оказалось примерно в 10 раз медленнее, чем код brute force , представленный ниже, которыйсистематически использует целочисленную индексацию.

У нас есть 2 * 3 = 6 возможных входных пар, так как состояние QF не допускается на входе. У нас есть 3 * 3 * 2 = 18 возможных триплетов на выходе. Таким образом, число возможных таблиц переходов составляет 18 ^ 6 = 34 012 224.

Код индексации и циклический код:

Для того, чтобы просмотреть все возможные таблицы переходов, мы используем целочисленные списки длиной 6, напримеркак [4,6,8,2,13,10]. Они идут от [0,0,0,0,0,0] до [17,17,17,17,17,17]. Затем эти списки преобразуются в списки триплетов.

Эти короткие целочисленные списки генерируются выражением: 

tmIndexList = sequence $ replicate 6  [ 0 .. 17 ]

Код индексации, создающий все 34 012 224 возможных карты перехода, приведен ниже: 

tmIndexList :: [[Int]]
tmIndexList = sequence $ replicate  tmInpListSize  [ 0 .. (tmOutListSize-1) ]
tmIndexListSize = length tmIndexList


deltaTableFromIndexes :: [Int] -> DeltaTable
deltaTableFromIndexes indexList =
    let outFromIndex = (\ix -> Mb.fromJust $ M.lookup ix tmMapOutList)
    in  M.fromList $ zip  tmInpList  (map  outFromIndex  indexList)


-- big list of map objects mapping (st, sy) to (st', sy', dir)
deltaTableList :: [DeltaTable]
deltaTableList = map deltaTableFromIndexes tmIndexList

-- big list of  *functions*  mapping  st sy  to  (st', sy', dir)
deltaFuncList :: [DeltaFunc]
deltaFuncList = let funcFromMap ma = (\st sy -> Mb.fromJust $ M.lookup (st,sy) ma)
                in  map funcFromMap deltaTableList

Переменная deltaTableList представляет собой список всех возможных объектов карты. Версия списка объекта карты выглядит следующим образом: 

[((Q0,Zero),(QF,Blank,R)),((Q0,One),(QF,Blank,R)),((Q0,Blank),(QF,One,R)),((Q1,Zero),(QF,Blank,L)),((Q1,One),(Q0,Blank,L)),((Q1,Blank),(QF,Blank,L))]

В тексте вопроса упоминаются функции, а не карты. Однако более практично использовать карты, поскольку вы можете переходить от карт к функциям, но не от функций к картам. Функции непрозрачны, так сказать. См. Определение deltaFuncList выше.

Основная программа:

Чтобы форсировать оценку в следующей основной программе, мы печатаем карту с рангом 34 000 000, который находится ближе к концу списка. 

prettyPrintMap :: DeltaTable -> String
prettyPrintMap ma =
    let ptrls = M.toList ma
        fn = \(p,tr) -> (show p) ++ " -> " ++ (show tr) ++ " ; "
    in  (concatMap fn ptrls)


main = do
    putStrLn $ "  tmInpListSize   = "  ++  (show tmInpListSize)
    putStrLn $ "  tmOutListSize   = "  ++  (show tmOutListSize)
    putStrLn $ "  tmIndexListSize = "  ++  (show tmIndexListSize)

    -- force printing of one transition table close to the end of the list
    let ma34m = deltaTableList !! (34*1000*1000)
    putStrLn $ "Plain  ma34m = " ++ (show ma34m)
    putStrLn $ "Pretty ma34m = " ++ (prettyPrintMap ma34m)
    putStrLn $ " "

Выполнение с краткими показателями производительности: 

$ ghc -O2 turing01.hs  -o turing01.x
$
$ time ./turing01.x +RTS -s -RTS

  tmInpListSize   = 6
  tmOutListSize   = 18
  tmIndexListSize = 34012224

Plain  ma34m = fromList [((Q0,Zero),(QF,Blank,R)),((Q0,One),(QF,Blank,R)),((Q0,Blank),(QF,One,R)),((Q1,Zero),(QF,Blank,L)),((Q1,One),(Q0,Blank,L)),((Q1,Blank),(QF,Blank,L))]
Pretty ma34m = (Q0,Zero) -> (QF,Blank,R) ; (Q0,One) -> (QF,Blank,R) ; (Q0,Blank) -> (QF,One,R) ; (Q1,Zero) -> (QF,Blank,L) ; (Q1,One) -> (Q0,Blank,L) ; (Q1,Blank) -> (QF,Blank,L) ; 

   5,873,144,856 bytes allocated in the heap
   3,516,995,416 bytes copied during GC
     886,616,408 bytes maximum residency (11 sample(s))
...

  %GC     time      76.6%  (76.6% elapsed)
  Productivity  23.4% of total user, 23.4% of total elapsed

real    0m3,692s
user    0m3,096s
sys     0m0,588s

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

...