terça-feira, 17 de novembro de 2009

Camel case stripper

Estava conversando com o Chico e ele me falou da implementação do camel case stripper que ele fez em Smalltalk.

Enquanto ele me explicava o algoritmo, pensei em como seria simples uma versão funcional e acabei escrevendo este código.


isUpper = (flip elem) ['A'..'Z']

stripCamel (x:xs)= stripCamel' xs [x] []

stripCamel' [] [] b = reverse b
stripCamel' [] a@(x:xs) b = stripCamel' [] [] ((reverse a):b)
stripCamel' (x:xs) a b | isUpper x = stripCamel' xs [x] ((reverse a):b)
| otherwise = stripCamel' xs (x:a) b


Sei lá... Parece mais simples! :-)

terça-feira, 10 de novembro de 2009

IFCP 2009 - O final

Desculpe desapontá-los, mas abandonei o projeto de terminar o problema do ICFP2009 antes do final do ano. Na verdade, fiquei um pouco aborrecido pois queria ter implementado um visualizador das órbitas, e não estou com tempo de aprender OpenGL.

Coloco aqui a última versão do código de transferência entre órbitas. O algoritmo é bastante simples: uma outra mônada RWS que envolve o IO, apenas para escrever a saída na tela. Ainda não critico o final da execução e nem escrevo o arquivo de saída no formato do problema, mas dá para se divertir vendo a distância entre o satélite e a órbita destino diminuindo!! Aproveitem!


module Main where

import System.IO
import System.Environment
import Control.Monad.RWS
import qualified Data.ByteString.Lazy as BL
import OBFFile
import Vector
import OBFProgram
import OBFData
import OVM

-- Read Write State
-- Program Time,Input Time,VMInput,Memory
type SimVM a=RWST (OVM()) [(Integer,OBFData)] (Integer,OBFData,OBFData) IO a


main::IO ()
main=do
(fn:scene:args)<-getArgs
withBinaryFile fn ReadMode (readAndRun (read scene))


readAndRun::Double->Handle->IO ()
readAndRun s h=
do
(p,d)<-readOBFFile h
let i=singleton 0x3e80 s
dum<-case s of
s | s>=1000 && s<2000 ->print "Hohmann"
s | s>=2000 && s<3000 ->print "Meet and Greet"
s | s>=3000 && s<4000 ->print "Eccentric Meet and Greet"
s | s>=4000 && s<5000 ->print "Operation Clear Skies"
s | s>=5000 && s<6000 ->print "Operation Dance with Stars"
ret<-execSim hohmannSim p i d
print ret

execSim::SimVM()->OVM()->OBFData->OBFData->IO [(Integer,OBFData)]
execSim s p i d=liftM snd $ execRWST s p (0,i,d)

hohmannSim::SimVM ()
hohmannSim=
do
i<-gets (input)
(co ,v, tgt )<-getPositionSpeedTarget
let (dv1,dv2,tof_d)=calcHohmann co tgt
let tof=floor tof_d ::Int

liftIO $ print $ "targetOrbit="++show(tgt)
liftIO $ print $ show(tgt>co)
liftIO $ print $ "currentSpeed="++show(v)
liftIO $ print $ "dV1="++show(dv1)
liftIO $ print $ "dV2="++show(dv2)
liftIO $ print $ "tof_d="++show(tof_d)
liftIO $ print $ "tof="++show(tof)
let (dx1,dy1)=colinearVector dv1 v
liftIO $ print $ "deltaVector="++show(dx1,dy1)
let i'=i `union` (fromList [(2,dx1),(3,dy1)])
applyInput i'
(_,_)<-stepOVM
applyInput i
replicateM_ (tof-4) stepOVM
(co ,v, tgt )<-getPositionSpeedTarget
let (dx2,dy2)=colinearVector dv2 v
let i'=i `union` (fromList [(2,dx2),(3,dy2)])
applyInput i'
(_,_)<-stepOVM
applyInput i
replicateM_ (1000) stepOVM
return ()
where
input (t,i,d)=i
time (t,i,d)=t
memory(t,i,d)=d


getPositionSpeedTarget::SimVM (Double, Vector Double,Double)
getPositionSpeedTarget=do
(t ,o )<-stepOVM
(t ,o')<-stepOVM
return (currOrbit o', currSpeed o o', o'!-!4)


stepOVM::SimVM (Integer,OBFData)
stepOVM=do
p<-ask
(t,i,d)<-get
let (d',o)=execOVM p d i
put ((t+1),i,d')
let co=currOrbit o
let tgto=o!-!4
liftIO $ print $ "-------------- At time "++show (t+1)++" --------------"
liftIO $ print $ "Score: "++show(o!-!0)
liftIO $ print $ "Fuel: "++show(o!-!1)
liftIO $ print $ "Position: "++show(myPosition o)
liftIO $ print $ "Current Orbit: "++show(co)
liftIO $ print $ "Target Orbit: "++show(tgto)
liftIO $ print $ "Distance to go: "++show(tgto-co)
return ((t+1),o)

applyInput::OBFData->SimVM()
applyInput=modify.changeInput
where
changeInput i (t,_,d)=(t,i,d)

myPosition::OBFData->Vector Double
myPosition = liftM2 (,) (!-!2) (!-!3)

currOrbit::OBFData->Double
currOrbit=magnitude.myPosition

currSpeed::OBFData->OBFData->Vector Double
currSpeed a b=diff (myPosition a) (myPosition b)

{- Helpful constants -}
earthMu= constG * earthM
constG = 6.67428e-11 ::Double
earthM = 6.00000e24 ::Double
earthR = 6.357e6 ::Double




{- returns the delta-vs and time of flight of a hohmann transfer
between two circular orbits. -}

calcHohmann::Double->Double->(Double,Double,Double)
calcHohmann r1 r2=(dv1,dv2,tof)
where
dv1=(f r1)*((g r2)-1)
dv2=(f r2)*(1-(g r1))
tof=pi*sqrt((a^3)/earthMu)
a=(r1+r2)/2
f x=sqrt (earthMu/x)
g x=sqrt (x/a)





PS: Vector é um type synonim para (Int,Int)!

Postagens populares