Script Programming(스크립트 프로그래밍)

      Purpose: Show hexadecimal values of the given file.
 
    Compile: ghc testHexView_02.hs
    Execute: testHexView_02 [filename]
 
    Date: 2013. 8. 20.
-}

module Main where

import System.Directory
import System.Exit
import System.IO
import System.Environment
import Text.Printf
import Data.Bits
import Data.Char (ord)
import Data.Char (chr)
import Data.Array
import Data.List

printUsage :: IO()
printUsage = putStrLn "Usage: testHexView_02 [filename]"

strDupLoop :: String -> Integer -> String -> String
strDupLoop s n t = case n == 0 of
        True -> t
        _ -> strDupLoop s (n - 1) (t ++ s)

strDup :: String -> Integer -> String
strDup s n = strDupLoop s n ""

getHexStr :: String -> Integer -> Integer -> Integer -> String -> String
getHexStr s offset k cnt t = case k == cnt of
        True -> t
        _ -> getHexStr s offset (k + 1) cnt (t ++ c0 ++ (printf "%s" (toHex (ord (s !! (fromInteger (offset + k)))))))
                       where c0 = if k == 8 then "-" else " "

getDumStr :: String -> Integer -> Integer -> Integer -> String -> String
getDumStr s offset k cnt t = case k == cnt of
        True -> t
        _ -> getDumStr s offset (k + 1) cnt (t ++ (printf "%c" a))
                 where x = (s !! (fromInteger (offset + k)))
                       a = if (ord x) < (ord ' ') || (ord x) > 0x7F
                              then '.'
                              else x

printHexTable :: String -> Integer -> Integer -> IO()
printHexTable s offset size = case offset + 16 <= size of
    True -> do putStr $ printf "%s: " (toHex8 $ fromInteger offset)
               putStr (getHexStr s offset 0 16 "")
               putStrLn $ "  |" ++ (getDumStr s offset 0 16 "") ++ "|"
               printHexTable s (offset + 16) size
    _    -> do putStr $ printf "%s: " (toHex8 $ fromInteger offset)
               putStr (getHexStr s offset 0 (size - offset) "")
               putStr (strDup "   " (16 - size + offset))
               putStr $ "  |" ++ (getDumStr s offset 0 (size - offset) "")
               putStrLn $ (strDup " " (16 - size + offset)) ++ "|"
   

toHex :: Int -> [Char]
toHex n = printf "%c%c" sx1 sx2
          where x1 = shiftR (n .&. 0xF0) 4
                x2 = n .&. 0xF
                -- sx1 = show ((ord '0') + x1)
                -- sx2 = show ((ord 'A') + x2)
                sx1  = if x1 > 9
                       then
                            ((ord 'A') + (x1 - 10))
                       else
                            ((ord '0') + x1)
                sx2 = if x2 > 9
                      then
                            ((ord 'A') + (x2 - 10))
                      else
                            ((ord '0') + x2)

toHex8 :: Int -> [Char]
toHex8 n = printf "%c%c%c%c %c%c%c%c" sx1 sx2 sx3 sx4 sx5 sx6 sx7 sx8
          where x1 = shiftR (n .&. 0xF0000000) 28
                x2 = shiftR (n .&. 0xF000000) 24
                x3 = shiftR (n .&. 0xF00000) 20
                x4 = shiftR (n .&. 0xF0000) 16
                x5 = shiftR (n .&. 0xF000) 12
                x6 = shiftR (n .&. 0xF00) 8
                x7 = shiftR (n .&. 0xF0) 4
                x8 = n .&. 0xF
                sx1  = if x1 > 9
                       then
                            ((ord 'A') + (x1 - 10))
                       else
                            ((ord '0') + x1)
                sx2 = if x2 > 9
                      then
                            ((ord 'A') + (x2 - 10))
                      else
                            ((ord '0') + x2)
                sx3 = if x3 > 9
                      then
                            ((ord 'A') + (x3 - 10))
                      else
                            ((ord '0') + x3)
                sx4 = if x4 > 9
                      then
                            ((ord 'A') + (x4 - 10))
                      else
                            ((ord '0') + x4)
                sx5 = if x5 > 9
                      then
                            ((ord 'A') + (x5 - 10))
                      else
                            ((ord '0') + x5)
                sx6 = if x6 > 9
                      then
                            ((ord 'A') + (x6 - 10))
                      else
                            ((ord '0') + x6)
                sx7 = if x7 > 9
                      then
                            ((ord 'A') + (x7 - 10))
                      else
                            ((ord '0') + x7)
                sx8 = if x8 > 9
                      then
                            ((ord 'A') + (x8 - 10))
                      else
                            ((ord '0') + x8)

       
