;;; -*- Mode: Lisp; Syntax: Common-Lisp; Base: 10; Package: USER -*-

(in-package "USER")

(export '(
	  )
	(find-package "USER"))

(defvar *childes-sentences* nil)
(defvar *number-of-childes-sentences*)
(defvar *childes-phonetic-sentences* nil)
(defvar *childes-semantic-sentences* nil)
(defvar *childes-semantic-data* nil)
(defvar *childes-semantic-dictionary* nil)
(defvar *at-childes-sentence* 0)

(defun load-childes-data ()
  (load *phonetics*)
  (load *semantics*)
  (load *semantic-dictionary*)
  (when (/= (length *childes-phonetic-sentences*)
	    (length *childes-semantic-sentences*))
    (error "~&There are ~D phonetic and ~D semantic sentences!!~%"
	   (length *childes-phonetic-sentences*)
	   (length *childes-semantic-sentences*)))
  (setf *childes-semantic-dictionary*
	(create-childes-semantic-dictionary *childes-semantic-data*))
  (setf *childes-sentences*
	(mapcar #'(lambda (ps ss)
		    (let ((sememes (get-sememe-set ss *childes-semantic-dictionary*)))
		      (list ps sememes (remove #\Space ps :test #'char=))))
		*childes-phonetic-sentences*
		*childes-semantic-sentences*))
  (setf *number-of-childes-sentences* (length *childes-sentences*))
  (values))

(defun create-childes-semantic-dictionary (semantic-data)
  (let ((ht (make-hash-table :test #'eq)))
    (dolist (sd semantic-data)
      (let ((sememe-set (second sd)))
	(if (null sememe-set) (setf sememe-set :EMPTY-SEMANTICS))
	(dolist (word (first sd))
	  (setf (gethash word ht) sememe-set))))
    ht))

(defun get-sememe-set (semantic-sentence semantic-dictionary)
  (let ((utterance-sememe-set nil))
    (dolist (word semantic-sentence)
      (let ((word-sememe-set (gethash word semantic-dictionary)))
	(unless word-sememe-set
	  (error "The word ~S has no semantic definition!!" word))
	(setf utterance-sememe-set (append utterance-sememe-set word-sememe-set))))
    utterance-sememe-set))

(defun generate-childes-sentence (&key (spaces 0.0))
  (if (>= *at-childes-sentence* *number-of-childes-sentences*)
      (setf *at-childes-sentence* 0))
  (let ((s (nth *at-childes-sentence* *childes-sentences*)))
    (incf *at-childes-sentence*)
    (let ((phonemes (if (zerop spaces)
			(third s)
			(remove-if #'(lambda (p)
				       (and (char= p #\Space) (>= (random 1.0) spaces)))
				   (first s)))))
      (values phonemes (second s)))))