haskell - Haskell プログラムを (ほぼ) 一定量のメモリで実行する

Question

CSV ファイルを取り込んでエラーチェックを行い、エラーメッセージを出力しようとしています。

mapM_ (appendFile filePath) ([文字列] を返す errorCheck 関数)

これは機能しますが、実行すると非常に長い CSV ではメモリが不足します。問題は、あまりにも怠惰で、何かを行う前に CSV 全体をメモリにロードしていることだと思います。BangPatterns を使用して厳密性を強制しようとしましたが、役に立たないため、正しく使用しているかどうかわかりません

より多くの情報またはコードを提供できますが、問題に関連するものがわかりません

コード：

main = do
    safeRead s = catch (readFile s) $ \_ -> return ""

    filePath <- safeRead "in.txt"
    file <- safeRead filePath

    --save the errors
    writeFile (createErrorFilePath filePath) (getFileName $ filePath ++ "\n")
    let !addToErr = do appendFile (createErrorFilePath filePath) 

    mapM_ addToErr (map ('\n':) (errorCheckFile (( \(Right x) -> x )  (parseCSV file)) (errorCheckCols (checkCols . head $ (( \(Right x) -> x )  (parseCSV file))) errorMsgs)))
    --exit with correct number
    exitWith . ExitFailure . exitCtrl $ (errorCheckFile (( \(Right x) -> x )  (parseCSV file)) (errorCheckCols (checkCols $ head $ (( \(Right x) -> x )  (parseCSV file))) errorMsgs)) 

--decides what value to exit with, depends on if errors, warnings or nothing
exitCtrl :: [String] -> Int
exitCtrl [] = 1
exitCtrl (line:rest) 
    | ("ERROR:") == take 6 line = 3
--    | elem ("WARNING:") line = 1
    | otherwise = exitCtrl rest

--gets a files name given a filepath                
getFileName :: String -> String
getFileName filePath =  reverse $ takeWhile (/= '\\') (reverse filePath)

--changes the input filepath to create a new error file at the same location
createErrorFilePath :: String -> String
createErrorFilePath pathIn = (reverse $ drop 4 (reverse pathIn)) ++ "_error_log.txt"

--check if any of the columns errored
errorCheckCols :: [Int] -> [String] -> String
errorCheckCols cols errors 
    | errorPos == Nothing = "All headings are accounted for :)"
    | otherwise = errors !! (fromJust errorPos)
        where errorPos = findIndex (== 1-2) cols

--This takes the file and if any of the columns don't exists, tells you, otherwise it error checks the database    
errorCheckFile :: [[String]] -> String -> [String]
errorCheckFile [] _ = ["ERROR: No Data"]
errorCheckFile (headings:[]) colErrorMsg = ["ERROR: No Data"]
errorCheckFile (headings:info) colErrorMsg
    | length headings > 25 = ["ERROR: Too many Columns of data"]
    | colErrorMsg == "All headings are accounted for :)" = 
            checkDB 
                info 
                (findCol "example name 1" headings 3) 
                (findCol "example name 2" headings 5) 
                (findCol "example name 3" headings 5) 
                (findCol "example name 4" headings 3) 
                (findCol "example name 5" headings 3) 
                (findCol "example name 6" headings 3) 
                (findCol "example name 7" headings 8) 
                (findCol "example name 8" headings 3) 
                (findCol "example name 9" headings 15) 
                (findCol "example name 10" headings 15) 
                (findCol "example name 11" headings 3) 
                (findCol "example name 12" headings 3) 
                (findCol "example name 13" headings 9) 
                (findCol "example name 14" headings 16) 
                (findCol "example name 15" headings 9) 
                (findCol "example name 16" headings 16) 
                (findCol "example name 17" headings 3) 
                (findCol "example name 18" headings 3) 
                (findCol "example name 19" headings 8) 
                (findCol "example name 20" headings 3) 
                ((findCol "example name 21" headings 20) + (findCol "example name 21 alt" headings 20) + 1) 
                (findCol "example name 22" headings 22) 
                (findCol "example name 23" headings 3) 
                (findCol "example name 24" headings 3) 
                (findCol "example name 25" headings 9) 
                1
    | otherwise = [colErrorMsg]



