Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

updates

  • Loading branch information...
commit 5fc7a5aeabee3d8a83163dde0829b5f8501712b8 1 parent 28e4a98
@kirel authored
View
15 Classifier.hs
@@ -10,7 +10,9 @@ module Classifier
import Control.Monad
import Control.Concurrent.STM
-import Data.Heap
+import Control.Parallel.Strategies
+import Control.Parallel
+-- import Data.Heap
import Data.List (foldl', sortBy, sort)
import qualified Data.Map as Hash
import Data.Maybe
@@ -44,6 +46,8 @@ data Classifier a = Classifier {
data Score = Score { id :: String, score :: Double } deriving (Show)
type Results = [Score]
+pmap = (parMap rwhnf)
+
-- helper
updateTVar :: TVar a -> (a -> a) -> STM ()
updateTVar var f = readTVar var >>= (writeTVar var) . f
@@ -87,6 +91,13 @@ getSamples (Classifier _ t) = atomically $ readTVar t
classifyWithClassifier :: Sample s => Classifier s -> s -> IO Results
classifyWithClassifier c@(Classifier k t) unknown = do
samples <- getSamples c
- return $ map toScore $ sort $ Hash.elems $ Hash.map bestHit samples where
+ return $ map toScore $ sort $ pmap bestHit $ Hash.elems $ samples where
toScore hit = Score ((fromJust.identifier.sample) hit) (samplescore hit)
bestHit = minimum . (map (\next -> Hit (distance unknown next) next))
+ -- bestHit = avgminimum2 . (map (\next -> Hit (distance unknown next) next))
+ avgminimum2 unsorted = merge m m' m'' where
+ m = head sorted
+ m' = (head.tail) sorted
+ m'' = (head.tail.tail) sorted
+ sorted = sort unsorted
+ merge (Hit d1 s) (Hit d2 _) (Hit d3 _) = Hit ((d1+d2+d3)/3) s
View
BIN  Webserver
Binary file not shown
View
14 Webserver.hs
@@ -3,6 +3,7 @@ module Main where
import Hack.Handler.Happstack
import qualified Hack.Contrib.Request as Request
import qualified Hack.Contrib.Response as Response
+import Hack.Contrib.Middleware.UTF8Body
import Network.Loli hiding(mime)
import Network.Loli.Utils
@@ -31,8 +32,16 @@ classifier = newClassifier cK
--
-- sort = sortBy ord
+alpha = 2*pi*15/360
+
sanitize :: Strokes -> Strokes
-sanitize = (map (unduplicate.redistribute 10.refit (0,0,1,1).smooth.unduplicate)).limit 10
+sanitize = (map (dominant alpha
+ .unduplicate
+ .redistribute 10
+ .aspectrefit (Point (0,0), Point (1,1))
+ .smooth
+ .unduplicate)
+ ).limit 10
process :: Strokes -> Strokes
process = sanitize
@@ -60,7 +69,7 @@ jsonerror e = do
json $ toJSObject [("error", e)]
jsonmessage m = json $ toJSObject [("message", m)]
-serverinfo = json $ toJSObject [("server", "Not Betty :("), ("version", "0.0.1")]
+serverinfo = json $ toJSObject [("server", "Nöt Betty :("), ("version", "0.0.1")]
classify c d =
either
@@ -84,6 +93,7 @@ main = do
c <- classifier
run . loli $ do
+ middleware utf8_body
get "/" $ do
serverinfo
View
10 Websockets.hs
@@ -13,11 +13,17 @@ import Classifier
-- setup classifier
-cK = 20
+cK = 50
classifier = newClassifier cK
sanitize :: Strokes -> Strokes
-sanitize = (map (unduplicate.redistribute 20.refit (0,0,1,1).smooth.unduplicate)).limit 10
+sanitize = (map (dominant alpha
+ .unduplicate
+ .redistribute 10
+ .aspectrefit (Point (0,0), Point (1,1))
+ .smooth
+ .unduplicate)
+ ).limit 10
process :: Strokes -> Strokes
process = sanitize
Please sign in to comment.
Something went wrong with that request. Please try again.