diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,3 +1,9 @@
+## 0.2.0
+
+* Fix bug of rotation
+* Add RFunctor to define Functor for Data.Set and other data.
+* Add sample in cabal
+
 ## 0.1.0
 
 * First Release
diff --git a/Language/Cube.hs b/Language/Cube.hs
--- a/Language/Cube.hs
+++ b/Language/Cube.hs
@@ -1,39 +1,111 @@
-{-#LANGUAGE OverloadedStrings#-}
-{-#LANGUAGE InstanceSigs#-}
-{-#LANGUAGE Rank2Types#-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE IncoherentInstances  #-}
+{-# LANGUAGE StandaloneDeriving  #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Language.Cube (
-  ToSTL(..)
+  RSTL(..)
+, Stl
+, ToStl(..)
+, Conjugate(..)
+, Delta(..)
+, RFunctor(..)
 , Quaternion(..)
 , Cube
 , Block(..)
-, smap
+, toSTL
+, toCube
 , block
 , cube
+, compaction
+, flipTriangle
 , writeFileStl
-, ds
-, dx
-, dy
-, dz
-, dr
+, writeFileStlWithText
+, printStl
 , nCube
 , surface'
 , surface
-, house
 ) where
 
 import qualified Data.Serialize as C
 import Data.Monoid
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Builder as BL
 import Graphics.Formats.STL
+import Control.Monad
 
-class ToSTL a where
-  toSTL :: a -> STL
+-- | Ristricted STL
+-- This is the almost same as STL of Graphics.Formats.STL.
+-- This is used to instantiate RFunctor of STL.
+-- RFunctor provides a function(rfmap) like fmap of Functor.
+data RSTL a =
+  Stl {
+    stlData :: STL
+  }
 
+-- | Wrapper of RSTL
+type Stl = RSTL Triangle
+
+-- | Generate Ristricted STL
+class ToStl a where
+  toStl :: a -> Stl
+
+-- | Generate STL from Ristricted STL
+toSTL :: ToStl a => a -> STL
+toSTL a = stlData $ toStl a
+
+-- | class type of mathematical conjugate
+class Conjugate a where
+  conjugate :: a -> a
+
+-- | Delta move and rotation for quaternion
+class (Num a) => Delta a where
+  -- | delta for x axis
+  dx :: a
+  -- | delta for y axis
+  dy :: a
+  -- | delta for z axis
+  dz :: a
+  -- | delta for real part of quaternion
+  ds :: a
+  -- | cons (theta/2) + i sin (theta/2) + j sin (theta/2)  + k sin (theta/2)  of  quaternion
+  dr :: Float -- ^ radian
+     -> a    -- ^ axes of routation
+     -> a
+  -- | Routation for quaternion
+  dR :: Float -- ^ radian
+     -> a    -- ^ axes of routation
+     -> a    -- ^ Input Vector
+     -> a
+  -- | Routation for quaternion
+  -- This is the same as dR.
+  rotate :: Float -- ^ radian
+         -> a    -- ^ axes of routation
+         -> a    -- ^ Input Vector
+         -> a
+  rotate = dR
+
+-- | Ristricted Functor
+class RFunctor f a b where
+  rfmap :: (a -> b) -> f a -> f b
+
+-- | Functor of Set
+instance (Ord a, Ord b) => RFunctor S.Set a b where
+  rfmap = S.map
+
+instance (Functor m) => RFunctor m a b where
+  rfmap = fmap
+
+instance RFunctor RSTL Triangle Triangle where
+  rfmap func (Stl stl) = Stl $ stl {triangles = map func (triangles stl)}
+
 -- | Unit element of Cube.
 -- 
 -- This is the same as quaternion.
@@ -44,13 +116,32 @@
 , uz :: a
 } deriving (Show,Eq,Ord)
 
-type Cube = Quaternion Int
+type Cube = Quaternion Float
 
+instance Functor Quaternion where
+  fmap func Quaternion{..} = Quaternion (func us) (func ux) (func uy) (func uz)
+
+instance Num a => Conjugate (Quaternion a) where
+  conjugate (Quaternion s x y z) = Quaternion s (-x) (-y) (-z)
+
+instance Delta Cube where
+  dx = Quaternion 0 1 0 0
+  dy = Quaternion 0 0 1 0
+  dz = Quaternion 0 0 0 1
+  ds = Quaternion 1 0 0 0
+  dr theta (Quaternion _s x y z) =  Quaternion (co 1) (si x) (si y) (si z)
+    where
+      co :: Float -> Float
+      co v = cos (theta/2) * v
+      si :: Float -> Float
+      si v = sin (theta/2) * v
+  dR theta a i = let r = (dr theta a)
+                     tmp = fmap round (r * i * conjugate r) :: Quaternion Integer
+                 in fmap fromIntegral tmp
 instance (Num a) => Monoid (Quaternion a) where
   mappend a b = a + b 
   mempty = Quaternion 0 0 0 0
 
-
 instance (Num a) => Num (Quaternion a) where
   (+) (Quaternion ax ay az ar) (Quaternion bx by bz br) =
     Quaternion (ax+bx) (ay+by) (az+bz) (ar+br)
@@ -66,8 +157,6 @@
   signum (Quaternion ax ay az ar) = Quaternion (signum ax) (signum ay) (signum az) (signum ar)
   fromInteger a = Quaternion (fromIntegral a) 0 0 0
 
---norm2 :: Quaternion a -> a
---norm2 (Quaternion s x y z) = s*s + x**n + y**n + z**n
 
 -- | Set of Cube.
 -- This supports boolean operations on polygons.
@@ -86,131 +175,126 @@
     au <- S.toList a
     bu <- S.toList b
     return (au + bu)
-  abs (Block a) = Block $ S.map abs a
-  signum (Block a) = Block $ S.map signum a
+  abs (Block a) = Block $ rfmap abs a
+  signum (Block a) = Block $ rfmap signum a
   fromInteger a = Block $ S.singleton $ fromInteger a
 
--- | map for Block.
-smap :: (Ord a,Ord b) => (a -> b) -> Block a -> Block b
-smap func (Block elems) = Block $ S.map func elems
+instance (Ord a, Ord b) => RFunctor Block a b where
+  rfmap func Block{..} = Block $ rfmap func units
 
+instance Num STL where
+  (+) (STL an atri) (STL _bn btri) = STL an $ S.toList $ S.fromList (atri ++ btri)
+  (-) (STL an atri) (STL _bn btri) = STL an $ S.toList $ S.fromList atri S.\\ S.fromList btri
+  (*) _ _ = error "(*) is not defined for STL"
+  abs _ = error "abs is not defined for STL"
+  signum _ = error "signum is not defined for STL"
+  fromInteger _ = error "fromInteger is not defined for STL"
+
+instance Num Stl where
+  (+) (Stl a) (Stl b) = Stl $ a + b
+  (-) (Stl a) (Stl b) = Stl $ a - b
+  (*) _ _ = error "(*) is not defined for STL"
+  abs _ = error "abs is not defined for STL"
+  signum _ = error "signum is not defined for STL"
+  fromInteger _ = error "fromInteger is not defined for STL"
+
 -- | Utility function of generating Block from list of cube
 block :: (Ord a) => [a] -> Block a
 block elems = Block $ S.fromList elems
 
 -- | Utility function of Cube 0 x y z
 cube :: Int -> Int -> Int -> Cube
-cube x y z = Quaternion 0 x y z
+cube x y z = Quaternion 0 (fromIntegral x) (fromIntegral y) (fromIntegral z)
 
+-- | Utility function of generating Cube from list of Int
 toCube :: [Int] -> Cube
-toCube [s,a,b,c] = Quaternion s a b c
+toCube [s,x,y,z] = Quaternion (fromIntegral s) (fromIntegral x) (fromIntegral y) (fromIntegral z)
 toCube [a,b,c] = cube a b c
 toCube _ = error "toCube"
 
+-- | Flip rotation of triangle
+flipTriangle :: Triangle -> Triangle
+flipTriangle (Triangle m (x,y,z)) = Triangle m (x,z,y)
 
+deriving instance (Ord Triangle)
+deriving instance (Eq Triangle)
+deriving instance (Show Triangle)
 
-instance ToSTL (Quaternion Int) where
-  toSTL v = STL "" $ flip map tri2 $ \[t0,t1,t2] ->
+instance ToStl STL where
+  toStl a = Stl a
+
+instance ToStl Stl where
+  toStl a = a
+
+instance Monoid STL where
+  mappend (STL an at) (STL _bn bt) = STL an (at<>bt)
+  mempty = STL "" []
+
+instance Monoid Stl where
+  mappend (Stl a) (Stl b) = Stl (a<>b)
+  mempty = Stl mempty
+
+instance ToStl Cube where
+  toStl v = Stl $ STL "" $ flip map tri2 $ \[t0,t1,t2] ->
       Triangle Nothing (
          ve (t0 + v),
          ve (t1 + v),
          ve (t2 + v))
     where
-      ve (Quaternion _s a b c) = (fromIntegral a,fromIntegral b,fromIntegral c)
+      ve (Quaternion _s a b c) = (a,b,c)
       vec [a,b,c] =
         case (b-a)*(c-a) + a of
           Quaternion _s x y z | 0 <= x && x <=1  &&0 <= y && y <=1  && 0 <= z && z <=1 -> True
                               | otherwise -> False
       vec _ = error "vec"
-      tri =  [map toCube [a,b,c] |
-              a <- [[0,0,0],[0,1,1],[1,0,1],[1,1,0]],
-              b <- cube0,
-              c <- cube0,
-              dist a b == 1,
-              dist a c == 1,
-              dist b c == 2,
-              b < c ]
-      
+      o1  = [mempty,mempty + dx,mempty + dy]
+      o2 = [mempty+dx+dy,mempty + dx,mempty + dy]
+      o3 = map (+ dz) o1
+      o4 = map (+ dz) o2
+      o5 = map (dR (pi/2) dx) o1
+      o6 = map (dR (pi/2) dx) o2
+      o7 = map (+ dy) o5
+      o8 = map (+ dy) o6
+      o9 = map (dR (-pi/2) dy) o1
+      o10 = map (dR (-pi/2) dy) o2
+      o11 = map (+ dx) o9
+      o12 = map (+ dx) o10
+      tri = [o1,o2,o3,o4,o5,o6,o7,o8,o9,o10,o11,o12]
       tri2 = map (\l@[a,b,c] -> if vec l then [a,c,b] else [a,b,c]) tri
-      
-      cube0 = do
-        a <- [0,1]
-        b <- [0,1]
-        c <- [0,1]
-        return [a,b,c]
-      dist a b =  sum $ map abs $ map (uncurry (-)) $ zip a b
 
--- instance (Real a,Fractional a, Num a) => ToSTL (Quaternion a) where
---   toSTL v@(Quaternion _s x y z) = STL "" $ flip map tri2 $ \[t0,t1,t2] ->
---       Triangle Nothing (
---          ve (t0 + v),
---          ve (t1 + v),
---          ve (t2 + v))
---     where
---       ve (Quaternion _s a b c) = (realToFrac a,realToFrac b,realToFrac c)
---       ve _ = error ""
---       xyz = [x,y,z]
---       cubeTriangle =  [(a,b,c) | a <- [[0,0,0],[0,1,1],[1,0,1],[1,1,0]],
---                                  b <- cube0,
---                                  c <- cube0,
---                                  dist a b == 1,
---                                  dist a c == 1,
---                                  dist b c == 2,
---                                  b < c ]
---       cube0 = do
---         a <- [0,1]
---         b <- [0,1]
---         c <- [0,1]
---         return [a,b,c]
---       dist a b =  sum $ map abs $ map (uncurry (-)) $ zip a b
 
-instance (ToSTL a) => ToSTL (Block a) where
-  toSTL (Block sets) = foldr (<>) mempty $ map toSTL $ S.toList sets
-
-instance Monoid STL where
-  mappend (STL an at) (STL _bn bt) = STL an (at<>bt)
-  mempty = STL "emptry" []
+instance (ToStl a) => ToStl (Block a) where
+  toStl (Block sets) = compaction $ foldr (<>) mempty $ map toStl $ S.toList sets
 
 instance (Ord a, Monoid a) => Monoid (Block a) where
   mappend (Block a) (Block b) = Block (a<>b)
   mempty = Block $ S.singleton mempty
 
--- | Generate STL file from Block
-writeFileStl :: ToSTL a => String -> a -> IO ()
+-- | Remove redundant triangles
+compaction :: Stl -> Stl
+compaction stl =  stl - (rfmap flipTriangle stl)
+
+-- | Generate binary STL file from Block
+writeFileStl :: ToStl a => String -> a -> IO ()
 writeFileStl filename stl = BL.writeFile filename $ C.encodeLazy $ toSTL stl
 
--- | Unit vector of Z direction
-dz :: Cube
-dz = Quaternion 0 0 0 1
+-- | Generate text STL file from Block
+writeFileStlWithText :: ToStl a => String -> a -> IO ()
+writeFileStlWithText filename stl = BL.writeFile filename $ BL.toLazyByteString $ textSTL $ toSTL stl
 
--- | Unit vector of Y direction
-dy :: Cube
-dy = Quaternion 0 0 1 0
+-- | Print triangles of STL
+printStl :: ToStl a => a -> IO ()
+printStl stl = do
+  let tris = triangles $ toSTL stl
+  forM_ tris $ \t -> do
+    print $ t
 
--- | Unit vector of X direction
-dx :: Cube
-dx = Quaternion 0 1 0 0
 
--- | Unit scalar vector
-ds :: Cube
-ds = Quaternion 1 0 0 0
-
--- | Vector for generating routation vector
-dr :: Float -- ^ radian
-   -> Cube -- ^ axes of routation
-   -> Cube
-dr theta (Quaternion _s x y z) =  Quaternion (co 1) (si x) (si y) (si z)
-  where
-    co :: Int -> Int
-    co v = round $ cos theta * fromIntegral v
-    si :: Int -> Int
-    si v = round $ sin theta * fromIntegral v
-
 -- | This function genrates a cube of n-width.
 nCube :: Int -> Block Cube
 nCube n =
   let lst = [0..(n-1)]
-  in Block $ S.fromList [Quaternion 0 a b c | a <- lst,b <- lst,c <- lst]
+  in Block $ S.fromList [cube a b c | a <- lst,b <- lst,c <- lst]
 
 -- | Generate surface block.
 -- This is fast function. But shape becomes little bit bigger.
@@ -227,16 +311,3 @@
     cube2 :: Block Cube
     cube2 = block $ [Quaternion 0 x y z| x<-[-2..2], y<-[-2..2], z<-[-2..2]]
 
--- | Generate house which is for demo.
-house :: Block Cube
-house = let house''  = (house' + square)*line
-        in smap (12 * dz +)  $ surface house''
-  where
-    house' :: Block Cube
-    house' = block $ [Quaternion 0 1 x y| x<-[-10..10], y<-[-10..10], y < x , y < (-x)]
-    
-    square :: Block Cube
-    square = smap ((+) (-12 * dz)) $ block $ [Quaternion 0 1 x y| x<-[-5..5], y<-[-5..5]]
-    
-    line :: Block Cube
-    line = block $ [Quaternion 0 x 0 0 | x<-[-5..5]]
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -24,18 +24,20 @@
 
 
 ```
+import Language.Cube
+
 house :: Block Cube
 house = let house''  = (house' + square)*line
-        in smap (12 * dz +)  $ surface house''
+        in rfmap (12 * dz +) house''
   where
     house' :: Block Cube
-    house' = block $ [Cube 0 1 x y| x<-[-10..10], y<-[-10..10], y < x , y < (-x)]
+    house' = block $ [cube 1 x y| x<-[-10..10], y<-[-10..10], y < x , y < (-x)]
     
     square :: Block Cube
-    square = smap ((+) (-12 * dz)) $ block $ [Cube 0 1 x y| x<-[-5..5], y<-[-5..5]]
+    square = rfmap ((+) (-12 * dz)) $ block $ [cube 1 x y| x<-[-5..5], y<-[-5..5]]
     
     line :: Block Cube
-    line = block $ [Cube 0 x 0 0 | x<-[-5..5]]
+    line = block $ [cube x 0 0 | x<-[-5..5]]
 main :: IO ()
 main = do
   writeFileStl "house.stl" $ house
diff --git a/cube.cabal b/cube.cabal
--- a/cube.cabal
+++ b/cube.cabal
@@ -1,5 +1,5 @@
 name:                cube
-version:             0.1.0
+version:             0.2.0
 synopsis:            Cubic DSL for 3D printing
 description:         Cube is DSL for 3D printing.
                      .
@@ -31,6 +31,10 @@
   type:           git
   location:       https://github.com/junjihashimoto/cube.git
 
+flag sample
+  description: Build sample programs
+  default: False
+
 library
   exposed-modules:     Language.Cube
   -- other-modules:       
@@ -38,11 +42,29 @@
   build-depends:       base >=4 && <5
                      , STL
                      , cereal
-                     , bytestring
+                     , bytestring >= 0.10.2
                      , containers
   -- hs-source-dirs:      
   default-language:    Haskell2010
   ghc-options:       -Wall
+
+executable house
+  if flag(sample)
+    buildable: True
+  else
+    buildable: False
+  ghc-options:       -Wall
+  build-depends:       base >=4 && <5
+                     , cube
+                     , STL
+                     , cereal
+                     , bytestring
+                     , containers
+                     , hspec
+  hs-source-dirs:    sample
+  main-is:           house.hs
+  Extensions:        DeriveDataTypeable
+
 
 test-suite test
   type:              exitcode-stdio-1.0
diff --git a/sample/house.hs b/sample/house.hs
new file mode 100644
--- /dev/null
+++ b/sample/house.hs
@@ -0,0 +1,17 @@
+import Language.Cube
+
+house :: Block Cube
+house = let house''  = (house' + square)*line
+        in rfmap (12 * dz +) house''
+  where
+    house' :: Block Cube
+    house' = block $ [cube 1 x y| x<-[-10..10], y<-[-10..10], y < x , y < (-x)]
+    
+    square :: Block Cube
+    square = rfmap ((+) (-12 * dz)) $ block $ [cube 1 x y| x<-[-5..5], y<-[-5..5]]
+    
+    line :: Block Cube
+    line = block $ [cube x 0 0 | x<-[-5..5]]
+main :: IO ()
+main = do
+  writeFileStl "house.stl" $ house
diff --git a/tests/test.hs b/tests/test.hs
--- a/tests/test.hs
+++ b/tests/test.hs
@@ -2,10 +2,26 @@
 {-#LANGUAGE FlexibleContexts#-}
 {-#LANGUAGE TemplateHaskell#-}
 {-#LANGUAGE QuasiQuotes#-}
+{-#LANGUAGE ScopedTypeVariables#-}
 
 import Test.Hspec
 import Language.Cube
+import Graphics.Formats.STL
 
+-- | Generate house which is for demo.
+house :: Block Cube
+house = let house''  = (house' + square)*line
+        in rfmap (12 * dz +) house''
+  where
+    house' :: Block Cube
+    house' = block $ [cube 1 x y| x<-[-10..10], y<-[-10..10], y < x , y < (-x)]
+    
+    square :: Block Cube
+    square = rfmap ((+) (-12 * dz)) $ block $ [cube 1 x y| x<-[-5..5], y<-[-5..5]]
+    
+    line :: Block Cube
+    line = block $ [cube x 0 0 | x<-[-5..5]]
+
 main :: IO ()
 main = 
   hspec $ do
@@ -23,26 +39,33 @@
       it "-2 * dx" $ do
         (-2) * dx `shouldBe` cube (-2) 0 0 
       it "route pi/2" $ do
-        (dr (pi/2) dz) * dx `shouldBe` cube 0 1 0
+        (dR (pi/2) dz dx) `shouldBe` cube 0 1 0
       it "route pi" $ do
-        (dr (pi) dz) * dx `shouldBe` cube (-1) 0 0
+        (dR (pi) dz dx) `shouldBe` cube (-1) 0 0
       it "route 3*pi/2" $ do
-        (dr (3*pi/2) dz) * dx `shouldBe` cube 0 (-1) 0
+        (dR (3*pi/2) dz dx) `shouldBe` cube 0 (-1) 0
       it "route 2*pi" $ do
-        (dr (2*pi) dz) * dx `shouldBe` cube 1 0 0
+        (dR (2*pi) dz dx) `shouldBe` cube 1 0 0
       it "multi" $ do
-        dx * dy `shouldBe` dz
+        dx * dy `shouldBe` (dz :: Cube)
       it "multi" $ do
-        dy * dx `shouldBe` (-dz)
+        dy * dx `shouldBe` (-dz :: Cube)
     describe "Block" $ do
       it "dx" $ do
-        block [dx,dx] `shouldBe` block [dx]
+        block [dx,dx] `shouldBe` (block [dx] :: Block Cube)
       it "dx+dy" $ do
-        block [dx] + block [dy] `shouldBe` block [dx,dy]
+        block [dx] + block [dy] `shouldBe` (block [dx,dy] :: Block Cube)
       it "[dx,dy]-dy" $ do
-        block [dx,dy] - block [dy] `shouldBe` block [dx]
+        block [dx,dy] - block [dy] `shouldBe` (block [dx] :: Block Cube)
       it "convolution(dx * [-2*dx,2*dx])" $ do
-        block [dx] * block [-2*dx,2*dx] `shouldBe` block [-dx,3*dx]
+        block [dx] * block [-2*dx,2*dx] `shouldBe` (block [-dx,3*dx] :: Block Cube)
+    describe "Compaction" $ do
+      it "num triangle of one block" $ do
+        length (triangles (toSTL (block [dx] :: Block Cube))) `shouldBe` 12
+      it "num triangle of two block" $ do
+        length (triangles (toSTL (block [dx,2*dx] :: Block Cube))) `shouldBe` 20
+      it "flip triangle" $ do
+        (flipTriangle (Triangle Nothing ((5.0,0,0),(1,0,0),(2,0,0)))) `shouldBe` (Triangle Nothing ((5.0,0,0),(2,0,0),(1,0,0)))
     describe "ToSTL" $ do
       it "Block Cube" $ do
         writeFileStl "tmp.stl" (block [dx] :: Block Cube) `shouldReturn` ()