1 -- Glasgow Haskell 0.403 : FINITE ELEMENT PROGRAM V2 2 -- ********************************************************************** 3 -- * * 4 -- * FILE NAME : database_array.hs DATE : 13-3-1991 * 5 -- * * 6 -- * CONTENTS : Database of source data implemented by array data type. * 7 -- * * 8 -- * CHANGES : * 9 -- * 1. Mon May 27 11:27:43 BST 1991 * 10 -- * Not to scan the source data more times than needed. * 11 -- ********************************************************************** 12 13 module Database(idatabase,rdatabase) where 14 import Array 15 import Char (isDigit) 16 17 idatabase :: [Char] -> Array Int Int 18 19 idatabase s = listArray (0,n-1) il 20 where 21 il = isource s 22 n = length il 23 24 rdatabase :: [Char] -> Array Int Float 25 26 rdatabase s = listArray (0,n-1) rl 27 where 28 rl = rsource s 29 n = length rl 30 31 isource :: [Char] -> [Int] 32 33 isource s = fst (irsource s) 34 35 rsource :: [Char] -> [Float] 36 37 rsource s = snd (irsource s) 38 39 irsource s = intreal (words s) 40 41 intreal [] = ([], []) 42 intreal (x:ls) = if (elem '.' x) then (idb, (realreal x) : rdb) 43 else ((intint x) : idb, rdb) 44 where 45 (idb,rdb) = intreal ls 46 47 {- Mon May 27 11:27:43 BST 1991 48 isource :: [Char] -> [Int] 49 50 isource s = 51 map intint (filter (\x -> not (elem '.' x) ) (words s) ) 52 -} 53 54 intint :: [Char] -> Int 55 56 intint (c:x) = 57 if (c == '-') then ( - 1 ) * (stoi x) 58 else if (c=='+') then stoi x 59 else stoi (c:x) 60 61 stoi :: [Char] -> Int 62 stoi s = stoi' (reverse s) 63 64 stoi' [] = 0 65 stoi' (c:ls) = (stoi' ls) * 10 + ctoi c 66 67 ctoi c = 68 if ( c =='0' ) then 0 69 else if ( c == '1') then 1 70 else if ( c == '2') then 2 71 else if ( c == '3') then 3 72 else if ( c == '4') then 4 73 else if ( c == '5') then 5 74 else if ( c == '6') then 6 75 else if ( c == '7') then 7 76 else if ( c == '8') then 8 77 else 9 78 79 80 {- Mon May 27 11:27:43 BST 1991 81 rsource :: [Char] -> [Float] 82 83 rsource s = 84 map realreal (filter (\x -> elem '.' x) (words s) ) 85 -} 86 87 realreal :: [Char] -> Float 88 89 realreal (c:x) = 90 if (c=='-') then ( - 1.0 ) * ( stor x ) 91 else if (c=='+') then stor x 92 else stor (c:x) 93 94 stor :: [Char] -> Float 95 stor s = (intpart s) + (floatpart s) 96 97 intpart :: [Char] -> Float 98 intpart x = intpart' (takeWhile isDigit x) 99 100 intpart' :: [Char] -> Float 101 intpart' s = intparts (reverse s) 102 103 intparts [] = 0.0 104 105 intparts (c : s) = 106 (intparts s) * 10.0 + intpartss c 107 108 intpartss c = 109 if ( c =='0' ) then 0.0 110 else if ( c == '1') then 1.0 111 else if ( c == '2') then 2.0 112 else if ( c == '3') then 3.0 113 else if ( c == '4') then 4.0 114 else if ( c == '5') then 5.0 115 else if ( c == '6') then 6.0 116 else if ( c == '7') then 7.0 117 else if ( c == '8') then 8.0 118 else 9.0 119 120 floatpart :: [Char] -> Float 121 floatpart x = floatpart' (drop 1 ( dropWhile isDigit x ) ) 122 123 floatpart' :: [Char] -> Float 124 floatpart' s = (intpart' s) / (e10 (length s)) 125 126 e10 0 = 1.0 127 e10 i = 10.0 * (e10 (i - 1)) 128 129