--given the inputs headings, finds the positions if each row by name 
checkCols :: [String] -> [Int]
checkCols headings = [(findCol "example name 1" headings 3),
                (findCol "example name 2" headings 5), 
                (findCol "example name 3" headings 5), 
                (findCol "example name 4" headings 3), 
                (findCol "example name 5" headings 3), 
                (findCol "example name 6" headings 3), 
                (findCol "example name 7" headings 8), 
                (findCol "example name 8" headings 3),
                (findCol "example name 9" headings 15), 
                (findCol "example name 10" headings 15), 
                (findCol "example name 11" headings 3), 
                (findCol "example name 12" headings 3), 
                (findCol "example name 13" headings 9), 
                (findCol "example name 14" headings 16), 
                (findCol "example name 15" headings 9), 
                (findCol "example name 16" headings 16), 
                (findCol "example name 17" headings 3), 
                (findCol "example name 18" headings 3), 
                (findCol "example name 19" headings 8), 
                (findCol "example name 20" headings 3), 
                ((findCol "example name 21" headings 20) + (findCol "example name 21 alt" headings 20) + 1), 
                (findCol "example name 22" headings 22), 
                (findCol "example name 23" headings 3), 
                (findCol "example name 24" headings 3), 
                (findCol "example name 25" headings 9)]


-- [[String]] Intx25 Int(count) returns a [String]
checkDB :: [[String]] -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> [String]
checkDB [] _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = ["ERROR: Filename given does not exist"]
checkDB (lastRow:[]) pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 count
    | map (toUpper) (lastRow !! pos4) == "ASD" = checkASD lastRow pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 count
    | map (toUpper) (lastRow !! pos4) == "QWE" || map (toUpper) (lastRow !! pos4) == "DPS" = checkQWE lastRow pos1 pos2 pos3  pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos18 pos19 pos24 pos25 pos17 count 
    | otherwise = ["ERROR: identifier not valid on line " ++ (show count)]
checkDB (firstRow:otherRows) pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 count
--    | count `mod` 50 == 0 = []
    | map (toUpper) (firstRow !! pos4) == "ASD" = checkASD firstRow pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 count ++ checkDB otherRows pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 (count+1)
    | map (toUpper) (firstRow !! pos4) == "QWE" || map (toUpper) (firstRow !! pos4) == "DPS" = checkQWE firstRow pos1 pos2 pos3  pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos18 pos19 pos24 pos25 pos17 count ++ checkDB otherRows pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 (count+1)
    | otherwise = ["ERROR: identifier not valid on line " ++ (show count)] ++ checkDB otherRows pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 pos24 pos25 (count+1) 

--collection of error checking methods for ASD rows
checkASD :: [String] -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> [String]
checkASD row pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos17 pos18 pos19 pos20 pos21 pos22 pos23 count
    | sum ans == 0 = []
    | (findIndex (>=20) ans /= Nothing && findIndex (>0) ans /= Nothing) = ["WARNING: At line " ++ (show count) ++ " at column(s) " ++ (show (cols!!(fromJust(findIndex (>=20) ans)) + 1))]
    | findIndex (>=20) ans /= Nothing = ["WARNING: At line " ++ (show count) ++ " at column(s) " ++ (show (cols!!(fromJust(findIndex (>=20) ans)) + 1)) ++ "\nERROR: At line " ++ (show count) ++ " at column(s) " ++ unwords( map show( map (+1) (map (cols!!) (findIndices (>0) (init ans)))))]
    | otherwise = ["ERROR: At line " ++ (show count) ++ " at column(s) " ++ unwords( map show( map (cols!!) (findIndices (>0) ans))) ]
    where 
         ans = [errorCheck (row!!pos1) ["01","02","03","04","05"],
                errorCheck (row!!pos2) ["3","4"],
                errorCheck (row!!pos3) ["1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20"],
                checkTypeLength (row!!pos5) isDigit 5,
                sum [ checkLength (row!!pos6) 12, errorCheckNL (row!!pos6) ],
                checkDate (row!!pos7),
                checkTypeLength (row!!pos8) checkSex 1,
                checkDate (row!!pos9),
                checkDate (row!!pos10),
                checkLength (row!!pos11) 5,
                checkTypeLength (row!!pos12) isDigit 5,
                checkMoney (row!!pos13),
                checkMoney (row!!pos14),
                checkMoney (row!!pos15),
                checkMoney (row!!pos16), 
                checkLength (row!!pos17) 10,
                checkLength (row!!pos18) 2,
                checkDate (row!!pos19), 
                checkTypeLength (row!!pos20) isDigit 5,
                checkTypeLength (row!!pos21) isDigit 5,
                checkLength (row!!pos22) 1,
                checkLength (row!!pos23) 1]
         cols = [pos1, pos2, pos3, pos5, pos6, pos7, pos8, pos9, pos10, pos11, pos12, pos13, pos14, pos15, pos16, pos17, pos18, pos19, pos20, pos21, pos22, pos23]
         --cols is a quick fix for finding where errors have occured