main :: IO ()
main = do
    args <- getArgs

    if (length args == 0)
       then do printUsage
               exitWith (ExitFailure 1)
       else do

    let fname = args !! 0

    dirExist <- doesDirectoryExist fname
    if dirExist
       then do putStrLn $ printf "%s is a directory." fname
               exitWith (ExitFailure 1)
       else do

    fileExist <- doesFileExist fname
    if not fileExist
       then do putStrLn $ printf "The file \"%s\" does not exist." fname
               exitWith (ExitFailure 1)
       else do
    inh <- openFile fname ReadMode
    fsize <- hFileSize inh
    inpStr <- hGetContents inh

    putStrLn $ printf "The size of the file \"%s\" is %d." fname fsize
    putStrLn ""

    printHexTable inpStr 0 fsize

    putStrLn ""
    putStrLn $ printf "Read %d bytes." fsize

    hClose inh

module Main where

import System.Environment
import Text.Printf

arcsinh :: (RealFloat a) => a -> a
arcsinh x = w where
                      w = log (x + sqrt (x*x + 1))

arccosh :: (RealFloat a) => a -> a
arccosh x = w where
                      w = log (x + sqrt (x*x - 1))

main :: IO ()       
main = do
    let x = -0.9 :: Double
    let y = asin x
   
    printf "y = asin(%f) = %.9f\n" x y
    printf "sin(y) = sin(%.9f) = %f\n" y (sin y)
    printf "\n"
   
    let x =1.1 :: Double
    let u = acosh x
    printf "u = acosh(%.1f) = %.10f\n" x u
    let v = asinh x
    printf "v = asinh(%.1f) = %.10f\n" x v
   
    printf "cosh(u) = cosh(%.10f) = %3.1g\n" u (cosh u)
    printf "sinh(v) = sinh(%.10f) = %3.1g\n" v (sinh v)
    printf "\n"

    printf "arccosh(%.1f) = %.10f\n" x (arccosh x)
    printf "arcsinh(%.1f) = %.10f\n" x (arcsinh x)

{-
Output:
y = asin(-0.9) = -1.119769515
sin(y) = sin(-1.119769515) = -0.9

u = acosh(1.1) = 0.4435682544
v = asinh(1.1) = 0.9503469298
cosh(u) = cosh(0.4435682544) = 1.1
sinh(v) = sinh(0.9503469298) = 1.1

arccosh(1.1) = 0.4435682544
arcsinh(1.1) = 0.9503469298
-}

module Main where

import Data.Complex
import Data.Ratio
import Text.Printf
import Data.List 

-- 행렬 곱셉 함수
mmult :: Num a => [[a]] -> [[a]] -> [[a]] 
mmult a b = [ [ sum $ zipWith (*) ar bc | bc <- (transpose b) ] | ar <- a ]

-- 사용 예
main :: IO ()
main = do
    -- matrix of integers
    let test = [[1, 2], 
                  [3, 4]] `mmult` [[-3, -8, 3],
                                            [-2,  1, 4]]
    print test

    -- matrix of floats
    let test = [[1.0, 2.0], 
                    [3.0, 4.0]] `mmult` [[-3, -8, 3],
                                                   [-2,  1, 4]]
    print test

    -- matrix of fraction
    let test = [[(1 % 1),  (2 % 1)], 
                    [(3 % 1), (4 % 1)]] `mmult` [[-3, -8, 3],
                                                                [-2,  1, 4]]
    print test

    -- matrix of complex numbers
    let test = [[(1 :+ 1),  (2 :+ 1)], 
                    [(3 :+ 1), (4 :+ 1)]] `mmult` [[-3, -8, 3],
                                                                [-2,  1, 4]]
    print test

{-
실행: runhaskell testMatrixMultiplication.hs
출력:
-------------------------------------------
[[-7,-6,11],[-17,-20,25]]
[[-7.0,-6.0,11.0],[-17.0,-20.0,25.0]]
[[(-7) % 1,(-6) % 1,11 % 1],[(-17) % 1,(-20) % 1,25 % 1]]
[[(-7.0) :+ (-5.0),(-6.0) :+ (-7.0),11.0 :+ 7.0],[(-17.0) :+ (-5.0),(-20.0) :+ (-7.0),25.0 :+ 7.0]]
-}

