Lego BotsをHaskellで動かす-Netwireに実装する（１）

５．Netwireに実装する

システム図ができたので、その要素をWireとして定義すればよい。上の図で、ストックは、運動量、フローは力積であった。運動量の不足と過剰（ライントレースカーが黒い線から外れようとしている）を知らせてくれるのが光センサであった。また、力積を構成する力はモータの回転速度として与えられる。そこで、ストックを制御する光センサとモータの二つの要素をWireとしてあらわす(運動量を計測する手段がないので、運動量をWireで表すことはできない）。

光センサは、赤色の光を放射し、その反射光によって、光を受けた物体の色が白なのか黒なのかを判断する（白の場合には光は反射され、黒の場合には吸収される）。従って、外部から観察すると、光センサは光の当たっている物質の表面が白なのか黒なのかを出力するデバイスと考えてよい。

そこで、表面の色をデータ型Lightで定義し、その値はWhiteかBlackと定義する。

data Light = White | Black

光センサは二つあるので、これを対として扱うことにする。対の光センサはデータ型Lightの値の対を出力するので、その型シグネチャは次のようになる。

lineSensors :: Wire s () m () (Light, Light)

モータも対であるが、光センサからの出力を受けて、モータを駆動する。従って、外側から見ると、光センサからのデータ型Lightの対を入力とするデバイスとなるので、その型シグネチャは次のようになる。

motors :: Wire s () m  (Light, Light) ()

次に、モータと光センサを具備したライントレースカーを考える。システム図は、ライントレースカーの微小時間\( \Delta t\)での振舞いを示している。即ち、\(t\)から\(t+ \Delta t\)の時間での振舞いを示している。ここでは、\(t\)時の直前に計測した光センサの出力を受けて、モータを回転させ、微小時間\( \Delta t\)経たときに光センサを観察し、その出力を次の微小時間に渡している。このため、ライントレースカーの型シグネチャは次のようになる（ここで、出力は(Light, Light)ではなく()になっていることに注意してほしい。これは次のプログラムで明らかになるが、次の微小時間を同じルーチンの中で再帰的に呼び出しているためである）。

car :: (Monad m, HasTime t s) => Wire s () m (Light, Light) ()

これまでの説明をまとめたのが下図である。

また、carの関数の方は上に説明した振舞いを素直に書けばよいので、次のようになる。なお、微小時間は50000マイクロ秒とした。

car :: (HasTime t s) => Wire s () IO (Light, Light) ()
car  = proc (left, right) -> do
  motors -< (left, right) 
  t <- time -< ()
  delay 50000 -< t
  _ <- updateValues -< ()              --要修正（真になるまで待つようにする）
  (left1, right1) <- lineSensors -< ()
  car -< (left1, right1)

それでは、光センサ、モータについても実装する。まずは光センサの方から始める。

センサーに値を設定するときは、brickPiUpdateValuesで値が設定できる状態にあるかどうかを検知しなければならない。これは、イベントの処理に当たるので、WireとしてupdateValuesを次のように用意する。

updateValues :: Wire s () IO a Bool
updateValues = mkGen_ $ \_ -> do
  result <- brickPiUpdateValues
  return $ if result == 0 then Right True else Left ()

また、センサーから値を取り出すが、これもイベントであるので、同じようにWireとしてgetValueを用意する。

getValue ::  Int -> Wire s () IO a Light
getValue a = mkGen_ $ \_ -> do
  value <- getSensor a
  return $ if value > 450 then Right Black else Right White

これを用いて、光センサの振舞いを表すlineSensorsは次のように定義できる。

lineSensors :: Wire s () IO a (Light, Light)
lineSensors = proc _ -> do
  left <- getValue port_4 -< ()
  right <- getValue port_1 -< ()
  returnA -< (left, right)

上記のプログラムで、左側の光センサはBrickPiのport_4に右側はport_1に接続してある。また、反射光の値が450以下の時は白の、そうでないときは黒の物体からの反射と見なしている。また、計測できないときは再度繰り返す。

モータの方は、光センサからの出力をパターン分けし、前回説明した判断によりモータの回転を決定する。なお、左側のモータはport_cに、右側はport_bに接続されている。また、モーターの速度の設定もイベントとなるので、これはイベントsetValueとして用意すると次のようになる。

setValue ::   Int -> Int -> Wire s () IO a ()
setValue p v = mkGen_ $ \_ -> do
  _ <- setMotorSpeed p v 
  return $ Right ()

モータの振舞いmotorsは次のようになる。

motors :: Wire s () IO (Light, Light) ()
motors = proc (left, right) -> do
  case (left, right) of
    (White, White) -> do
      _ <- setValue port_c highSpeed -< ()
      _ <- setValue port_b highSpeed -< ()
      returnA -< ()
    (Black, White) -> do
      _ <- setValue port_c lowSpeed -< ()
      _ <- setValue port_b highSpeed -< ()
      returnA -< ()
    (White, Black) -> do
      _ <- setValue port_c highSpeed -< ()
      _ <- setValue port_b lowSpeed -< ()
      returnA -< ()
    (_, _) -> do
      _ <- setValue port_c lowSpeed -< ()
      _ <- setValue port_b lowSpeed -< ()
      returnA -< ()

最後に初期化するプログラムが必要となる。BrickPiが準備できているかどうかを調べるイベントsetupを用意する。

setup :: Wire s () IO a Bool
setup = mkGen_ $ \_ -> do
  result <- brickPiSetup
  return $ if result == 0 then Right True else Left ()

アドレスをセットするイベントsetAddrは次のようになる。

setAddr :: Int -> Int -> Wire s () IO a ()
setAddr p v = mkGen_ $ \_ -> do
  _ <- setAddress p v 
  return $ Right ()

センサーのタイプをセットするイベントsetTypeは次のようになる。

setType :: Int -> Int -> Wire s () IO a ()
setType p v = mkGen_ $ \_ -> do
  _ <- setSensorType p v 
  return $ Right ()

モータを使えるようにするイベントsetEnableは次のようになる。

setEnable :: Int -> Int -> Wire s () IO a ()
setEnable p v = mkGen_ $ \_ -> do
  _ <- setMotorEnable p v 
  return $ Right ()

モータを使えるようにするイベントsetupSensorsは次のようになる。

setupSensors :: Wire s () IO a ()
setupSensors = mkGen_ $ \_ -> do
  _ <- brickPiSetupSensors 
  return $ Right ()

これらを用いて、センサーやモータをセットする。

initialize :: (HasTime t s)  => Wire s () IO a ()
initialize = proc _ -> do
  result <- setup -< ()
  case result of
    True -> do
      _ <- setAddr 0 1 -< ()
      _ <- setAddr 1 2 -< ()
      _ <- setType port_4 type_sensor_light_on -< ()  -- left Sensor (White=355, Black=563)
      _ <- setType port_1 type_sensor_light_on -< ()    -- right Sensor
      _ <- setEnable port_c 1 -< ()                     -- left Motor
      _ <- setEnable port_b 1 -< ()                     -- right Sensor
      _ <- setupSensors -< ()
      t <- time -< ()
      _ <- delay 10000 -< t
      returnA -< ()
  returnA -< ()

主プログラムは次のようになる。

main1 :: (HasTime t s) => Wire s () IO a ()
main1 = proc _ -> do
  initialize -< ()
  car  -< (White, White)

main :: IO () 
main = do
  testWireM liftIO  clockSession_ main1

また、以下のモジュールをインポートする必要がある。

{-# LANGUAGE Arrows, ForeignFunctionInterface #-}

import Control.Wire
import FRP.Netwire
import BrickHs
import System.IO

ここまで出来上がったのだが、NetwireがRaspberry Piにインストールすることができない。原因は、profunctorのモジュールを実装しようとすると、対応していないOSということでこのモジュールを拒絶するためである。profunctorはarm64に対応するようになっているので、Raspberry PiのOSも受け付けるように記述を修正すればよいのだが、これについては時間がかかりそうである。そこで、修正がすむまでの仮のプログラムとして以下のものを用意した。

Netwireでのプログラムと比較すると、入出力の関係が不明瞭になり、表現能力では劣っていることが分かる。環境に合わせて、モータの回転速度のhighSpeedとlowSpeedを変化させ、安定な値を求めることが残された作業である。

後記：Raspberry Pi 2では、Ubuntu Mateを利用することができる（実は、Windows 10も可能）。これだと、Haskell-Platformを実装することが可能なので、Netwireは問題なく利用できる。しかし、BrickPiの方がUbuntuに対応していない。いずれ、対応したものが出てくると思うので、それまで待つこととする。

{-# LANGUAGE ForeignFunctionInterface #-}

{-# LANGUAGE ForeignFunctionInterface #-}

import BrickHs
import Control.Concurrent.Thread.Delay
import System.IO

data Light = Black | White deriving (Show, Eq)

highSpeed = 200
lowSpeed = 50

initialize :: IO ()
initialize = do
  result <- brickPiSetup
  print "BrickPiSetup: "
  print (show result)
  if result /= 0 then 
      return () 
    else do
      setAddress 0 1
      setAddress 1 2
      setSensorType port_4 type_sensor_light_on  -- left Sensor (White=355, Black=563)
      setSensorType port_1 type_sensor_light_on  -- right Sensor
      setMotorEnable port_c 1                     -- left Motor
      setMotorEnable port_b 1                     -- right Sensor
      result1 <- brickPiSetupSensors
      print "BrickPiSetupSensors:" 
      print (show result1)
      delay 10000
      return ()

lineSensors :: IO (Light, Light)
lineSensors = do
  left  <- getSensor port_4
  right <- getSensor port_1
  print ("left=" ++ (show left)  ++ " right=" ++ (show right))
  return (if left > 450 then Black else White, if right > 450 then Black else White)

motors :: Light -> Light -> IO () 
motors l r
  | l == White && r == White = do setMotorSpeed port_c highSpeed 
                                  setMotorSpeed port_b highSpeed 
  | l == Black && r == White = do setMotorSpeed port_c lowSpeed
                                  setMotorSpeed port_b highSpeed
  | l == White && r == Black = do setMotorSpeed port_c highSpeed
                                  setMotorSpeed port_b lowSpeed
  | otherwise                = do setMotorSpeed port_c lowSpeed
                                  setMotorSpeed port_b lowSpeed

car :: Light -> Light -> IO ()
car left right = do
  motors left right
  delay 50000
  result <- brickPiUpdateValues
  print ("Results: " ++ (show result)) 
  (left1, right1) <- lineSensors
  car left1 right1

main :: IO ()
main = do
  initialize
  car White White