Главное меню
Мы солидарны с Украиной. Узнайте здесь, как можно поддержать Украину.

Программный генератор лексики, если лень

Автор arseniiv, июля 27, 2008, 20:47

0 Пользователи и 1 гость просматривают эту тему.

BurSer

В разделе Syl пишу:

Allow_CV=0
Allow_CVC=0
Allow_VC=1
Allow_V=0
CV_MaxCons=1
CVC_MaxFirstCons=1
CVC_MaxLastCons=1
VC_MaxCons=1

В разделе Letters пишу:

OpenCs=b d f g h j k l m n p r s t v w z
OpenVs=a e i o u
ClosedFCs=b d f g h j k l m n p r s t v w z
ClosedLCs=f h j l m n r s v z
ClosedVs=a e i o u
SClosedCs=0
SClosedVs=0
VowelVs=a e i o u

На выходе получаю строки типа 000, 0000 и т.п.

arseniiv

SClosedCs и SClosedVs (SClosed = semi-closed, полузакрытый, мой "термин" для VC) заполните. Как раз эти строки влияют на генерацию при Allow_VC=1 :)

BurSer



addewyd

Цитата: Artemon от августа 28, 2008, 22:21
А чом би й ні? Сейчас работаю над конлангом.
Программу вашу скачал, посмотрел. Вроде всё работает, спасибо.
Просто пока до словаря не добрался. :)

Лучше вот это зацените. А доработать до генератора лексики - 5 минут.
Просто вместо слов читать буквы.

[size=1]
;;;; -*- Mode: Lisp; Syntax: Common Lisp -*-
;;;; Addewyd, Mon Aug 11 1999
;;;; bred, v.0.2

(defvar *word-1* nil)
(defvar *word-2* nil)
(defvar *tree* (list nil nil nil))

(defun get-words (stream)
    (if *word-1*
        (setf *word-1* *word-2* *word-2* (read-word stream))
        (setf *word-1* (read-word stream) *word-2* (read-word stream))))

