Фраза о Лиспе...

> В принципе, приветствуются решения на Haskell OCaml и hq9+

[Makefile]
adventure: advserver hclient roboclient

advserver: adv_world.cmo advserver.ml
	ocamlc unix.cma adv_world.cmo advserver.ml -o advserver
hclient: adv_world.cmo hclient.ml
	ocamlc -g unix.cma adv_world.cmo hclient.ml -o hclient
roboclient: adv_world.cmo roboclient.ml
	ocamlc -g unix.cma adv_world.cmo roboclient.ml -o roboclient
adv_world.cmo: adv_world.mli adv_world.ml
	ocamlc -g -c adv_world.mli
	ocamlc -g -c adv_world.ml

clean:
	rm -Rf *~ *.cm[io] advserver hclient roboclient

[adv_world.ml]
let find (map, n, _) c =
  let rec find_aux i =
    if i = n - 1 then raise Not_found
    else try (i, String.index map.(i) c) with Not_found -> find_aux (i + 1)
  in find_aux 0

let get_items (map, n, m) =
  let rec get_items_aux accu = function
      (i, j) when i = n -> accu
    | (i, j) when j = m -> get_items_aux accu (i + 1, 0)
    | (i, j) -> get_items_aux (if map.(i).[j] = 'S' then (i, j) :: accu else accu) (i, j + 1)
  in
  get_items_aux [] (0, 0) ;;

let num_of_items world = List.length (get_items world) ;;

let output oc (map, n, m) =
  for i = 0 to n - 1 do
    for j = 0 to m - 1 do
      output_char oc map.(i).[j]
    done ;
    output_char oc '\n'
  done

let input ic =
  let rec input_aux () =
    try let line = input_line ic in line :: input_aux () with End_of_file -> []
  in
  let m = Array.of_list (input_aux ()) in m, Array.length m, String.length m.(0)

let send oc (map, n, m) ((x, y), _) =
  output_string oc (Printf.sprintf "%d\n" n) ;
  for i = 0 to n - 1 do
    for j = 0 to m - 1 do
      output_char oc (if x = i && y = j then '@' else map.(i).[j])
    done ;
    output_char oc '\n'
  done

let recv_common ic n =
  let rec rc_aux = function
      0 -> []
    | n -> let line = input_line ic in line :: rc_aux (n - 1)
  in
  rc_aux n

let recv ic =
  let n = int_of_string (input_line ic) in
  let map = Array.of_list (recv_common ic n) in map, n, String.length map.(0)

let recv_stat ic = recv_common ic 3

let send_stat oc (map, n, m) ((x, y), is_empty) =
  List.iter (Printf.fprintf oc "%s\n")
    [if num_of_items (map, n, m) = 0 && is_empty then "You won!" else "Game is in progress";
     if is_empty then "Your hand are empty" else "You carry an item";
     if map.(x).[y] = 'S' then "Here lies 1 item" else "Here lies 0 items"]

[adv_world.mli]
val find : string array * int * 'a -> char -> int * int
val get_items : string array * int * int -> (int * int) list
val num_of_items : string array * int * int -> int
val output : out_channel -> string array * int * int -> unit
val input : in_channel -> string array * int * int
val send : out_channel -> string array * int * int -> (int * int) * bool -> unit
val recv : in_channel -> string array * int * int
val recv_stat : in_channel -> string list
val send_stat : out_channel -> string array * int * int -> (int * int) * bool -> unit 

[advserver.ml]
let make_step (map, n, m) (x, y) cmd =
  let cmds = [("north", (-1, 0)); ("south", (1, 0)); ("west", (0, -1)); ("east", (0, 1))] in
  let x', y' = (fun (dx, dy) -> x + dx, y + dy) (try List.assoc cmd cmds with Not_found -> 0, 0) in
  if x' < 0 || x' >= n || y' < 0 || y' >= m || map.(x').[y'] = '#' then x, y else x', y'

let serve_cmd (map, n, m) ((x, y), is_empty) = function
    "pickup" when is_empty && map.(x).[y] = 'S' ->
      map.(x).[y] <- ' ' ;
      ((x, y), false)
  | "drop" when not is_empty && map.(x).[y] != 'S' ->
      map.(x).[y] <- if map.(x).[y] = '.' then '.' else 'S' ;
      ((x, y), true)
  | cmd ->
      (make_step (map, n, m) (x, y) cmd, is_empty)

let serve in_channel out_channel =
  let world = Adv_world.input (open_in Sys.argv.(1)) in
  let rec loop state =
    Adv_world.send out_channel world state ;
    Adv_world.send_stat out_channel world state ;
    flush out_channel ;
    try
      let state = serve_cmd world state (input_line in_channel) in
      loop state
    with
      End_of_file -> ()
  in
  loop ((Adv_world.find world '.'), true) ;;

Unix.establish_server serve (Unix.ADDR_INET (Unix.inet_addr_loopback, int_of_string Sys.argv.(2))) ;; 

[hclient.ml]
let in_channel, out_channel = Unix.open_connection
  (Unix.ADDR_INET ((Unix.inet_addr_of_string Sys.argv.(1)), int_of_string Sys.argv.(2)))
in
while true do
  Adv_world.output stdout (Adv_world.recv in_channel) ;
  List.iter (Printf.printf "%s\n") (Adv_world.recv_stat in_channel) ;
  flush stdout ;
  Printf.fprintf out_channel "%s\n" (read_line ()) ;
  flush out_channel
done ;; 

[roboclient.ml]
let dfs (map, n, m) (sx, sy) =
  let dxy = [(-1, 0); (1, 0); (0, -1); (0, 1)] in
  let f = Array.make_matrix n m (-1) in
  let q = Queue.create () in
  Queue.push (sx, sy) q ; f.(sx).(sy) <- 0 ;
  while not (Queue.is_empty q) do
    let x, y = Queue.pop q in
    List.iter
      (fun (x', y') -> Queue.push (x', y') q ; f.(x').(y') <- f.(x).(y) + 1)
      ( List.filter
          (fun (x', y') -> x' >= 0 && x' < n && y' >= 0 && y' < m && map.(x').[y'] <> '#' && f.(x').(y') = -1)
          (List.map (fun (dx, dy) -> x + dx, y + dy) dxy) )
  done ;
  f

let calc_commands f (x, y) =
  let rec find_path (x, y) path =
    let dxy = [(-1, 0); (1, 0); (0, -1); (0, 1)] in
    let cmds = [((-1, 0), "south"); ((1, 0), "north"); ((0, -1), "east"); ((0, 1), "west")] in

    if f.(x).(y) = 0 then path
    else
      let find_path_aux (dx, dy) =
        if f.(x + dx).(y + dy) + 1 = f.(x).(y) then
          find_path (x + dx, y + dy) (List.assoc (dx, dy) cmds :: path)
        else raise Not_found
      in
      let rec iter = function
          []      -> raise Not_found
        | d :: tl -> try find_path_aux d with Not_found -> iter tl
      in
      iter dxy
  in
  let invert_path path =
    let map = [("north", "south"); ("south", "north"); ("west", "east"); ("east", "west")] in
    let rec invert_path_aux accu = function
        []        -> accu
      | cmd :: tl -> invert_path_aux (List.assoc cmd map :: accu) tl
    in
    invert_path_aux [] path
  in

  let path = find_path (x, y) [] in
  path @ ["pickup"] @ (invert_path path) @ ["drop"]

let main () =
  let in_channel, out_channel = Unix.open_connection
    (Unix.ADDR_INET ((Unix.inet_addr_of_string Sys.argv.(1)), int_of_string Sys.argv.(2)))
  in
  let world = Adv_world.recv in_channel in
  Adv_world.output stdout world ;
  List.iter (Printf.printf "%s\n") (Adv_world.recv_stat in_channel) ;

  let start = Adv_world.find world '@' in
  let marks = dfs world start in

  List.iter
    ( fun (x, y) ->
        List.iter
          ( fun cmd ->
              Printf.printf "\ncommand: %s\n" cmd ;
              Printf.fprintf out_channel "%s\n" cmd ;
              flush out_channel ;
              Adv_world.output stdout (Adv_world.recv in_channel) ;
              List.iter (Printf.printf "%s\n") (Adv_world.recv_stat in_channel) )
          (calc_commands marks (x, y)) )
    ( Adv_world.get_items world ) ;;