{-#
      Filename: complexAndFraction.hs
          Testing the expressions and calculations of complex numbers and fractions in Haskell.

     Compile: ghc complexAndFraction.hs
     Execute: ./complexAndFraction

     Or
 
     Execute: runhaskell complexAndFraction.hs
#-}

module Main where

import Data.Complex
import Data.Ratio
import Text.Printf

{-#  복소수 출력하는 함수 #-}
printC :: (RealFloat a, Show a) => Complex a -> IO ()
printC a = print ((show (realPart a)) ++ " + " ++ (show (imagPart a)) ++ "j")

{-#  분수 출력하는 함수 #-}
printF :: (Integral a, Num a, Eq a, Show a) => Ratio a -> IO ()
printF a = print ((show(numerator a)) ++ "/" ++ (show (denominator a)))

{-#  (인용 부호 없이) 복소수 출력하는 함수 #-}
-- printfFraction :: (PrintfArg a, Show a, Eq a, Integral a) => Ratio a -> IO ()
printFraction :: (Show a, Integral a) => Ratio a -> IO ()
printFraction a = printf "%s/%s\n" (show (numerator a)) (show (denominator a))

{-#  (인용 부호 없이) 분수 출력하는 함수 #-}
-- printfComplex :: (Num a, RealFloat a, Show a, PrintfArg a) => Complex a -> IO ()
printComplex :: (Show a, RealFloat a) => Complex a -> IO ()
printComplex a = printf "%s + %sj\n" (show (realPart a)) (show (imagPart a))

main :: IO ()       
main = do
    -- 몫과 나머지 구하기
    print (div 5 3)
    print (mod 5 3)
    print (divMod 5 3)
    print (5 `div` 3)
    print (5 `mod` 3)
    print (5 `divMod` 3)

    -- 분수 생성과 계산
    print (5 % 3)
    print (5 % 3 * 2)
    print (5 % 3 + 2)
    print (5 % 3 + 2 % 3)

    -- 복소수 생성과  계산
    print (2 :+ 3)
    print (sqrt 2 :+ 3)
    print (sqrt (2 :+ 3))
    print (2 :+ 3 * 2)
    print ((2 :+ 3) - 2)
    print ((2 :+ 3) - (0:+2))
    print ((2 :+ 3) * (0:+2))
    print (conjugate (2 :+ 3))
    print (1 / 2 :+ 3)
    print (1 / (2 :+ 3))

    let x = 2 :+ 5
    printf "x = %s + %sj\n" (show (realPart x)) (show (imagPart x))

    -- 복소수 츨력하기 --
    printC x
    printC (conjugate x)
    printC (sin x)
    printC (asin (sin x))
    printC ((asin . sin) x)

    -- 분수 츨력하기
    let b = 2 % 3
    printF b
    printF (1/b)
    printF ((1/b)*2)

    -- (인용 부호 없이) 분수 츨력하기
    printFraction b
    printFraction (1/b)
    printFraction ((1/b)*(2%1))

    -- (인용 부호 없이) 복소수 츨력하기
    printComplex x
    printComplex (conjugate x)
    printComplex (sin x)
    printComplex (asin (sin x))
    printComplex ((asin . sin) x)
{-
------
Output:
------
1
2
(1,2)
1
2
(1,2)
5 % 3
10 % 3
11 % 3
7 % 3
2.0 :+ 3.0
1.4142135623730951 :+ 3.0
1.6741492280355401 :+ 0.8959774761298381
2.0 :+ 6.0
0.0 :+ 3.0
2.0 :+ 1.0
(-6.0) :+ 4.0
2.0 :+ (-3.0)
0.5 :+ 3.0
0.15384615384615385 :+ (-0.23076923076923078)
x = 2.0 + 5.0j
"2.0 + 5.0j"
"2.0 + -5.0j"
"67.47891523845588 + -30.879431343588244j"
"1.1415926535897933 + -5.0j"
"1.1415926535897933 + -5.0j"
"2/3"
"3/2"
"3/1"
2/3
3/2
3/1
2.0 + 5.0j
2.0 + -5.0j
67.47891523845588 + -30.879431343588244j
1.1415926535897933 + -5.0j
1.1415926535897933 + -5.0j
-}

-- Filename: solveQuadratic.hs
--    Solve a quadratic equation.
--
--   Compile: ghc solveQuadratic.hs
--   Execute: solveQuadratic 1 3 2
--
--   Or
--
--   Execute: runhaskell solveQuadratic.hs 1 3 2

{-
Compile: ghc solveQuadratic.hs
Execute & Result: solveQuadratic 1 0 4
     Quadratic Equation: 1.0x^2 + 0.0x + 4.0 = 0
     Discriminant D = -16.0
     x1 = 2.0j
     x2 = -2.0j

Or

Execute & Result: runhaskell solveQuadratic.hs 1 0 4
     Quadratic Equation: 1.0x^2 + 0.0x + 4.0 = 0
     Discriminant D = -16.0
     x1 = 2.0j
     x2 = -2.0j
-}

module Main where

import System.Environment
import Data.Complex
import Text.Printf

printUsing :: IO ()
printUsing = do
    putStrLn "Using: runhugs solveQuadratic.hs coeff2  coeff1  coeff0"
    putStrLn "Or solveQuadratic coeff2  coeff1  coeff0"
    putStrLn "Find the roots pf a quadratic equations."

printSolution :: [Char] -> Double -> Double -> IO()
printSolution msg x y = do
           if not (y == 0) && not (x == 0)
           then
               printf "%s%f + %fj\n" msg x y
           else  if not (y == 0) && (x == 0)
           then
               printf "%s%fj\n" msg y
           else
               printf "%s%f\n" msg x

printEquation :: Double -> Double -> Double -> IO()
printEquation a b c =    printf "Quadratic Equation: %fx^2 + %fx + %f = 0\n" a b c

solveEquation :: (RealFloat a) => a -> a -> a -> [Complex a]
solveEquation a b c = x1:x2:[] where
                        za = (a :+ 0)
                        zb = (b :+ 0)
                        zc = (c :+ 0)
                        discr = zb*zb - 4*za*zc
                        x1 = (-zb + sqrt (discr))/(2*za)
                        x2 = (-zb - sqrt (discr))/(2*za)

main :: IO ()       
main = do
    args <- getArgs

    if not ((length args) == 3)
        then printUsing
    else do
    let a1:b1:c1:ts = args
    let a = read a1 :: Double
    let b = read b1 :: Double
    let c = read c1 :: Double
    let d = b*b - 4.0*a*c

    printEquation a b c
    printf "Discriminant D = %g\n" d
    let sols = solveEquation a b c
    let x1:x2:x3 = sols

    printSolution "x1 = " (realPart x1) (imagPart x1)
    printSolution "x2 = " (realPart x2) (imagPart x2)

    Compile: ghc fact.hs
    Execute: main

    Date: 2010/07/20
    Author: phkim  pkim (AT) scripts.pe.kr
-}

module Main where

  factorial :: Integer -> Integer
  factorial n =  recfact 1 n

  recfact :: Integer -> Integer -> Integer
  recfact acc k = case k of
        0 -> acc
        k-> recfact (acc*k) (k - 1)

  fib :: Integer -> Integer
  fib n = fibGen 0 1 n

  fibGen :: Integer -> Integer -> Integer -> Integer
  fibGen a b n = case n of
        0 -> a
        n -> fibGen b (a + b) (n - 1)

  main :: IO ()
  main = do
        print ("Factorial(30000) has " ++ show (length (show (factorial 30000))) ++ " digits")
        print ("Fibonacci(200000) has " ++ show (length (show (fib 200000))) ++ " digits")

{-
    Expected result:
    "Factorial(30000) has 121288 digits"
    "Fibonacci(200000) has 41798 digits"
-}

 명령프롬프트> hugs
__   __ __  __  ____   ___      _________________________________________
||   || ||  || ||  || ||__      Hugs 98: Based on the Haskell 98 standard
||___|| ||__|| ||__||  __||     Copyright (c) 1994-2005
||---||         ___||           World Wide Web: http://haskell.org/hugs
||   ||                         Bugs: http://hackage.haskell.org/trac/hugs
||   || Version: 20051031       _________________________________________

Haskell 98 mode: Restart with command line option -98 to enable extensions

Type :? for help
Hugs> "2" + "5"
ERROR - Cannot infer instance
*** Instance   : Num [Char]
*** Expression : "2" + "5"

Hugs> read "2" + read "5"        -- read 는 스트링을 Int 타입으로 형변환하는 함수이다.
7
Hugs> read "2.1" + read "5"        -- read 는 스트링을 Double 타입으로 형변환하지 못한다.

Program error: Prelude.read: no parse

Hugs> read "2.1" :: Double + read "5"       -- Double 타입이라고 형을 명시적으로 지정하면 변환해준다. 그러나 구문에러이다.
ERROR - Syntax error in input (unexpected token)
Hugs> (read "2.1") :: Double + read "5"    -- 여전히 구문 에러이다.
ERROR - Syntax error in input (unexpected token)
Hugs> ((read "2.1") :: Double) + read "5"   -- 구문 에러가 해결되었다.
7.1
Hugs> (read "2.1" :: Double) + read "5"      -- 속에 있는 소괄호는 없어도 된다.
7.1
Hugs> :quit