#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}
package require XOTcl ; namespace import -force xotcl::*
# За последние два дня на хабре появилась пара статей про программирование КПК на C# и C++. Это побудило меня написать цикл статей про тоже самое, а заодно познакомить читателей хабра, да и себя самого с такими технологиями, о которых мало кто слышал, но которые почти не имеют аналогов. Итак, резултатом статей будет программа для КПК, которая помогает что-либо учить. Работать она будет по методике карточек: одна сторона слово неизвестное, другая его значение. По дороге куда-либо просматриваем карточки, если слово неизвестное уже стало известно, то переходим к следующей карточке, иначе смотрим его значение и пытаемся запомнить.
# Язык, на которым будет написано приложение, — TCL. Этот великолепный язык, возможно, не имеет аналогов. Благодаря его примитивному синтаксису, идея метапрограммирования и DSL в нем реализована по максимому. Например, существует расширение TCL, написанное как библиотека к нему, которое превращает его в язык похожий на smalltalk и ruby: вызов методов через посылку сообщений, интроспекция объектов и классов, возможность динамически изменять классы и отделные объекты, возможность менять класс объекта (!) и, конечно же, мета-классы и method_missing. Именно на этом расширении я и буду писать. Имя ему xotcl.
# Сегодня я создам движок приложения. В отличии от карточек, которые мы перебираем последовательно или случайно я хочу, что бы те слова, которые я не знаю выбирались чаще, поэтому необходимо хранить статистику. Очевидно, что вопрос, который будет задан, связан с этой статистикой, а так же, что ответ на вопрос — знаю или не знаю — то же связан с этой статистикой. Пусть вопрос это будет объект класса Exam с соответствующими методами pass, fail, question и answer. А сам класс Exam будет экземпляром метакласса Session, который будет имееть дело со статистикой. Таким образом мы связали логическое отношение сущностей в отношение, выраженное в языке.
# Ниже соответсвующий код.
Class Session -superclass Class ; # определяю метакласс Session
# Далее я определю a-la method_missing метод для обработки кода вида: «Session data.db Exam», где
# data.db — файл со статистикой
# Exam — имя класса, файл состоит из строк вида: «wins defeats {question answer}», где wins — количество побед, defeats — количество поражений, question — неизвестное слово, answer — его значение
# Метод загружает статистику и сохраняет её как переменную класса Exam и определяет сам класс Exam.
Session proc unknown {file_name class_name} {
Class $class_name -parameter {id} ; # определяю класс $class_name
# читаю статистику из файла и сохраняю её в массиве knowledge как говорят жабисты class variable
set id 0
set db [open $file_name r]
while {![eof $db]} {
foreach {wins defeats dictionary} [gets $db] {
$class_name set knowledge($id,wins) $wins
$class_name set knowledge($id,defeats) $defeats
$class_name set knowledge($id,dictionary) $dictionary
incr id
}
}
close $db
$class_name set knowledge(count) $id
# определяю class method для сохранения статистики
$class_name proc save {file_name} {
set db [open $file_name w]
for {set id 0} {$id<[[self] set knowledge(count)]} {incr id} {
set wins [[self] set knowledge($id,wins)]
set defeats [[self] set knowledge($id,defeats)]
set dictionary [[self] set knowledge($id,dictionary)]
puts $db [list $wins $defeats $dictionary]
}
close $db
}
# перегружаю обработчик сообщения create, отвечающий за создание
# экземпляза класса
$class_name proc create {args} {
# код ниже определяет какой вопрос следует задать. Алгоритм
# примерно следующий: составляю отрезок из отрезков длинна
# которых равна отношению количества провалов к сумме
# попыток. Нормирую его, а затем беру случайное число от
# 0 до 1 и выбираю какой отрезок его содержит.
set current null
set i 0
set omega 0
for {set id 0} {$id<[[self] set knowledge(count)]} {incr id} {
set wins [[self] set knowledge($id,wins)].0
set defeats [[self] set knowledge($id,defeats)].0
set sum [expr {$wins+$defeats}]
set delta($id) [expr {$defeats/$sum}]
set omega [expr {$omega+$delta($id)}]
}
set probe [expr {rand()*$omega}]
set sum 0
foreach key [array names delta] {
set current $key
set sum [expr {$sum+$delta($key)}]
if {$probe<$sum} break
}
# передаю управление стандартному механизму создания
# экземпляра класса с передачей параметра current,
# который указывает на вопрос который следует задать.
next [lindex $args 0] -id $current
}
# прошел тест
$class_name instproc pass {} {
[[self] class] incr knowledge([my id],wins)
}
# завалил тест
$class_name instproc fail {} {
[[self] class] incr knowledge([my id],defeats)
}
# возвращает вопрос
$class_name instproc question {} {
lindex [[[self] class] set knowledge([my id],dictionary)] 0
}
# возвращает ответ
$class_name instproc answer {} {
lindex [[[self] class] set knowledge([my id],dictionary)] 1
}
return $class_name
}
# Ниже простой пример использования написанной части программы
# Создаю объект Exam (фактически класс) класса (фактически
# мета-класса) Session и загружаю в него статистику из
# файла data.db
Session data.db Exam
Exam test ; # Создаю тест
puts [test question] ; # Узнаем какой вопрос
# Если вопрос green то мы притворяемся, что его не знаем и
# смотрим ответ иначе гордо говорим знаю
if {[string equal [test question] green]} {
puts [test answer]
test fail
} {
test pass
}
test destroy ; # удаляю объект
Exam save 2data.db ; # сохраняем статистику
# \
exec tclsh "$0" ${1+"$@"}
package require XOTcl ; namespace import -force xotcl::*
# За последние два дня на хабре появилась пара статей про программирование КПК на C# и C++. Это побудило меня написать цикл статей про тоже самое, а заодно познакомить читателей хабра, да и себя самого с такими технологиями, о которых мало кто слышал, но которые почти не имеют аналогов. Итак, резултатом статей будет программа для КПК, которая помогает что-либо учить. Работать она будет по методике карточек: одна сторона слово неизвестное, другая его значение. По дороге куда-либо просматриваем карточки, если слово неизвестное уже стало известно, то переходим к следующей карточке, иначе смотрим его значение и пытаемся запомнить.
# Язык, на которым будет написано приложение, — TCL. Этот великолепный язык, возможно, не имеет аналогов. Благодаря его примитивному синтаксису, идея метапрограммирования и DSL в нем реализована по максимому. Например, существует расширение TCL, написанное как библиотека к нему, которое превращает его в язык похожий на smalltalk и ruby: вызов методов через посылку сообщений, интроспекция объектов и классов, возможность динамически изменять классы и отделные объекты, возможность менять класс объекта (!) и, конечно же, мета-классы и method_missing. Именно на этом расширении я и буду писать. Имя ему xotcl.
# Сегодня я создам движок приложения. В отличии от карточек, которые мы перебираем последовательно или случайно я хочу, что бы те слова, которые я не знаю выбирались чаще, поэтому необходимо хранить статистику. Очевидно, что вопрос, который будет задан, связан с этой статистикой, а так же, что ответ на вопрос — знаю или не знаю — то же связан с этой статистикой. Пусть вопрос это будет объект класса Exam с соответствующими методами pass, fail, question и answer. А сам класс Exam будет экземпляром метакласса Session, который будет имееть дело со статистикой. Таким образом мы связали логическое отношение сущностей в отношение, выраженное в языке.
# Ниже соответсвующий код.
Class Session -superclass Class ; # определяю метакласс Session
# Далее я определю a-la method_missing метод для обработки кода вида: «Session data.db Exam», где
# data.db — файл со статистикой
# Exam — имя класса, файл состоит из строк вида: «wins defeats {question answer}», где wins — количество побед, defeats — количество поражений, question — неизвестное слово, answer — его значение
# Метод загружает статистику и сохраняет её как переменную класса Exam и определяет сам класс Exam.
Session proc unknown {file_name class_name} {
Class $class_name -parameter {id} ; # определяю класс $class_name
# читаю статистику из файла и сохраняю её в массиве knowledge как говорят жабисты class variable
set id 0
set db [open $file_name r]
while {![eof $db]} {
foreach {wins defeats dictionary} [gets $db] {
$class_name set knowledge($id,wins) $wins
$class_name set knowledge($id,defeats) $defeats
$class_name set knowledge($id,dictionary) $dictionary
incr id
}
}
close $db
$class_name set knowledge(count) $id
# определяю class method для сохранения статистики
$class_name proc save {file_name} {
set db [open $file_name w]
for {set id 0} {$id<[[self] set knowledge(count)]} {incr id} {
set wins [[self] set knowledge($id,wins)]
set defeats [[self] set knowledge($id,defeats)]
set dictionary [[self] set knowledge($id,dictionary)]
puts $db [list $wins $defeats $dictionary]
}
close $db
}
# перегружаю обработчик сообщения create, отвечающий за создание
# экземпляза класса
$class_name proc create {args} {
# код ниже определяет какой вопрос следует задать. Алгоритм
# примерно следующий: составляю отрезок из отрезков длинна
# которых равна отношению количества провалов к сумме
# попыток. Нормирую его, а затем беру случайное число от
# 0 до 1 и выбираю какой отрезок его содержит.
set current null
set i 0
set omega 0
for {set id 0} {$id<[[self] set knowledge(count)]} {incr id} {
set wins [[self] set knowledge($id,wins)].0
set defeats [[self] set knowledge($id,defeats)].0
set sum [expr {$wins+$defeats}]
set delta($id) [expr {$defeats/$sum}]
set omega [expr {$omega+$delta($id)}]
}
set probe [expr {rand()*$omega}]
set sum 0
foreach key [array names delta] {
set current $key
set sum [expr {$sum+$delta($key)}]
if {$probe<$sum} break
}
# передаю управление стандартному механизму создания
# экземпляра класса с передачей параметра current,
# который указывает на вопрос который следует задать.
next [lindex $args 0] -id $current
}
# прошел тест
$class_name instproc pass {} {
[[self] class] incr knowledge([my id],wins)
}
# завалил тест
$class_name instproc fail {} {
[[self] class] incr knowledge([my id],defeats)
}
# возвращает вопрос
$class_name instproc question {} {
lindex [[[self] class] set knowledge([my id],dictionary)] 0
}
# возвращает ответ
$class_name instproc answer {} {
lindex [[[self] class] set knowledge([my id],dictionary)] 1
}
return $class_name
}
# Ниже простой пример использования написанной части программы
# Создаю объект Exam (фактически класс) класса (фактически
# мета-класса) Session и загружаю в него статистику из
# файла data.db
Session data.db Exam
Exam test ; # Создаю тест
puts [test question] ; # Узнаем какой вопрос
# Если вопрос green то мы притворяемся, что его не знаем и
# смотрим ответ иначе гордо говорим знаю
if {[string equal [test question] green]} {
puts [test answer]
test fail
} {
test pass
}
test destroy ; # удаляю объект
Exam save 2data.db ; # сохраняем статистику