main () ;;

Написано примерно за 3 часа, наверное можно сильно сократить. Но буду
это делать, только если кто напишет сильно короче. Пока без пустых 156
строк. Не думаю, что на python или lisp будет сильно по другому.
Больно задача общая. Уж ocaml здесь точно большого выигрыша не дает.

>> Замеряем таким образом?

> Замеряйте :-)

> Результаты сведите в общую таблицу

Ну, соорудил мерялку, как описывал -- по лексемам. Результаты
получились довольно занятные :-).

Для версии с БД программы на C++ не участвовали, потому сравниваются
только Лисп и Питон.

Параметр                     | Lisp | Python
--------------------------------------------
Общая длина                  |  511 |   677
Смысловая длина              |  248 |   289
Общий тезаурус               |  112 |   128
Смысловой тезаурус           |   85 |    93
Насыщенность (в %)           |   49 |    43
Выразительность (в %)        |   76 |    73
Общая изменчивость (в %)     |   22 |    19
Смысловая изменчивость (в %) |   34 |    32

Для версии со словарями оказалось возможно сравнить все три языка,
однако я не проверял их на работоспособность.

Параметр                     | Lisp | Python | C++
--------------------------------------------------
Общая длина                  |  176 |    186 | 421
Смысловая длина              |   60 |     66 | 172
Общий тезаурус               |   42 |     52 |  88
Смысловой тезаурус           |   24 |     27 |  55
Насыщенность (в %)           |   34 |     35 |  41
Выразительность (в %)        |   57 |     52 |  62
Общая изменчивость (в %)     |   24 |     28 |  21
Смысловая изменчивость (в %) |   40 |     41 |  32

Расшифровка терминов следующая:

Общая длина -- число всех лексем в программе. По идее, определяет
основной параметр -- интуитивный размер программы.

Смысловая длина -- число всех значимых лексем (не ключевых слов и не
спецсимволов, т.е., идентификаторов, строк, чисел и т.п.).
Приблизительно определяет общее количество определений и использования
новых сущностей в программе. Параметр может быть определен неточно,
так как в "ключевые слова" попали также все идентификаторы,
определенные стандартом, или, по другому, использовать которые
оказалось возможно без подключения внешних библиотек или пакетов. Сами
имена библиотек/пакетов не считаются ключевыми.

Общий тезаурус -- размер словаря программы, число неповторяющихся
лексем. Дает грубую оценку общего числа понятий, используемых в
программе.

Смысловой тезаурус -- размер смыслового словаря программы, число
неповторяющихся значимых лексем (определение такое же, как и для
смысловой длины). Дает оценку числа новых понятий, определенных в
программе.

Насыщенность -- отношение смысловой длины к общей, выражается в
процентах. Определяет степень "засахаренности" синтаксиса программы --
чем больше насыщенность, тем меньшую роль играет синтаксис языка. По
идее, это близость программы к человеческому определению.

Выразительность -- отношение смыслового тезауруса к общему, выражается
в процентах. Похоже на насыщенность, но относится к составу словаря.

Общая изменчивость -- отношение общего тезауруса к общей длине
программы, выражается в процентах. По идее, эта величина является
обратной к регулярности -- среднему количеству использований одной
лексемы. Возможно, определяет "высокоуровневость" языка, так как
интуитивно ассемблеры должны иметь низкую изменчивость (длинные
программы с небольшим набором команд), а, например, для BrainF**k и
WhiteSpace изменчивость практически равна 0, что напоминает ситуацию с
характеристикой словаря людоедки-Эллочки.

Смысловая изменчивость -- отношение смыслового тезауруса к смысловой
длине программы, выражается в процентах. Похожа на общую изменчивость,
но только в применении к смысловым лексемам. Для BrainF**k и
WhiteSpace смысловая изменчивость определяется неопределенным
отношением 0/0 (в этих языках нет неключевых слов), для простоты я
определил ее в таком случае, как 0, что соответствует "вырожденности"
этих языков.

Можно заметить, что для Лиспа и Питона относительные параметры
практически равны, а абсолютные заметно отличаются. Насколько
"заметно" -- зависит от субъективного восприятия. Для питоноводов это
может быть "всего лишь на десяток (сотню) строк", а для лисперов это
может быть "аж целых 10 (25) процентов". Можно ли на таких задачах
считать выигрыш в четверть длины "существенным" -- личное дело
каждого. Кроме того, в процессе написания мерялки я нашел задачу, где
использование макров на лиспе может дать выигрыш в длине кода раз в
10, то есть, примерно на порядок. Когда сделаю, покажу кусочек, хотя
по сути это именно то, что я описывал по отношению к написанию крупных
синтаксических и лексических анализаторов для нетривиальных языков.
Если дело дойдет до принципа, то придется писать лексический
анализатор на Питоне. Пока что попробую позже написать, как это
делается на Лиспе.

Одинаковость относительных параметров наводит на мысль, что они
характеризуют равный характер квалификации программистов и
одинаковость алгоритмов, использованных в программе. Возможно, это
удастся использовать для косвенной оценки.

Из всей этой картинки выбивается С++. По абсолютным параметрам он
проигрывает в разы (примерно в 3 раза), а по относительным показывает
меньшую изменчивость и большую выразительность/насыщенность. Это можно
интерпретировать, как низкоуровневость (типа низкая изменчивость
характерна именно для ассемблеров), а можно посчитать, что эта
программа решает не совсем ту задачу. В частности, очевидно, что
программа на C++ не выполняет поиска по всем трем критериям, которые
были в условии задачи.

Если интересно, могу прогнать через мерялку еще и задачу о
перестановках. Кроме того, могу опубликовать код мерялки (она на
Лиспе) с целью выяснения принципов ее работы, поиска ошибок и
неточностей (в частности, с разделением на ключевые и неключевые
слова) и замеров других параметров.

> Пока без пустых 156 строк.

Total length                                         1627
Meaning length                                        603
Total thesaurus                                       164
Meaning thesaurus                                     113
Saturation (%)                                         37
Expressiveness (%)                                     69
Total variability (%)                                  10
Meaning variability (%)                                19

;-)

Удалось сократить на 5 строк, изменив функцию output модуля adv_world.ml

let output oc (map, _, _) =
  Array.iter (Printf.fprintf oc "%s\n") map

Просто изначально функции output и send были одной, поэтому output была такой большой. В принципе и send можно уменьшить, но не очень красиво - пока этого делать не буду.

