[NEM] - In his book ''Vehicles: Experiments in Synthetic Psychology''[http://www.amazon.com/exec/obidos/ASIN/0262521121/ref=ase_johnwiseman/104-0408933-4121513], Valentino Braitenberg describes some experiments involving little machines, which are made up of the following parts:

   * 2 wheels - one on the left, one on the right.
   * A number of sensors mounted on the front of the vehicle which respond to elements in the environment (heat, light, objects, etc)
   * Connections from the sensors to the motors - these connections either cut or supply power to the motors.

The vehicles are therefore quite simple reactive architectures. However, when these machines are placed into an environment, they can exhibit surprisingly complex behaviour (Braitenberg even characterised these as "Love" and "Hate" and other emotions). The interest in this from an AI point of view, is that it shows that complex behaviour may be a result of a complex environment, and not some sort of higher consciousness (in certain cases). The Braitenberg vehicles appear to have ''goals'', even though they possess no state (other than current velocities, needed for the simulation) and have no goal following architecture.

I'm not sure whether we should read too deeply into the results of these experiments, but they are fun to repeat! Here's a quick first stab at a simple simulator and a simple experiment. It has no collision detection, so the cars often move through each other or obstacles. If someone wants to add collision detection, be my guest! Just start it up and a single car will be created. A short time later another car will be created. You can add light sources by clicking on the canvas with the left mouse button, and you can add obstacles by right-clicking. You can play with the car definitions in the code to wire up new sensors and experiment!

 #!/bin/sh
 #\
 exec wish "$0" ${1+"$@"}
 
 # Simple simulation of Braitenburg vehicles. Car drawing code stolen from "Car
 # Racing in Tcl" - http://wiki.tcl.tk/4364
 package require Tk
 
 set tcl_precision 17
 
 namespace eval car {
     variable cars [list]
 }
 
 # Create a new car:
 # params:
 #   name    - a name for the car
 #   c       - the canvas to draw on
 #   color   - colo(u)r of this car
 #   angle   - initial direction of motion
 #   inputs  - list of inputs in form (e.g.):
 # left input light + -> left wheel
 proc car::new {name c x y color angle inputs} {
     variable cars
     lappend cars $name
     interp alias {} $name {} car::dispatch $name
     namespace eval $name {
         variable lspeed 10 rspeed 10
         variable ldiff 0 rdiff 0
         variable inputs [list]
     }
     namespace eval $name [list variable canvas $c angle $angle]
     interp alias {} $name: {} namespace eval ::car::$name
     $c create line $x [expr {$y + 5}] [expr {$x + 20}] [expr {$y + 5}] \
         -tag [list $name object] -width 3
     $c create line [expr {$x - 2}] [expr {$y + 40}] [expr {$x + 22}] \
         [expr {$y + 40}] -tag [list $name object] -width 3
     $c create poly [expr {$x + 2}] $y [expr {$x + 18}] $y \
         [expr {$x + 20}] [expr {$y + 50}] $x [expr {$y + 50}]\
         -fill $color -tags [list $name object]
     # Create the wheels
     wheel $name $c [expr {$x - 3}] [expr {$y + 5}]
     wheel $name $c [expr {$x + 23}] [expr {$y + 5}]
     wheel $name $c [expr {$x -5}] [expr {$y + 40}]
     wheel $name $c [expr {$x + 25}] [expr {$y + 40}]
 
     canvas'rotate $c $name $angle
 
     # Run through the inputs sections adding the inputs
     foreach line [split $inputs \n] {
         if {[regexp {(left|right|center) input (.+) (\+|-) -> (left|right) wheel} \
             $line -> iside type posneg wside]} {
             # Create the input
             lappend ${name}::inputs [list $iside $type $posneg $wside]
         }
     }
 }
 
 proc car::wheel {name c x y} {
     set dx 3; set dy 6
     set x0 [expr {$x - $dx}]
     set y0 [expr {$y - $dy}]
     set x1 [expr {$x + $dx}]
     set y1 [expr {$y + $dy}]
     $c create poly $x0 $y0 $x0 $y1 $x1 $y1 $x1 $y0 -fill black \
         -tag [list $name object]
 }
 
 proc car::dispatch {name cmd args} {eval ::car::$cmd $name $args}
 
 proc car::move {} {
     variable cars
     foreach name $cars {
         set c [$name: set canvas]
         # Work out the change in angle, by comparing the left and right wheel
         # speeds.
         set angle [$name: set angle]
         set rspeed [expr {[$name: set rspeed] + [$name: set rdiff]}]
         set lspeed [expr {[$name: set lspeed] + [$name: set ldiff]}]
         set nangle [expr {($rspeed - $lspeed)/5.}]
         # Mean speed
         set speed [expr {($rspeed + $lspeed)/2.}]
         canvas'rotate $c $name $nangle
         $name: set angle [expr {$angle + $nangle}]
         set dx [expr {-$speed * sin([$name: set angle])}]
         set dy [expr {-$speed * cos([$name: set angle])}]
         $c move $name $dx $dy
 
         # Turn back from walls
         foreach {x0 y0 x1 y1} [$c bbox $name] { break }
         if {$x0 < 0} {
             $c move $name [$c cget -width] 0
         }
         if {$x1 > [$c cget -width]} {
             $c move $name -[$c cget -width] 0
         }
         if {$y0 < 0} {
             $c move $name 0 [$c cget -height]
         }
         if {$y1 > [$c cget -height]} {
             $c move $name 0 -[$c cget -height]
         }
 
         # Find nearby objects and adjust speeds appropriately
         # Work out position of left and right inputs
         foreach {x y} [canvas'center $c $name] { break }
         # Precomputed hypot and angle to corners
         set hypot 50.0
         set phi   0.411516846067
         set rx [expr {$x + $hypot * sin([$name: set angle] + $phi)}]
         set ry [expr {$y + $hypot * cos([$name: set angle] + $phi)}]
         set lx [expr {$x + $hypot * sin([$name: set angle] - $phi)}]
         set ly [expr {$y + $hypot * cos([$name: set angle] - $phi)}]
         set cx [expr {$x + $hypot * sin([$name: set angle])}]
         set cy [expr {$y + $hypot * cos([$name: set angle])}]
         array set totals {
             right,inputs    0
             left,inputs     0
             right,total     0
             left,total      0
         }
         foreach item [$name: set inputs] {
             foreach {iside type posneg wside} $item { break }
             # Find all overlapping items of the right type in a certain radius
             # (50 pixels)
             set start {}
             if {"$iside" == "left"} {
                 set sx $lx
                 set sy $ly
             } elseif {"$iside" == "right"} {
                 set sx $rx
                 set sy $ry
             } else {
                 # Center
                 set sx $cx
                 set sy $cy
             }
             set closest [$c find closest $sx $sy 100]
             while {$closest != $start} {
                 # Check the tag
                 if {[lsearch [$c gettags $closest] $name] == -1} {
                 if {[lsearch [$c gettags $closest] $type] > -1} {
                     # Find distance from sensor
                     foreach {ox oy} [canvas'center $c $closest] { break }
                     set distance [expr {150 - hypot(abs($ox-$sx),abs($oy-$sy))}]
                     # Add to total
                     set totals($wside,total) [expr $totals($wside,total) \
                             $posneg $distance]
                     incr totals($wside,inputs)
                 }
                 }
                 if {![string length $start]} { set start $closest }
                 set closest [$c find closest $sx $sy 100 $closest]
             }
         }
         if {$totals(right,inputs) > 0} {
             set dr [expr {$totals(right,total) / $totals(right,inputs)}]
             $name: set rdiff [expr {$dr / 10.0}]
         } else {
             $name: set rdiff 0
         }
         if {$totals(left,inputs) > 0} {
             set dl [expr {$totals(left,total) / $totals(left,inputs)}]
             $name: set ldiff [expr {$dl / 10.0}]
         } else {
             $name: set ldiff 0
         }
     }
 }
 
 proc object {c x y type} {
     switch $type {
         object  { set color blue }
         light   { set color yellow }
     }
     $c create oval $x $y [expr {$x + 20}] [expr {$y + 20}] \
         -fill $color -tags $type
 }
 
 proc canvas'center {w tag} {
     foreach {x0 y0 x1 y1} [$w bbox $tag] { break }
     list [expr {($x0 + $x1) / 2.}] [expr {($y0 + $y1) / 2.}]
 }
 
 proc canvas'rotate {w tag angle} {
     foreach {xm ym} [canvas'center $w $tag] { break }
     foreach item [$w find withtag $tag] {
         set coords {}
         foreach {x y} [$w coords $item] {
             set rad [expr {hypot($x-$xm, $y-$ym)}]
             set th  [expr {atan2($y-$ym, $x-$xm)}]
             lappend coords [expr {$xm + $rad * cos($th - $angle)}]
             lappend coords [expr {$ym + $rad * sin($th - $angle)}]
         }
         $w coords $item $coords
     }
 }
 proc every {ms body} {eval $body; after $ms [info level 0]}
 
 pack [canvas .c -width 600 -height 400 -bg white] -fill both -expand 1
 car::new foo .c 200 200 red 0.2 {
     left input light + -> right wheel
     right input light + -> left wheel
     left input object + -> left wheel
     right input object + -> right wheel
 }
 
 bind .c <Button-1> {
     object .c %x %y light
 }
 
 bind .c <Button-3> {
     object .c %x %y object
 }
 
 after [expr {int(rand() * 2000) + 1000}] [list new_car]
 proc new_car {} {
 car::new bar .c 150 200 blue -0.2 {
     left input light + -> right wheel
     right input light + -> left wheel
     left input object + -> left wheel
     right input object + -> right wheel
 }
 }
 
 
 every 50 {car::move}

----
[[
[Category AI]
]]