--collection of error checking methods for QWE/DPS rows
checkQWE :: [String] -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> [String]    
checkQWE row pos1 pos2 pos3 pos5 pos6 pos7 pos8 pos9 pos10 pos11 pos12 pos13 pos14 pos15 pos16 pos18 pos19 pos24 pos25 pos17 count
    | sum ans == 0 = []
    | (findIndex (>=20) ans /= Nothing && findIndex (>0) ans /= Nothing) = ["WARNING: At line " ++ (show count) ++ " at column(s) " ++ (show (cols!!(fromJust(findIndex (>=20) ans)) + 1))]
    | findIndex (>=20) ans /= Nothing = ["WARNING: At line " ++ (show count) ++ " at column(s) " ++ (show (cols!!(fromJust(findIndex (>=20) ans)) + 1)) ++ "\nERROR: At line " ++ (show count) ++ " at column(s) " ++ unwords( map show( map (+1) (map (cols!!) (findIndices (>0) (init ans)))))]
    | otherwise = ["ERROR: At line " ++ (show count) ++ " at column(s) " ++ unwords( map show (map (cols!!) (findIndices (>0) ans))) ]
    where
         ans = [errorCheck (row!!pos1) ["01","02","03","04","05","06","07","08","1","2","3","4","5","6","7","8"],
                errorCheck (row!!pos2) ["1","2","3","4"],
                errorCheck (row!!pos3) ["1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","31","32"],
                checkTypeLength (row!!pos5) isDigit 5,
                sum [ checkLength (row!!pos6) 12, errorCheckNL (row!!pos6) ],
                checkDate (row!!pos7),
                checkTypeLength (row!!pos8) checkSex 1,
                checkDate (row!!pos9),
                checkDate (row!!pos10),
                checkLength (row!!pos11) 5,
                checkTypeLength (row!!pos12) isDigit 5,
                checkMoney (row!!pos13),
                checkMoney (row!!pos14),
                checkMoney (row!!pos15),
                checkMoney (row!!pos16),
                checkLength (row!!pos18) 2,
                checkDate (row!!pos19),
                checkDate (row!!pos24), 
                checkMoney (row!!pos25),
                checkQWEpos17 (row!!pos17)]
         cols = [pos1, pos2, pos3, pos5, pos6, pos7, pos8, pos9, pos10, pos11, pos12, pos13, pos14, pos15, pos16, pos18, pos19, pos24, pos25, pos17]
         --cols is a quick fix for finding where errors have occured


--checks that a string is 'm' or 'f'
checkSex :: Char -> Bool
checkSex input 
    | toLower input == 'm' || toLower input == 'f' = True
    | otherwise = False

--finds if a row has something other than 1 type and are of a certain length
checkTypeLength :: String -> (Char -> Bool) -> Int -> Int
checkTypeLength [] _ _ = 1
checkTypeLength el isType maxSize
    | length el > 0 && length el <= maxSize && (and $ map isType el) = 0
    | otherwise = 1

--finds elements that exceed a certain length
checkLength :: String -> Int -> Int
checkLength [] _ = 1
checkLength el maxSize
    | length el <= maxSize && length el > 0 = 0
    | otherwise = 1

--finds a columns position given its name and the list of column names, else returns -1
findCol :: String -> [String] -> Int -> Int
findCol colName header unique   --unique is the number of letters of each word that need to be compared
    | findMatch /= Nothing = fromJust findMatch
    | otherwise = -1
    where findMatch = findIndex (==(map (toLower) (take unique colName))) (map (map toLower) (map (take unique) header))

--finds if a line where the element is not a letter and number ONLY, returns col num or 0
errorCheckNL :: String -> Int
errorCheckNL [] = 1
errorCheckNL (el1:el2:el3:rest)
    | isDigit el1 && isDigit el2 && isDigit el3 && and(map isLetter rest) = 0 --return Nothing?
    | otherwise = 2