(defun alpha-char-p-v (c)
#+CLISP (or
(char= c (int-char 215))
(char= c (int-char 247))
(char= c #,)
(char= c #!)
(char= c #.)
(char= c #?)
(alpha-char-p c))
#-CLISP (alpha-char-p c)
)

(defun read-word (stream)
    (let (c (str "") (d (skip-not-alpha stream)))
        (when d (setq str (string-append str d)))
(if (find d ".!,?") (string d)
        (loop
            (setq c (read-char stream nil nil))
            (cond
                ((null c) (return str))
((find c ".!?,")  (unread-char c stream) (return str)  )
                ( (and (alpha-char-p-v c)  (not (find c ".!,?"))  )
                    (setq str (string-append str c)))
                (t (return str)))))
       (string-downcase str)))
       

(defun skip-not-alpha (stream)
    (let (c)
        (loop
            (setq c (read-char stream nil nil))
            (cond
                ((null c) (return nil))
                ((alpha-char-p-v c)
(return c))
                (t t)))))

(defun tree-add (word nextword tree)
    (cond
((string= word "") nil)
        ((null (car tree))
            (setf (car tree)
                (list word 1 (list (list nextword 1)))))
        ((string= word (caar tree))
            (incf (second (first tree)))
                (add-next nextword (third (car tree))))
        ((string< word (caar tree))
            (unless (second tree)
                (setf (second tree) (list ()()())))
            (tree-add word nextword (second tree)))
        (t (unless (third tree)
                (setf (third tree) (list ()()())))
            (tree-add word nextword (third tree)))))

(defun add-next (word lst)
    (let ((el (member word lst
        :test #'(lambda (i l) (string= (car l) i)))))
        (if el
            (incf (second (first el)))
            (nconc lst (list (list word 1))))))

(defun find-word (tree word)
    (cond
        ((null tree) nil)
        ((string= (caar tree) word) (car tree))
        ((string< word (caar tree))
(find-word (second tree) word))
        (t (find-word (third tree) word))))

(defun choose-word (lst)
    (if lst
        (let* ((n (apply #'+ (mapcar #'cadr lst)))
            (r (random n)) 
            (l (length lst))
            (m 0))
            (loop
                (decf l)
                (when (or (< (decf r (cadr (nth m lst))) 0) (< l 1))
                    (return (car (nth m lst))))
                (incf m)))
        nil))

(defun string-append (str chr)
    (string-concat str (make-string 1 :initial-element chr)))

(defun generate-tree (fname)
    (with-open-file (stream fname)
        (loop
            (get-words stream)
            (tree-add *word-1* *word-2* *tree*)
            (when (string= *word-2* "") (return *tree*)))))

(defun write-text (tree)
    (let ((wrd (first tree)) (n 0) w-next)
        (loop
            (unless (and wrd (setf w-next (choose-word (third wrd))))
                (return))
            (format t "~A " (first wrd))
            (when (> (incf n) 7) (setq n 0) (terpri))
            (setf wrd (find-word tree w-next)))))

#-CLISP
(defvar *arguments* '("test.txt"))
#+CLISP
(defvar *arguments* *args*)

(defun main ()
    (setf *random-state* (make-random-state t))
    (if (car *arguments*)

(let ((tree (generate-tree (car *arguments*))))
;; (print tree)
(write-text tree))

        (princ "Usage: bred <filename>")))

(main)
[/size]

myst

А что оно делает? :???
Цитата: "addewyd" от
(char= c #,)
(char= c #!)
(char= c #.)
(char= c #?)
Здесь после решёток обратные слэши должны быть.

addewyd

Да, они и были. ушли, несмотря на <code>

a 215 b 247 -- workaround для CLISP 1999 года. Устарело немного...


myst

Цитата: "addewyd" от
Да, они и были. ушли, несмотря на <code>
Так эта... программа-то чово делает? :what:

RawonaM

Цитата: "arseniiv" от
Программный генератор лексики, если лень
А программный генератор языков будет? Я может тоже хочу свой язык, но мне лень :)


arseniiv

Цитата: RawonaM от апреля 21, 2009, 18:01
А программный генератор языков будет? Я может тоже хочу свой язык, но мне лень :)
Это спросите у Когони Буть, он такое вроде разрабатывал ;-)

USL

Цитата: arseniiv от июля 27, 2008, 20:47
Если кого-нибудь интересует программный генератор слов (по набору правил) для какого-нибудь языка, то, пожалуйста, напишите. Тогда я выложу программу и справку. Если не интересует, тогда лучше пусть модераторы удалят эту тему, чтобы не мешала, потому что вряд ли прямое отношение к лингвистике имеет. Если всё же интересует, то любые пожелания принимаются с попыткой воплотить в жизнь

Уважаемый Арсений! Ваше предложение еще в силе - на тему "попытки воплотить в жизнь"?
Меня эта тема очень заинтересовала, хотелось бы обсудить.
Спасибо за прогу, скачал, сейчас постараюсь разобраться.

addewyd

я бы тоже поучаствовал
как бы програмист. кажется... или нет...

addewyd


myst

Цитата: addewyd от мая  6, 2009, 16:22
сочиняет нечто вроде бреда
Я скормил ей одно предложение, так она только пробел перед знаком вопроса вставила и всё. :donno:




myst



shinkarom

Скачайте Langmaker и пройдите обучение. По-моему, выполняет похожие задачи.
Мой блог //allthetongues.hol.es

Быстрый ответ

Обратите внимание: данное сообщение не будет отображаться, пока модератор не одобрит его.

Имя:
Имейл:
Проверка:
Оставьте это поле пустым:
Наберите символы, которые изображены на картинке
Прослушать / Запросить другое изображение

Наберите символы, которые изображены на картинке:

√36:
ALT+S — отправить
ALT+P — предварительный просмотр