Кстати, флейм как-то поутих, а я только добрался :( Может найдутся новые возможности развития дискуссии в рамках выбранной темы?..

>Кстати, флейм как-то поутих, а я только добрался :( Может найдутся новые возможности развития дискуссии в рамках выбранной темы?..

Я уже тоже похоронил про себя топик, но теперь, похоже, все только начинается. LOR contest :)

Вчера по зрелому размышлению возникла мысль переопределить
относительные параметры программы. Отношение числа смысловых лексем к
их общему количеству всегда будем называть "насыщенностью", причем она
может определяться, как "общая насыщенность" и "насыщенность
тезауруса". То, что раньше называлось выразительностью, становится
"насыщенностью тезауруса", а изменчивость теперь будем называть
"выразительностью", которая тоже может измеряться двумя способами.

Такое переопределение ближе к интуитивному пониманию. Выразительность
определяет не только возможности языка, но и степень применения
"метода китайских программистов" (copy-paste). Чем меньше повторяются
слова в программе, тем она выразительнее, хотя для полной оценки нужно
учитывать многократное использование изоморфных грамматических
конструкций.

Теперь к вопросу об использовании макросов для повышения
читабельности.

Для считалки нужно было определить лексический анализатор, который
будет пропускать сепараторы (пробельные символы и комментарии), а
остальные лексемы делить на ключевые и смысловые слова. В моем первом
варианте на Лиспе это выглядело вот так:

(deflexer make-lisp-token-stream
  :flex-compatible
  ("\\(" (return (values :keyword %0)))
  ("\\)" (return (values :keyword %0)))
  ("'"   (return (values :keyword %0)))
  ("#'"  (return (values :keyword %0)))
  ; И т.д.

  ("(\\-)?[0-9]+" (return (values :meanword %0)))
  ("[\\[]" (return (values :meanword %0)))
  ("[\\]]" (return (values :meanword %0)))
  ("[A-Za-z][A-Za-z\\-]*" (return (values :meanword %0)))
  ; И т.п.

  (";.*$") ("[:space:]+"))

Понятно, что тут дофига повторяющихся фрагментов кода (добавьте сюда
еще 3 языка), в результате чего программа оказалось изрядно распухшей.
После применения макросов получаем следующее решение:

(defun lex-class (class-def)
  (mapcar 
     #'(lambda (regex) `(,regex (return (values ,(car class-def) %0))))
     (cdr class-def)))

(defmacro defclassifier (name class-list skip-list)
  `(deflexer ,name
      :flex-compatible 
      ,@(mapcan #'lex-class class-list)
      ,@(mapcar #'list skip-list)))

(defclassifier make-ocaml-classifier
  ((:keyword
    .("!=" "%" "&" "&&" "," ":" "::" ";" ";;" "<" "<\\-" "=" ">" ">=" "@" "Array"
      "List" "Queue" "\\(" "\\)" "\\*" "\\+" "\\-" "\\->" "\\." "\\[" "\\]" "\\{"
      "\\|" "\\|\\|" "\\}" "assoc" "create" "do" "done" "else" "flush" "for" "fun"
       "function" "if" "in" "iter" "length" "let" "loop" "make_matrix" "map" "not"
       "pop" "push" "raise" "then" "to" "true" "try" "with"))

   (:meanword
    .("\"[^\"]*\"" "'[^']*'" "(-)?[0-9]+" "[A-Za-z_][A-Za-z_]*(')?")))

  ;skipword
  ("//.*$" "[:space:]+"))

(defclassifier make-c++-classifier
  ((:keyword
    .("!=" "#include" "%" "&" "," ":" "::" ";" "<" "<<" "=" ">" ">=" ">>" "\\("
      "\\)" "\\*" "\\+" "\\+\\+" "\\->" "\\." "\\[" "\\]" "\\{" "\\|\\|" "\\}"
      "bool" "class" "const" "for" "if" "int" "namespace" "operator" "return" "std"
      "struct" "try" "typedef" "using" "void"))

   (:meanword
    .("\"[^\"]*\"" "(-)?[0-9]+" "[A-Za-z_][A-Za-z_]*")))

  ;skipword
  ("//.*$" "[:space:]+"))

(defclassifier make-python-classifier
  ((:keyword 
    .("!=" "%" "," ":" "<" "=" ">" ">=" "\\(" "\\)" "\\*" "\\+" "\\." "\\[" "\\]"
      "__class__" "__init__" "__name__" "__unicode__" "append" "class" "cond" "def"
      "dict" "except" "for" "if" "import" "in" "join" "lambda" "len" "list" "print"
      "return" "setattr" "try" "unicode" "yield"))

   (:meanword
    .("\"[^\"]*\"" "(-)?[0-9]+" "[A-Za-z_][A-Za-z_]*" "u?'[^']*'")))

  ;skipword	
  ("#.*$" "[:space:]+"))

(defclassifier make-lisp-classifier
  ((:keyword 
    .("\\." "#'" "%" "&key" "&optional" "'" "," ",@" "/" "1\\+" ":" ":test" "<" "<>" "="
      ">" ">=" "\\(" "\\)" "\\*" "\\+" "`" "and" "break" "caar" "cond" "defun" "eq"
      "equal" "gethash" "if" "in-package" "lambda" "length" "list" "make-hash-table"
      "make-instance" "not" "print" "progn" "push" "setf" "setq" "slot-value"
      "string=" "t" "terpri"))

   (:meanword
    .("\"[^\"]*\"" "(\\-)?[0-9]+" "[A-Za-z][A-Za-z\\-\\+]*" "[\\[]" "[\\]]")))

  ;skipword	
  (";.*$" "[:space:]+"))

Как видим, получилось не только короче, но и понятнее, удалось описать
только существенную часть. В результате замеры показали:

Параметр                        | Без макро | С макро
-----------------------------------------------------
Общая длина                     |      3110 |    896
Смысловая длина                 |      1192 |    446
Общий тезаурус                  |       252 |    256
Смысловой тезаурус              |       222 |    225
Общая насыщенность (в %)        |        38 |     50
Насыщенность тезауруса (в %)    |        88 |     88
Общая выразительность (в %)     |         8 |     29
Смысловая выразительность (в %) |        19 |     50

То есть, практически без изменения словаря удалось сократить программу
в 3.5 раза и примерно в 3 раза повысить выразительность программы. А
по мере увеличения количества языков и ключевых слов в них эта цифра
может стать еще больше.

Кстати, это хорошо показывает, что понимается под
"быдлопрограммированием", и что никакой язык не застрахован от такого
стиля программирования. Другое дело, позволяет ли язык писать
компактно. Например, интересно посмотреть, как эта проблема может быть
решена в Питоне.

Ну вот. На 38-й странице наконец пошёл конструктив :)

Наконец-то приоткрылась полезность макров на _конкретном_ примере. Спасибо.

Буду читать про лисп, давно хотел, но всё в полезности сомневался.

>(defclassifier make-lisp-classifier...)

С методом категорически не согласен. Повторю свою точку зрения. Нам надо программы привести к виду синтаксического дерева. Осуществлять подсчет по ключевым словам неправильно. Особенно в LISP! В LISP надо подсчитать толко узлы деревьев, т. е. количество окрывающихся скобочек. А так ты получишь, что LISP имеет бесконечно большое количество ключевых слов. Хоть ты и пытаешься использовать какое-то подмножество их, но вот (defclass...) ты куда денешь? А это макрос уже. Учесть, получается, нельзя. Не учесть -- тоже неправильно, потому что объявление class в C++ вроде есть (+1 в keyword), а в LISP ты посчитаешь, что это (+1 в meanword). Получается, ты сравниваешь не структуру программ, а число используемых ключевых слов и идентификаторов, что для LISP не имеет смысла. Скажу кощунство, но в LISP нет синтаксиса. Программирование в LISP -- это составление синтаксического дерева, т. е. низкоуровневой синтаксической структуры, к которой могут приведены и другие языки после парсинга. А вот макросы LISP не могут быть приведены к C++, так как они просто не могут быть описаны в терминах C++. Получается, что LISP -- это синтаксическое надмножество.

if (a == getSomeValue (b)) { return a };

Если распарсить по синтаксическому дереву, то получим:

(if (== a (getSomeValue b)) (return a))

Отсутсвие возможности делать макросы, как в LISP сразу же вылезет наружу при таком вот анализе. Ты получишь ситуацию, когда синтаксическое дерево C++ не сможет выйти за рамки оспользования ключевых слов и вызова функций. А в LISP я смогу переопределить ключевые слова, и твой алгоритм начнет сбоить. Переопределю if на if* и буду везде использовать последний. Твой алгоритм один раз посчитает if в макросе или функции, а в остальной программе больше никогда его не найдет. LISP-программа обхитрит твой алгоритм.

А вот по размеру и *структуре* (структурный анализ тоже можно проводить: подумать, есть ли смымл в "ветвистости" и пр.) синтаксического дерева можно вполне судить обо всех параметрах языков. При использовании макросов ты сразу увидишь сокращение синтаксического дерева. синтаксический анализ не должен уходить в учет ключевых слов и идентификаторов.