errorCheckNL others = 3

-- given a row, the column num to check, options of what the column and a counter==0, returns row num or 0
errorCheck :: String -> [String] -> Int
errorCheck [] _ = 1
errorCheck el options 
    | map toLower el `elem` options = 0
    | otherwise = 1

--finds if a date is valid given a row, the column num to check and a counter=0, returns row num or 0
checkDate :: String -> Int
checkDate [] = 1
checkDate el 
    | sepPos1 == Nothing = 1 --error: this is not formated as a date, there's no separator
    | sepPos2 == Nothing = 2 --error: this is not formated as a date, there's no separator
    | day `notElem` ["1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","31"] = 3
    | (map toLower month) `notElem` ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"] = 4   --error: month is not valid
    | length (tail year) == 4 && and (map isDigit (tail year)) = 22
    | length (tail year) == 2 && and (map isDigit (tail year)) = 0
    | otherwise = 5
    where 
        sepPos1 = findIndex (== '-') el            --maybe
        (day, rest) = splitAt (fromJust sepPos1) el
        sepPos2 = findIndex (== '-') (tail rest)   --maybe
        (month, year) = splitAt (fromJust sepPos2) (tail rest)

--checks that quantities of money are presented correctly
checkMoney :: String -> Int
checkMoney [] = 4
checkMoney cash 
    | decimalPoint == Nothing && checkTypeLength cash isDigit 9 /= 0 = 1  --error: not numbers
    | decimalPoint /= Nothing && checkTypeLength (tail cents) isDigit 2 /= 0 = 2 --error: not numbers after the decimal point
    | decimalPoint /= Nothing && checkTypeLength euros isDigit 9 /= 0 = 3 --error: not numbers after the decimal point
    | otherwise = 0
    where
        decimalPoint = findIndex (== '.') cash     --maybe
        (euros, cents) = splitAt (fromJust decimalPoint) cash

score 5 · Accepted Answer

このコードのビット

(( \(Right x) -> x )  (parseCSV file))

parseCSVは、ファイル全体を消費することなく、ファイルを段階的に解析し、結果の一部を返し始めることはほとんど不可能だと述べています。そして、それは不可能です

parseCSVの結果はLeft something、不正な形式の入力のRight result場合、および整形式の入力の場合と、
整形式の場合、入力全体が消費されます

Left errorMessage完全な入力が消費される前に、解析が成功するかどうかを知ることはできないため、結果がまたはであるかどうかを判断することはできませんRight result。

また、解析結果を 2 回使用します。1 回はメッセージをログファイルに追加するため、もう 1 回は終了コードを決定するためです。2 番目の使用はそれへの参照を保持するため、それ (または、複数の評価の場合はファイルの内容) をガベージコレクションすることはできません。

別のメモとして、そのコードを 4 つの場所で使用しています。コンパイラが一般的な部分式を削除する方法に応じて、ファイルは最大 4 回解析されます。複数の評価を避けるために、解析結果を名前にバインドする方が安全です。

ファイルが適切な形式であることがわかっている場合は、ファイルを行単位などのチャンクで解析し、トラバーサルを 1 回だけ実行する (ログと終了コードの決定を組み合わせて行う) ことで、スペースの使用量を減らすことができます。そのトラバーサルに適したパターンはControl.Monad.foldM、

logAndUpdate file exitCode record = do
    appendFile file (message record)
    return $! update exitCode (exitInfo record)

主に：

exitCode <- foldM (logAndUpdate filename) 0 (parsedRecords)
exitWith $ ExitCode exitCode

行が独立している場合、同様の戦略が可能であり、不正な行の存在が前後の適切な行の処理に影響を与えないように、各行はに解析されEither ParseError Recordます。不正な行が後続の行にのみ影響し、前の行には影響しない場合でも、不正な行に遭遇したときに解析を停止するかパーサーを切り替えることで可能です。

しかし、不正な行がファイル全体を無効にする場合、多かれ少なかれ一定のスペースでそれを行うことは不可能かもしれません。1 つは整形式であることの確認用、もう 1 つは構文解析用の 2 つのパスで実行できます (予想される構造で許可されている場合)。

haskell - Haskell プログラムを (ほぼ) 一定量のメモリで実行する

1 に答える 1

Related

Reference