> В LISP надо подсчитать толко узлы деревьев, т. е. количество окрывающихся скобочек.

Оформляя почти любой блок кода через loop я резко снижу количество этих самх скобок.

Если просто переписать впрямую этот код, то код на Лиспе будет на 20% короче и существенно понятнее за счет одной только ликвидации извратов с рекурсией:

#| ;; OCaml let get_items (map, n, m) = let rec get_items_aux accu = function (i, j) when i = n -> accu | (i, j) when j = m -> get_items_aux accu (i + 1, 0) | (i, j) -> get_items_aux (if map.(i).[j] = 'S' then (i, j) :: accu else accu) (i, j + 1) in get_items_aux [] (0, 0) ;; |#

;; Common Lisp (defun get-items (map n) (loop for i from 0 below n append (loop with cpos = 0 for p = (position #\S (aref map i) cpos) when p collect (cons i p) do (setf cpos p))))

#| ;; OCaml let find (map, n, _) c = let rec find_aux i = if i = n - 1 then raise Not_found else try (i, String.index map.(i) c) with Not_found -> find_aux (i + 1) in find_aux 0

;; Common Lisp (defun find (map n c) (loop for row across map for p = (position с row) when p do (return (values i p))))

Если просто переписать впрямую этот код, то код на Лиспе будет на 20% короче и существенно понятнее за счет одной только ликвидации извратов с рекурсией: 

#| ;; OCaml 
let get_items (map, n, m) =
  let rec get_items_aux accu = function
      (i, j) when i = n -> accu
    | (i, j) when j = m -> get_items_aux accu (i + 1, 0)
    | (i, j) -> get_items_aux (if map.(i).[j] = 'S' then (i, j) :: accu else accu) (i, j + 1)
  in get_items_aux [] (0, 0) ;;
|# 

;; Common Lisp 
(defun get-items (map n) 
    (loop for i from 0 below n append 
        (loop with cpos = 0 
              for p = (position #\S (aref map i) cpos) when p  
              collect (cons i p) do (setf cpos p))))

#| ;; OCaml 
let find (map, n, _) c =
  let rec find_aux i =
    if i = n - 1 then raise Not_found
    else try (i, String.index map.(i) c) with Not_found -> find_aux (i + 1)
  in find_aux 0
|#


;; Common Lisp 
(defun find (map n c) 
    (loop for row across map 
          for p = (position с row) 
          when p do (return (values i p))))

Исправление:

(defun find (map n c)
  (loop for i from 0 below (length map)
        for p = (position c (aref map i))
        when p do (return (values i p))))

Исправление:

(defun get-items (map n) (loop for i from 0 below n append (loop with cpos = 0 for p = (position #\S (aref map i) :start cpos) while p collect (cons i p) do (setf cpos p))))

Исправление:

(defun get-items (map n m)
  (loop for i from 0 below n nconc
     (loop for j from 0 below m
           when (eql (elt (aref map i) j) #\S) 
           collect (cons i j))))

Да, я вижу, что loop это круто. Но все же не вижу никакого изврата в своих рекурсиях - стандартный подход в ФП, код прозрачный и понятный. Думаю реализация в виде цикла вам была бы понятнее, но лично мне так нравится гораздо больше.

> А так ты получишь, что LISP имеет бесконечно большое количество ключевых слов.

Стандарт Common Lisp конечен (хотя и велик). Поэтому количество ключевых слов тоже конечно.

> Хоть ты и пытаешься использовать какое-то подмножество их, но вот (defclass...) ты куда денешь?

Если определено в стандарте, то это ключевое слово. Вообще говоря, ключевыми являются те слова, которые определены сразу после запуска без подключения дополнительных библиотек или пакетов. То есть, это что-то вроде "батареек из коробки".

> Скажу кощунство, но в LISP нет синтаксиса.

Если бы в Лиспе не было синтаксиса, то не было бы и синтаксических ошибок. А они есть. Начиная с неверного числа скобок и неправильного числа аргументов при вызове функции, и заканчивая нарушением правил обратной блокировки.

> А в LISP я смогу переопределить ключевые слова, и твой алгоритм начнет сбоить.

А в С++ я могу переопределить стандартные операторы, как это сделано, например, для потокового вывода.Ты и сам это косвенно подтвердил -- переопределение ключевого слова не делает его смысловым.

> А вот по размеру и *структуре* (структурный анализ тоже можно проводить: подумать, есть ли смымл в "ветвистости" и пр.) синтаксического дерева можно вполне судить обо всех параметрах языков.

Любая методика несовершенна. Например, в С++ тоже есть макросы, и их далеко не всегда можно учесть на синтаксическом уровне. Важнее добиться приемлемого соотношения качества методики и усилий, потраченных на ее реализацию. Лексеры я смог сделать играючи, но с грамматиками (тем более, контекстно-зависимыми) мне возиться уже не хочется. Есть задачи и поважнее. Пусть синтаксическим разбором занимаются недовольные моей методикой.

Вот что получается при переписывании первой части кода c OCaml на CL:

(defstruct world map w h)

(defmacro with-world ((x y &optional p inner-body) w &body body)
  `(block with-world
     (loop for ,y fixnum from 0 below (world-h ,w) do
        (loop for ,x fixnum from 0 below (world-w ,w) 
              ,@(when p `(for ,p = (aref (world-map ,w) ,y ,x)))
              do ,@body)
        ,@(when inner-body `(,inner-body)))))

(defmacro promise ((fn &rest args))
  (let ((iargs (mapcar #'(lambda (x) (if (equal (symbol-name x) "_")
                                         (gensym) x)) args)))
    `(lambda ,(remove-if (lambda (x) (position x args)) iargs)
       (,fn ,@iargs))))
 
(defun lies-thing-p (world x y &optional (c #\S))
  (eql (aref (world-map world) y x) c))

(defun get-items (world)
  (let ((items ()))
    (with-world (x y) world
        (when (lies-thing-p world x y) (push (cons y x) items)))
    items))

(defun find (world c)
  (with-world (x y p) world
     (when (eql p c) (return-from find (cons y x)))))

(defun n-items (world) (length (get-items world)))

(defun output (stream world) 
   (with-world (x y p (terpri stream)) world 
     (princ p stream)))
      
(defun input-map (stream)
 (let ((lines (loop for line = (read-line stream nil 'eof)
                    until (eq line 'eof) collect line)))
   (make-array (list (length lines) (length (first lines))) :initial-contents acc)))


(defun send (stream world x y)
  (format stream "~D~%" (world-height world))
  (with-world (j i p (terpri stream)) world
    (princ (if (and (= x j) (= y i)) #\@ p) stream)))

(defun recv-common (stream n)
  (loop for line = (read-line stream nil 'eof) 
        unless (eq line 'eof) collect line))

(defun recv (stream)
  (input-map stream))

(defun recv-stat (stream) (recv-common stream 3))

(defun send-stat (stream world x y is-empty-p)  
 (map nil (promise (print _ stream)) (list
    (if (and (zerop (n-items world)) is-empty-p) "You won!" "Game is in progress"))
    (if is-empty-p "Your hand are empty" "You carry an item")
    (format nil "Here lies ~D item(s)" (if (lies-thing-p world y x) 1 0))))

кривовато, но код на CL в целом получается короче из-за прямолинейности и некоторой экономии на макрах.

Исправление:

(defun input-map (stream)
 (let ((lines (loop for line = (read-line stream nil 'eof)
                    until (eq line 'eof) collect line)))
   (make-array (list (length lines) (length (first lines))) 
               :initial-contents lines)))

> стандартный подход в ФП, код прозрачный и понятный

Я вовсе не против рекурсии, но IMHO в данном примере задача решается задом наперед. Если бы вспомогательные функции использовались повторно, то польза такого подхода была бы очевидной, но они все равно повторяются, тогда какой смысл все делать задом наперед, вручную рулить циклами как в функции:

let rec get_items_aux accu = function (i, j) when i = n -> accu | (i, j) when j = m -> get_items_aux accu (i + 1, 0) | (i, j) -> get_items_aux (if map.(i).[j] = 'S' then (i, j) :: accu else accu) (i, j + 1) in ...

Если строка последняя, то вернуть список вещей, иначе если кончилась строка, то перейти на следующую строку, иначе собрать вещи (если здесь вещь то добавить в список) левее.

Зачем мучиться такими низкоуровневыми деталями ?

IMHO проще:

Перебирая карту, если *здесь* лежит-вещь, добавить *координаты* в список.

Да, и кстати имена вспомогательных функций - это тоже лишние детали. Хотя наверняка тут еще можно оптимизировать с помощью функций высшего порядка, чтобы код для обхода карты не повторялся. Потом есть функции с идентичным кодом:

let input ic =
  let rec input_aux () =
    try let line = input_line ic in line :: input_aux () with End_of_file -> []
  in  let m = Array.of_list (input_aux ()) in m, Array.length m, String.length m.(0)

let recv_common ic n =
  let rec rc_aux = function
      0 -> []
    | n -> let line = input_line ic in line :: rc_aux (n - 1)
  in  rc_aux n

let recv ic =
  let n = int_of_string (input_line ic) in
  let map = Array.of_list (recv_common ic n) in map, n, String.length map.(0)

почти то же самое для вывода:

let output oc (map, n, m) =
  for i = 0 to n - 1 do
    for j = 0 to m - 1 do
      output_char oc map.(i).[j]
    done ;
    output_char oc '\n'
  done

let send oc (map, n, m) ((x, y), _) =
  output_string oc (Printf.sprintf "%d\n" n) ;
  for i = 0 to n - 1 do
    for j = 0 to m - 1 do
      output_char oc (if x = i && y = j then '@' else map.(i).[j])
    done ;
    output_char oc '\n'
  done

Да, и кстати имена вспомогательных функций - это тоже лишние детали. Хотя наверняка тут еще можно оптимизировать с помощью функций высшего порядка, чтобы код для обхода карты не повторялся. Потом есть функции с почти идентичным кодом:

let input ic = let rec input_aux () = try let line = input_line ic in line :: input_aux () with End_of_file -> [] in let m = Array.of_list (input_aux ()) in m, Array.length m, String.length m.(0)

let recv_common ic n = let rec rc_aux = function 0 -> [] | n -> let line = input_line ic in line :: rc_aux (n - 1) in rc_aux n

let recv ic = let n = int_of_string (input_line ic) in let map = Array.of_list (recv_common ic n) in map, n, String.length map.(0)

почти то же самое для вывода:

let output oc (map, n, m) = for i = 0 to n - 1 do for j = 0 to m - 1 do output_char oc map.(i).[j] done ; output_char oc '\n' done

let send oc (map, n, m) ((x, y), _) = output_string oc (Printf.sprintf "%d\n" n) ; for i = 0 to n - 1 do for j = 0 to m - 1 do output_char oc (if x = i && y = j then '@' else map.(i).[j]) done ; output_char oc '\n' done

На счет input и recv я так и думал, но не очень красиво получалось. Тем более, что для меня критерием являлся не меньший размер, а эстетичность (степень эстетичности разумеется определяется мной по моим субъективным критериям).

output и send так похожи как раз по той причине, что изначально были одной функцией, которую я потом разнес на две. Ниже на пару постов я переопределил output в две строки и указал, что могу уменьшить send, но выглядеть (опять же на мой взгляд) она будет хуже.

По поводу эстетичности и функциональных вызовов вместо циклов - я люблю ФП, поэтому, если какую-либо логику довольно удобно реализовывать без использования изменения состояния, я так и поступлю. По этой причине я и использовал рекурсию с накоплением для поиска всех вещей вместо циклов. Просто я не считаю, что цикл является сдесь более красивым решением. А вот для поиска в ширину, я осознанно использовал обыкновенную очередь. То есть я не фанатег - когда можно и удобно использовать ФП, я его использую, а когда оно не вписывается красиво в рамки логики задачи, я обхожусь императивным программированием.

P. S. Конечно мое решение далеко от совершенства и тут еще много где можно развернуться. Я и не претендовал на что-то. Появятся решения гораздо лучше, я займусь оптимизацией своего...

>Оформляя почти любой блок кода через loop я резко снижу количество 
этих самх скобок.


Люблю контрпримеры. Они позволяют двигаться в правильном направлении. 
:)

Вопрос-то непростой. Такая же проблема встанет и в методе, приведенном
 выше, который бегает по ключевым словам и символам:

for (i = 0; i < n; i = i + 2) { body };

посчитается пять раз: на "for", на "=", на "<" и на "=" с "+", а loop 
повезет больше -- он только один раз, хотя синтаксически выглядят 
идентично. Какая-то несправедливость будет по отношению к Си.

(loop :for i :from 0 :below n :by 2 :do ( body ))

Я специально написал через ':', чтобы было понимание, что это не 
функции, а парметры loop, которые используются для раскрытия макроса. 
for, below, do не отловятся, так как это просто символы. Тогда в целях
 сравнения надо потребовать, чтобы loop был хотя бы так:

(let ((i 0)) (loop :while (< i n) :do ( body ) (setq i (+ i 2))))

Тогда выравниваются очки.

Решение на питоне. В качестве middleware :-) платформы используется
Pyro (pyro.sf.net)

[world.dat]
##########
#  # $ # #
#$ #     .
#     #  #
##########

[advserver.py]
#!/usr/bin/env python

import sys
import Pyro.core

from advworld import World

class Server(Pyro.core.ObjBase):
    def init(self, fname):
        self.world = World(fname)
    
    def read_world(self):
        return self.world
    
    def perform_action(self, action):
        self.world.performAction(action)


def main():
    fname = sys.argv[1]
    port = sys.argv[2]
    
    server = Server()
    server.init(fname)
    
    Pyro.core.initServer()
    daemon = Pyro.core.Daemon(host='127.0.0.1', port=int(port))
    daemon.connect(server, 'adventure_server')
    daemon.requestLoop()
    
if __name__ == '__main__':
    main()

[advworld.py]
class World:
    def __init__(self, world_file):
        self.map = []
        self.items = []
        
        f = open(world_file)
        
        row = 0
        while True:
            l = f.readline().strip()
            
            if l == '':
                break
            
            map_line = str(l).replace('$', ' ').replace('.', ' ')
            self.map.append(list(map_line))
            
            for col in xrange(len(l)):
                if l[col] == '$':
                    self.items.append((row, col))
                if l[col] == '.':
                    self.entry = (row, col)
            
            row += 1
        
        self.height = len(self.map)
        self.width = len(self.map[0])
        self.hands_empty = True
        self.position = self.entry
        
    def gameWon(self):
        ok = True
        for item in self.items:
            if item != self.entry:
                ok = False
                break
        return ok and self.hands_empty
    
    def move(self, dx, dy):
        new_col = self.position[1] + dx
        new_row = self.position[0] + dy
        
        try:
            new_place = self.map[new_row][new_col]
        except IndexError:
            new_place = None
        
        if new_place == ' ':
            self.position = (new_row, new_col)
    
    def action_north(self):
        self.move(0, -1)
    
    def action_south(self):
        self.move(0, 1)
    
    def action_east(self):
        self.move(1, 0)
    
    def action_west(self):
        self.move(-1, 0)
    
    def action_pickup(self):
        if self.position in self.items:
            self.items.remove(self.position)
        self.hands_empty = False
    
    def action_drop(self):
        self.hands_empty = True
        self.items.append(self.position)
    
    def performAction(self, action):
        func = None
        try:
            func = getattr(self, 'action_'+action)
        except IndexError:
            pass
        
        if func is not None:
            func()
    
    def __str__(self):
        s = []
        
        for row in xrange(self.height):
            line = ''
            for col in xrange(self.width):        
                pos = (row, col)
                char = self.map[row][col]
                if pos == self.position:
                    char = '@'
                elif pos == self.entry:
                    char = '.'
                elif pos in self.items:
                    char = '$'
                line += char
            s.append(line)
            
        if self.gameWon():
            s.append('You won!')
        else:
            s.append('Game is in progress')
        
        if self.hands_empty:
            s.append('Your hands are empty')
        else:
            s.append('You carry an item')
        
        s.append('Here lie(s) %d item(s)' % (self.items.count(self.position)))
        
        return '\n'.join(s)

[hclient.py]
#!/usr/bin/env python

import sys
import Pyro.core

shortcuts = {
    'n': 'north',
    'e': 'east',
    'w': 'west',
    's': 'south',
    'd': 'drop',
    'p': 'pickup'}

def main():
    host = sys.argv[1]
    port = sys.argv[2]
    
    uri = 'PYROLOC://%s:%s/adventure_server' % (host, port)
    server = Pyro.core.getProxyForURI(uri)
    
    while True:
        print server.read_world()
        
        sys.stdout.write('> ')
        cmd = sys.stdin.readline().strip().lower()[0]
        server.perform_action(shortcuts[cmd])

if __name__ == '__main__':
    main()

[roboclient.py]
#!/usr/bin/env python

import sys
import copy
import time
import Pyro.core

class RoutingError(Exception):
    pass

class Robot:
    wait, goin, goout = range(3)
    
    def __init__(self, server, delay=1):
        self.server = server
        self.delay = 1
        
    def findPath(self, world, target_position):
        map = copy.deepcopy(world.map)
        map[world.position[0]][world.position[1]] = [world.position]
        
        def propagate(pos):
            deltas = [(0, 1), (0, -1), (1, 0), (-1, 0)]
            new_positions = []
            current_path = map[pos[0]][pos[1]]
            
            for d in deltas:
                new_pos = (pos[0] + d[0], pos[1] + d[1])
                new_path = list(current_path) + [new_pos]
                
                try:
                    location = map[new_pos[0]][new_pos[1]]
                except IndexError:
                    location = '#'
                
                if location != '#':
                    if location == ' ' or (len(location) > len(new_path)):
                        map[new_pos[0]][new_pos[1]] = new_path
                        new_positions.append(new_pos)
            return new_positions
        
        positions = [world.position]
            
        while True:
            new_positions = []
            for pos in positions:
                new_positions += propagate(pos)
            positions = new_positions
            
#            print positions
            if not positions:
                raise RoutingError()
            
            path = map[target_position[0]][target_position[1]]
            if isinstance(path, list):
                break
        return path
    
    def moveTo(self, position):
        world = self.server.read_world()
        path = self.findPath(world, position)[1:]
        for pos in path:
            self.stepTo(pos)
    
    def stepTo(self, pos):
        world = self.server.read_world()
        
        dr = pos[0] - world.position[0]
        dc = pos[1] - world.position[1]
        
        directions = {
            (0, -1): 'west',
            (0, 1): 'east',
            (1, 0): 'south',
            (-1, 0): 'north'}
        
        action = directions.get((dr, dc), None)
        if action is None:
            raise RoutingError()
        self.performAction(action)
    
    def performAction(self, action):
        print self.server.read_world()
        print 'Robot action:', action
        time.sleep(self.delay)
        self.server.perform_action(action)
    
    def play(self):
        while True:
            world = self.server.read_world()
            items = [i for i in world.items if i != world.entry]
            
            if not items:
                break
            
            self.moveTo(items[0])
            self.performAction('pickup')
            self.moveTo(world.entry)
            self.performAction('drop')
        print world

def main():
    host = sys.argv[1]
    port = sys.argv[2]
    
    uri = 'PYROLOC://%s:%s/adventure_server' % (host, port)
    server = Pyro.core.getProxyForURI(uri)
    robot = Robot(server)
    robot.play()
    
if __name__ == '__main__':
    main()

Общий размер в непустых строках: 217 
Бросается в глаза, то что у меня константы словарей перекодировок 
записаны в несколько строк, напр:

        directions = {
            (0, -1): 'west',
            (0, 1): 'east',
            (1, 0): 'south',
            (-1, 0): 'north'}

Также, если сравнить hclient.py и hclient.ml, сразу бросается в глаза,
что в OCaml импорты неявные, т.е. не надо писать import sys и т.д.

В питоне объявляются переменные host, port, uri, без которых, с одной
стороны можно обойтись, а с другой стороны они служат коментариями.

Также во многих местах в OCaml-е ифы/елзы записаны в строку, в питное
я так не делал никогда.

Общее впечатление от программ:
Питон - много коротких строк
OCaml - мало длинных строк

Сравнение по непустым символам это подтверждает:
OCaml - 4634
Питон - 4427

Написано тоже часа за три. Писал как обычно, нигде особо не ужимался.
Объекты называл как обычно.

Ждём лисповерсию, и eugene_kosenko с его мегаанализом :-)

http://www.digitalmars.com/d/lisp-java-d.html

45 строк на LISP против 55 строк на D

D выбор настроящих программистов?

Да где там 55 строк, даже по грубым замерам вроде больше 60 получается, если откинуть все комментарии и строки, где одна фигурная скобка или одно слово вроде continue.

D cмахивает на C# однако или C# на D ;-)

> посчитается пять раз: на "for", на "=", на "<" и на "=" с "+", а loop повезет больше -- он только один раз, хотя синтаксически выглядят идентично. Какая-то несправедливость будет по отношению к Си.

Я согласен добавить к ключевым словам _все_ "ключи" основных макр (defun, defmacro, defclass, loop & etc.) :) Это справедливо? ;)

Можно ещё оговорить ограничение - не переопределять "ключевые" формы (за исключением варианта сокращения вида их использования) :)

> По моему хорошая задача, т.е. решить такую задачу вобщем-то может 
> каждый, т.е. это не сравнение кто придумает более хитрожопый
> алгоритм, а сравнение именно языков программирования.

Ну, забабахал и я свой опус на Лиспе. Писал два дня, в общей сложности
8 часов из которых треть ушла на обдумывание алгоритма, половина на
чтение документации и примерку структур данных и оставшееся время --
на написание и оптимизацию. То есть, подозреваю, что для грамотного
лиспера понадобилось бы примерно столько же, сколько и для окамлера.

В связи с тем, что я пока не силен в написании серверов на Лиспе,
обмен через сокеты не реализован. Если будет время, допишу. С другой
стороны, отсутствие серверных фенечек вполне компенсируется форматными
рюшечками, которые тыкались для отладки, так что, думаю, это не сильно
повлияет на длину.

Наконец, есть вопросы к формулировке задачи. Во-первых, считается ли,
что роботу доступна вся карта, то есть, известных расположения всех
предметов? Я посчитал, что да, это упрощает алгоритм. Во-вторых, что
делать роботу, если он обнаруживает принципиальную недостижимость
некоторых предметов, которые находятся в замкнутой комнате? У меня в
этом случае выбрасывается исключение, но я его нигде не обрабатываю.
Еще хуже, если робот не видит всей карты -- тогда он в этом случае
вообще не найдет замкнутых предметов.

Статистика:

Total length                                         1158
Meaning length                                        331
Total thesaurus                                       160
Meaning thesaurus                                      85
Total saturation (%)                                   29
Thesaurus saturation (%)                               53
Total expressiveness (%)                               14
Meaning expressiveness (%)                             26

Если сравнивать с решением на Окамле, то получается короче (хотя этот
запас может сожрать работа с сокетами) и менее насыщено, зато более
выразительно. Возможно, это из-за loop и желания новичка перепробовать
весь доступный арсенал. Возможно, циклы могли быть покороче -- на мой
взгляд, это самая "пухлая" часть программы.

Наконец, насколько я понял, по ходу соревнования программы можно
оптимизировать, поэтому оставляю за собой право улучшать этот код по
советам старших товарищей.

---------------------------------------------------------------------

(defun defentities (form names)
  (mapcar #'eval (mapcar form names)))

(defentities
  #'(lambda (name) `(defvar ,name nil))
  '(image-name bound-x bound-y wall-points entry-point 
	 thing-points hero-point hero-carries-thing-p trace-p))

(defun inside-interval-p (interval value)
  (and 
	(>= value (car interval))
	(<= value (cdr interval))))

(defun inside-world-p (point)
  (and
	(inside-interval-p (cons 1 bound-x) (realpart point))
	(inside-interval-p (cons 1 bound-y) (imagpart point))))

(defun wallp (point)
  (or
	(not (inside-world-p point))
	(not (null (member point wall-points)))))

(defun thingp (point)
  (not (null (member point thing-points))))

(defun herop (point)
  (eql point hero-point))

(defun show-world (&optional (markup (make-hash-table)))
  (loop 
	for y from 1 to bound-y
	do (loop
		 for x from 1 to bound-x
		 do (let ((point (complex x y)))
				(cond
				 ((wallp point) (princ #\#))
				 ((herop point) 
				  (princ 
					(cond 
					 (hero-carries-thing-p #\@)
					 ((thingp point) #\*)
					 (t #\.))))
				 ((thingp point) (princ #\$))
				 ((gethash point markup) (format t "~100R" (gethash point markup)))
				 (t (princ " "))))
		 finally (terpri))))

(defun read-world (file-name)
  (setq image-name file-name)
  (setq wall-points ())
  (setq thing-points ())
  (setq hero-carries-thing-p nil)
  (with-open-file 
	(file file-name)
	(loop 
	 for y upfrom 1 
	 while (listen file)
	 do (let ((line (read-line file)))
			(loop
			 for x upfrom 1 
			 for c across line 
			 do (cond
				  ((eq c #\#) (push (complex x y) wall-points))
				  ((eq c #\$) (push (complex x y) thing-points))
				  ((eq c #\.) 
					(setq entry-point (complex x y))
					(setq hero-point (complex x y))))
			 finally (setq bound-x (1- x))))
	 finally (setq bound-y (1- y))))
  (if trace-p (show-world)))

(defun reset-world ()
  (read-world image-name))

(defun go-step (step)
  (let ((new-point (+ hero-point step)))
	 (if (not (wallp new-point))
		  (setq hero-point new-point))
	 (if trace-p (show-world))
	 hero-point))

(defconstant directions
  (pairlis 
	`(#c(1 0) #c(-1 0) #c(0 -1) #c(0 1))
	'(go-east go-west go-north go-south)))

(defentities
  #'(lambda (pair) 
		`(defun ,(cdr pair) () (go-step ,(car pair))))
  directions)

(defun pickup-thing ()
  (cond
	((and (thingp hero-point)
			(not hero-carries-thing-p))
	 (setq hero-carries-thing-p t)
	 (setq thing-points (remove hero-point thing-points :count 1))
	 (if trace-p (show-world)))))

(defun drop-thing ()
  (cond
	(hero-carries-thing-p
	 (setq hero-carries-thing-p nil)
	 (push hero-point thing-points)
	 (if trace-p (show-world)))))

(defmacro do-program (program)
  `(progn ,@(mapcar #'(lambda (command) `(,command)) (eval program))))

(defun neighbours (point)
  (remove-if #'wallp (mapcar #'(lambda (direction) (+ point (car direction))) directions)))

(defun point-front (point markup)
  (remove-if #'(lambda (neighbour) (gethash neighbour markup)) (neighbours point)))
  
(defun next-front (prev-front markup)
  (remove-duplicates (mapcan #'(lambda (point) (point-front point markup)) prev-front)))

(defun mark-front (label front markup)
  (mapcar #'(lambda (point) (setf (gethash point markup) label)) front))

(defun mark-world (label front start-point markup)
  (let ((next-front (next-front front markup)))
	 (mark-front label front markup)
	 (cond
	  ((gethash start-point markup) markup)
	  ((null next-front) (throw :unreachable markup))
	  (t (mark-world (1+ label) next-front start-point markup)))))

(defun make-world-markup (finish-point start-point)
  (mark-world 0 (list finish-point) start-point (make-hash-table)))

(defun next-point (point markup)
  (let ((neighbours (neighbours point))
		  (labels (mapcar #'(lambda (point) (gethash point markup)) (neighbours point))))
	 (cdr (assoc
	  (reduce #'min labels)
	  (pairlis labels neighbours)))))

(defun make-path (start-point finish-point markup)
  (if (eql start-point finish-point)
	 (list finish-point)
	 (cons start-point (make-path (next-point start-point markup) finish-point markup))))

(defun direction (point1 point2)
  (cdr (assoc (- point2 point1) directions)))

(defun path-program (path)
  (if (null (cdr path)) 
	 ()
	 (cons (direction (car path) (cadr path)) (path-program (cdr path)))))

(defun find-path-program (start-point finish-point)
  (path-program (make-path start-point finish-point (make-world-markup finish-point start-point))))

(defconstant command-reversion
  (pairlis
	'(go-east go-west go-north go-south pickup-thing drop-thing)
	'(go-west go-east go-south go-north drop-thing pickup-thing)))

(defun reverse-command (command)
  (cdr (assoc command command-reversion)))

(defun reverse-program (program)
  (reverse (mapcar #'reverse-command program)))

(defun bring-thing-program (thing-point)
  (let ((path-program (find-path-program entry-point thing-point)))
	 (append path-program '(pickup-thing) (reverse-program path-program) '(drop-thing))))

(defun bring-things-program ()
  (reduce #'append (mapcar #'bring-thing-program thing-points)))

> Ждём лисповерсию, и eugene_kosenko с его мегаанализом :-)

Шутить изволите...

Параметр                        | Лисп | Питон | Окамл
-------------------------------------------------------
Общая длина                     | 1158 |  1462 |  1627
Смысловая длина                 |  331 |   604 |   603
Общий тезаурус                  |  160 |   195 |   164
Смысловой тезаурус              |   85 |   154 |   113
Общая насыщенность (в %)        |   29 |    41 |    37
Насыщенность тезауруса (в %)    |   53 |    79 |    69
Общая выразительность (в %)     |   14 |    13 |    10
Смысловая выразительность (в %) |   26 |    25 |    19

Лисповая версия пока без сокетов, потому преимущества по длине у него,
скорее всего, нет. Зато смысловая длина и смысловой тезаурус (создание
и использование новых понятий) почти в два раза ниже. Причем могу эту
цифру еще уменьшить за счет удаления некоторых функций путем
подстановки, хотя выигрыш в Лиспе достигается за счет малых затрат на
определение функций. Кстати, в этом деле абсолютным чемпионом является
Форт, а я при написании использовал его парадигму -- создание
множества коротких определений. Поэтому результат почти очевиден. По
насыщенности разница примерно на треть, то есть, в Лиспе использовано
больше "сахара", но это скорее мое стремление задействовать весь
арсенал. По выразительности получается почти то же самое.

Кстати, эту программу писал полностью сам, не "обезьянничая", выбрал
довольно оригинальные структуры данных. В целом кажется, что Лисп
оставляет больше времени на обдумывание.

Респект. Веремени на это дело сейчас нет ;-( Но судя по всему программу можно укоротить раза в 2. Например не понял, зачем такой замысловатый способ вывода карты. Вот наброски сокетов для LispWorks:

Сервер:
(defun serve-world (port)
  (labels ((talk-with-client (stream)
              (unwind-protect
                 (let ((world (make-world-from-lines (load-map stream))))
                   (serve-world-client world stream))
                   (close stream)))
           (world-service-server (handle)
             (let ((stream (make-instance 'comm:socket-stream
                               :socket handle                               
                               :direction :io                               
                               :element-type 'base-char)))
               (mp:process-run-function "World" () 'talk-with-client stream))))
   (comm:start-up-server :function 'world-service-server :service port)))

Клиент:
(defun connect-world-server (address port)
  (with-open-stream (world-service (comm:open-tcp-stream address port))
    (talk-with-world-service ...)))

Еще не понятно запускают ли OCaml и Python версии отдельные сервера и процессы для каждого клиента ?

Всё сразу охватить времени нет. По кусочкам :)

> (defun inside-interval-p (interval value)
>   (and 
> 	(>= value (car interval))
> 	(<= value (cdr interval))))
>
> (defun inside-world-p (point)
>   (and
> 	(inside-interval-p (cons 1 bound-x) (realpart point))
> 	(inside-interval-p (cons 1 bound-y) (imagpart point))))

Зачем так "навороченно"? :)

(defmacro inside-interval-p (margin value)
  `(and (>= ,value 1) (<= ,value ,margin)))

(defun inside-world-p (point)
  (and
	(inside-interval-p bound-x (realpart point))
	(inside-interval-p bound-y (imagpart point))))

или совсем только так

(defun inside-world-p (point)
  (and (>= #1=(realpart point) 1) (<= #1# bound-x)
       (>= #2=(imagpart point) 1) (<= #2# bound-y)))

может можно ещё короче? :) Раз вызывается один раз - можно и её раскрыть. Вместо 

> (defun wallp (point)
>   (or
> 	(not (inside-world-p point))
> 	(not (null (member point wall-points)))))

(defun wallp (point)
  (or
    (not (and (>= #1=(realpart point) 1) (<= #1# bound-x)
              (>= #2=(imagpart point) 1) (<= #2# bound-y)))
    (not (null (member point wall-points)))))

Да, возможно читается несколько хуже. Но, имхо, нагляднее :)

P.S. Ладно, остально позже.

Да, у меня (ocaml версия) запускается отдельный процесс на каждого клиента.

Тут без концептуальных изменений существенно не укоротить. Для кросс-платформенных сокетов вероятно сойдет trivial-sockets (http://www.cliki.net/trivial-sockets):

Usage examples:

(with-open-stream (s (trivial-sockets:open-stream "www.google.com" 80)) 
  (format s "HEAD / HTTP/1.0~%Host: www.google.com~%~%") 
  (force-output s) 
  (loop 
    (let ((l (read-line s nil nil))) 
      (unless l (return)) 
      (princ l) (terpri))))

(trivial-sockets:with-server (s (:port 8913 :reuse-address t))
   (loop
    (with-open-stream (c (trivial-sockets:accept-connection s)) 
        (read-line c)
        (format c "Hi there!~%"))))

> Еще не понятно запускают ли OCaml и Python версии отдельные сервера и процессы для каждого клиента ?

Ну у меня в питоне так:

Запускается процесс сервер: advserver.py world.dat 9876

Теперь к нему может цепляться любой клент. Все они работают с одним миром, который обсчитывается сервером.

Человеческий клиент работает так: hclient.py localhost 9876

Робот-клиент: hclient.py localhost 9876

Вы однако вступили на темную сторону силы ;-) использование EVAL здесь явный overkill. Еще заметно множество подозрительных setq. Ну и так по мелочи: например with-open-file без указания :direction. А все равно Вы молодец.

А как запустить лисповую версию, что для этого надо?

> Во-первых, считается ли, что роботу доступна вся карта, то есть, известных расположения всех предметов?

Да.

> Во-вторых, что делать роботу, если он обнаруживает принципиальную недостижимость некоторых предметов, которые находятся в замкнутой комнате? У меня в этом случае выбрасывается исключение, но я его нигде не обрабатываю.

А фиг его знает, что ему делать :-) Исключение, наверное, нормально.

У меня тоже в роботе происходит исключение RoutingError, и оно тоже нигде не обрабатывается.

Кстати, я не понял, а в лисповой версии человеческий клиент есть? Или только робот?

В Питоне и OCaml-е есть и человеческий клиент, и робот-клиент.

Кстати, по линкам с D нашёл такую телегу про C++ vs Lisp http://userpages.umbc.edu/~bcorfm1/C++-vs-Lisp.html

>Запускается процесс сервер: advserver.py world.dat 9876 >Теперь к нему может цепляться любой клент. Все они работают с одним >миром, который обсчитывается сервером.

Несколько роботов шарятся по одной и той же карте ? Что значит "любой клиент" ? IMHO каждому клиенту свой свежий мир надо давать.

http://www.digitalmars.com/d/lisp-java-d.html

45 строк на LISP против 55 строк на D

D выбор настроящих программистов?

Повторяю. Да где там 55 строк ???, даже по грубым замерам вроде больше 60 получается, если откинуть все комментарии и строки, где одна фигурная скобка или одно слово вроде continue. D cмахивает на C# однако или C# на D ;-)

http://www.digitalmars.com/d/lisp-java-d.html

45 строк на LISP против 55 строк на D

D выбор настроящих программистов?

> Кстати, я не понял, а в лисповой версии человеческий клиент есть? Или только робот?

Человеческий клиент сводится к набору тривиальных функций-команда go-east, go-west, go-north, go-south, pickup-thing, drop-thing, show-world, reset-world и макро do-program, которое исполняет список команд, переданный в качестве аргумента. Кроме того, можно включить трассировку, тогда после каждой команды будет выводиться карта мира.

Робот сводится к тривиальному вызову bring-things-program, который возвращает список-программу для сбора всех вещей. Эта программа может быть подана в do-program.

> В Питоне и OCaml-е есть и человеческий клиент, и робот-клиент.

Я ж сказал, что сокеты не сделаны. Сейчас расковырял cl-trivial-sockets, похоже, получится еще красивее. Просто сетевое взаимодействие -- не мой профиль. Лет 5 назад баловался многопоточными игрушечными серверами на Ruby, но это все несерьезно.

> Тут без концептуальных изменений существенно не укоротить.

Не результата ради, а демонстрации для:

> (defun defentities (form names)
>   (mapcar #'eval (mapcar form names)))

> (defentities
>   #'(lambda (name) `(defvar ,name nil))
>   '(image-name bound-x bound-y wall-points entry-point 
> 	 thing-points hero-point hero-carries-thing-p trace-p))

Это тоже можно заменить на

(defmacro definities (&rest args)
  `(progn ,@(loop for d in args collect `(defvar ,d nil))))

(definities image-name bound-x bound-y wall-points entry-point 
            thing-points hero-point hero-carries-thing-p trace-p)

Далее: (not (null x)) равносильно самому x, если только тебе не надо приципиально получить T вместо конкретного значения.

Глобальные переменные - это зло ;-)

Согласен, но до глобального передела проекта дело ещё не дошло :)

Все по порядку ;)

Вот несколько сокращённая версия read-world:

(defun read-world (file-name)
  (setf image-name file-name
	wall-points ()
	thing-points ()
	hero-carries-thing-p nil)
  (with-open-file (file file-name)
    (loop for line = (read-line file nil nil)
	  for y upfrom 1 
	  while line
	  do (loop for x upfrom 1 
		   for c across line 
		   do (cond
		       ((eq c #\#) (push (complex x y) wall-points))
		       ((eq c #\$) (push (complex x y) thing-points))
		       ((eq c #\.) 
			(setq entry-point (complex x y))
			(setq hero-point (complex x y))))
		   finally (setq bound-x (1- x)))
	  finally (setq bound-y (1- y))))
  (if trace-p (show-world)))

Хотя мне совсем непонятна система координат с 1, а не с 0. Имхо, ещё несколько можно было упростить программу :)

Упс, не заметил, что definities используется не один раз - прошу прощения :)

Ну где tailgunner тыкните его в проги носом:)

> Ну где tailgunner тыкните его в проги носом:)

Я за него!

А если серьёзно, у тебя есть какой-то анализ, выводы, аналитика по поводу решений на разных языках?

Если есть, то не держи это в себе, расскажи нам...