;---------------------------------------------
  FORMULAS : This file contains some general formulas used in  .
;---------------------------------------------

(in-package 'user)

(defun update-temperature (&aux rule-weakness)
; Updates the temperature, which is a function of the average total-unhappiness
; of objects on the workspace (weigted by importance) and the weakness of the
; rule.
  (if* (not *clamp-temperature*)
   then (setq rule-weakness 
	      (if* (null *rule*) 
	       then 100
	       else (fake-reciprocal (send *rule* :total-strength))))
  
        (setq *temperature* 
	      (weighted-average 
	          `((,(send *workspace* :total-unhappiness) . 8) 
		    (,rule-weakness . 2))))))

;---------------------------------------------

(defun get-answer-temperature-threshold-distribution (&aux bond-density)
; Returns the probability-distribution from which to 
; choose a temperature threshold, used by rule-translator codelets in deciding
; whether or not to try to translate the rule and create an answer.  Which 
; distribution to use is a function of the amount of structure that has been 
; built (irrespective of its strength).  The more structure, the more the 
; distribution is slanted towards low temperatures.  The idea behind this
; can be given by listing the various cases:
;
;     If lots of structure has been built and it is good, then
;     the temperature will be low and it's probably a good time to try to 
;     create an answer, so return a distribution slanted towards low 
;     temperature, which, since the temperature is low, will make it likely 
      that the rule - translator  will decide to create an answer .
;
;     If lots of structure has been built and it isn't good, then the
;     temperature will be high.  Since the program has found some structure,
;     it is likely that there *is* a better way of structuring things, so
;     return a distribution slanted towards low temperature, i.e., make
;     it unlikely to create an answer soon.
;
;     If not much structure has been found, then it is not likely that much
      more will be found ( since the rule - translator  most likely
;     will not even be running until there has been opportunity to find
;     structure if there is any).  Thus the program shouldn't have to wait
;     much longer to go ahead and create an answer, since the lack of structure
;     at this point indicates that it probably will not be able to do much
;     better.  So return a distribution slanted more towards higher 
;     temperatures.
;
; This function only roughly measures how much structure there is.
  
  (if* (and (= (send *initial-string* :length) 1) 
	    (= (send *target-string* :length) 1))
   then (setq bond-density 1)
   else (setq bond-density 
	      (/ (length (append (send *initial-string* :bond-list) 
				 (send *target-string* :bond-list)))
	         (+ (1- (send *initial-string* :length))
		    (1- (send *target-string* :length))))))
		     
  (cond ((>= bond-density .8) 
	 %very-low-answer-temperature-threshold-distribution%)
        ((>= bond-density .6) 
	 %low-answer-temperature-threshold-distribution%)
        ((>= bond-density .4) 
	 %medium-answer-temperature-threshold-distribution%)
        ((>= bond-density .2) 
	 %high-answer-temperature-threshold-distribution%)
        (t %very-high-answer-temperature-threshold-distribution%)))

;---------------------------------------------

(defun get-temperature-adjusted-probability (prob &aux low-prob-factor
						       result)
  This function is a filter :   it inputs a value ( from 0 to 100 ) and returns
  a probability ( from 0 - 1 ) based on that value and the temperature .   When
  the temperature is 0 , the result is ( / value 100 ) , but at higher
  temperatures , values below 50 get raised and values above 50 get lowered
; as a function of temperature.
; I think this whole formula could probably be simplified.

  (setq result
	(cond ((= prob 0) 0)
	      ((<= prob .5)
               (setq low-prob-factor (max 1 (truncate (abs (log prob 10)))))
               (min (+ prob 
		       (* (/ (- 10 (sqrt (fake-reciprocal *temperature*))) 
			     100) 
			  (- (expt 10 (- (1- low-prob-factor))) prob)))
		    .5))
		     
   	      ((= prob .5) .5)
	      ((> prob .5)
               (max (- 1
		        (+ (- 1 prob) 
		           (* (/ (- 10 (sqrt (fake-reciprocal *temperature*))) 
			         100)
			      (- 1 (- 1 prob)))))
	            .5))))
  result)
		     
;---------------------------------------------

(defun test-get-temperature-adjusted-probability (prob)
(with-open-file (ostream "testfile" :direction :output 
	 	                  :if-does-not-exist :create
				  :if-exists :append) 
	(format ostream "prob: ~a~&" prob)
  (loop for temp in '(0 10 20 30 40 50 60 70 80 90 100) do
        (setq *temperature* temp)
        (format ostream "Temperature: ~a; probability ~a~&"
		temp (float (get-temperature-adjusted-probability prob))))
  (format ostream "~%")))

;---------------------------------------------

(defun get-temperature-adjusted-value-list (value-list &aux exponent)  
; Returns a list with values that are exponential functions of the original
; values, with the exponent being a function of the temperature.  The higher
; the temperature, the bigger the difference between unequal values.
  (setq exponent (+ (/ (fake-reciprocal *temperature*) 30) .5))
  (loop for value in value-list collect (round (expt value exponent))))

;---------------------------------------------

(defun test-get-tempterature-adjusted-value-list (value-list)
  (loop for temp in '(0 10 20 30 40 50 60 70 80 90 100) do
        (setq *temperature* temp)
        (format t "Temperature: ~a; adjusted-value-list: ~a~&"
		temp (get-temperature-adjusted-value-list value-list))))

;---------------------------------------------

(defun get-post-codelet-probability (structure-category &aux probability)
; This function gives the program a simple form of self-watching.  For a given
; structure-category (e.g., description, or bond), it returns a probability
; to use in deciding whether or not codelets looking for this type of 
; structure should be posted.  

  (cond ((eq structure-category 'description)
	 (setq probability (/ (sqr *temperature*) 100)))
	
	((eq structure-category 'bond) 
         (setq probability (send *workspace* :intra-string-unhappiness)))

        ((eq structure-category 'group) 
         (setq probability (send *workspace* :intra-string-unhappiness)))

       ((eq structure-category 'replacement)
	(setq probability
	      (if* (send *workspace* :unreplaced-objects) then 100 else 0)))

       ((eq structure-category 'correspondence)
        (setq probability (send *workspace* :inter-string-unhappiness)))

       ((eq structure-category 'rule)
        (setq probability 
	      (if* (null *rule*) 
	       then 100 else (send *rule* :total-weakness))))

	((eq structure-category 'translated-rule)
         (setq probability (if* *rule* then 100 else 0))))

  (/ probability 100))

;---------------------------------------------

(defun get-num-of-codelets-to-post (structure-category &aux number)
; This function gives the program a simple form of self-watching.  For a given
; structure-category (e.g., description, or bond), it returns the number
; of codelets looking for this type of structure that should be posted.  

  (cond ((eq structure-category 'description)
	 (setq number 1))
	
	((eq structure-category 'bond) 
         (setq number (case (send *workspace* :rough-num-of-unrelated-objects)
			    (few 1) (medium 2) (many 3))))

        ((eq structure-category 'group) 
         (setq number
	       (if* (null (send *workspace* :bond-list))
                then 0
	        else (case (send *workspace* 
			         :rough-num-of-ungrouped-objects) 
			         (few 1) (medium 2) (many 3)))))

       ((eq structure-category 'replacement)
        (setq number 
	      (if* *rule*
	       then 0
               else (case (send *workspace* :rough-num-of-unreplaced-objects)
                          (few 1) (medium 2) (many 3)))))


       ((eq structure-category 'correspondence)
         (setq number 
	       (case (send *workspace* :rough-num-of-uncorresponding-objects) 
		     (few 1) (medium 3) (many 3))))

       ((eq structure-category 'rule)
	(setq number 2))


       ((eq structure-category 'translated-rule)
        (setq number (if* (null *rule*) then 0 else 1))))

  number)

;---------------------------------------------

---------------------------------------------
---------------------------------------------
 Updates the temperature, which is a function of the average total-unhappiness
 of objects on the workspace (weigted by importance) and the weakness of the
 rule.
---------------------------------------------
 Returns the probability-distribution from which to 
 choose a temperature threshold, used by rule-translator codelets in deciding
 whether or not to try to translate the rule and create an answer.  Which 
 distribution to use is a function of the amount of structure that has been 
 built (irrespective of its strength).  The more structure, the more the 
 distribution is slanted towards low temperatures.  The idea behind this
 can be given by listing the various cases:

     If lots of structure has been built and it is good, then
     the temperature will be low and it's probably a good time to try to 
     create an answer, so return a distribution slanted towards low 
     temperature, which, since the temperature is low, will make it likely 

     If lots of structure has been built and it isn't good, then the
     temperature will be high.  Since the program has found some structure,
     it is likely that there *is* a better way of structuring things, so
     return a distribution slanted towards low temperature, i.e., make
     it unlikely to create an answer soon.

     If not much structure has been found, then it is not likely that much
     will not even be running until there has been opportunity to find
     structure if there is any).  Thus the program shouldn't have to wait
     much longer to go ahead and create an answer, since the lack of structure
     at this point indicates that it probably will not be able to do much
     better.  So return a distribution slanted more towards higher 
     temperatures.

 This function only roughly measures how much structure there is.
---------------------------------------------
 as a function of temperature.
 I think this whole formula could probably be simplified.
---------------------------------------------
---------------------------------------------
 Returns a list with values that are exponential functions of the original
 values, with the exponent being a function of the temperature.  The higher
 the temperature, the bigger the difference between unequal values.
---------------------------------------------
---------------------------------------------
 This function gives the program a simple form of self-watching.  For a given
 structure-category (e.g., description, or bond), it returns a probability
 to use in deciding whether or not codelets looking for this type of 
 structure should be posted.  
---------------------------------------------
 This function gives the program a simple form of self-watching.  For a given
 structure-category (e.g., description, or bond), it returns the number
 of codelets looking for this type of structure that should be posted.  
---------------------------------------------
  FORMULAS : This file contains some general formulas used in  .

(in-package 'user)

(defun update-temperature (&aux rule-weakness)
  (if* (not *clamp-temperature*)
   then (setq rule-weakness 
	      (if* (null *rule*) 
	       then 100
	       else (fake-reciprocal (send *rule* :total-strength))))
  
        (setq *temperature* 
	      (weighted-average 
	          `((,(send *workspace* :total-unhappiness) . 8) 
		    (,rule-weakness . 2))))))


(defun get-answer-temperature-threshold-distribution (&aux bond-density)
      that the rule - translator  will decide to create an answer .
      more will be found ( since the rule - translator  most likely
  
  (if* (and (= (send *initial-string* :length) 1) 
	    (= (send *target-string* :length) 1))
   then (setq bond-density 1)
   else (setq bond-density 
	      (/ (length (append (send *initial-string* :bond-list) 
				 (send *target-string* :bond-list)))
	         (+ (1- (send *initial-string* :length))
		    (1- (send *target-string* :length))))))
		     
  (cond ((>= bond-density .8) 
	 %very-low-answer-temperature-threshold-distribution%)
        ((>= bond-density .6) 
	 %low-answer-temperature-threshold-distribution%)
        ((>= bond-density .4) 
	 %medium-answer-temperature-threshold-distribution%)
        ((>= bond-density .2) 
	 %high-answer-temperature-threshold-distribution%)
        (t %very-high-answer-temperature-threshold-distribution%)))


(defun get-temperature-adjusted-probability (prob &aux low-prob-factor
						       result)
  This function is a filter :   it inputs a value ( from 0 to 100 ) and returns
  a probability ( from 0 - 1 ) based on that value and the temperature .   When
  the temperature is 0 , the result is ( / value 100 ) , but at higher
  temperatures , values below 50 get raised and values above 50 get lowered

  (setq result
	(cond ((= prob 0) 0)
	      ((<= prob .5)
               (setq low-prob-factor (max 1 (truncate (abs (log prob 10)))))
               (min (+ prob 
		       (* (/ (- 10 (sqrt (fake-reciprocal *temperature*))) 
			     100) 
			  (- (expt 10 (- (1- low-prob-factor))) prob)))
		    .5))
		     
   	      ((= prob .5) .5)
	      ((> prob .5)
               (max (- 1
		        (+ (- 1 prob) 
		           (* (/ (- 10 (sqrt (fake-reciprocal *temperature*))) 
			         100)
			      (- 1 (- 1 prob)))))
	            .5))))
  result)
		     

(defun test-get-temperature-adjusted-probability (prob)
(with-open-file (ostream "testfile" :direction :output 
	 	                  :if-does-not-exist :create
				  :if-exists :append) 
	(format ostream "prob: ~a~&" prob)
  (loop for temp in '(0 10 20 30 40 50 60 70 80 90 100) do
        (setq *temperature* temp)
        (format ostream "Temperature: ~a; probability ~a~&"
		temp (float (get-temperature-adjusted-probability prob))))
  (format ostream "~%")))


(defun get-temperature-adjusted-value-list (value-list &aux exponent)  
  (setq exponent (+ (/ (fake-reciprocal *temperature*) 30) .5))
  (loop for value in value-list collect (round (expt value exponent))))


(defun test-get-tempterature-adjusted-value-list (value-list)
  (loop for temp in '(0 10 20 30 40 50 60 70 80 90 100) do
        (setq *temperature* temp)
        (format t "Temperature: ~a; adjusted-value-list: ~a~&"
		temp (get-temperature-adjusted-value-list value-list))))


(defun get-post-codelet-probability (structure-category &aux probability)

  (cond ((eq structure-category 'description)
	 (setq probability (/ (sqr *temperature*) 100)))
	
	((eq structure-category 'bond) 
         (setq probability (send *workspace* :intra-string-unhappiness)))

        ((eq structure-category 'group) 
         (setq probability (send *workspace* :intra-string-unhappiness)))

       ((eq structure-category 'replacement)
	(setq probability
	      (if* (send *workspace* :unreplaced-objects) then 100 else 0)))

       ((eq structure-category 'correspondence)
        (setq probability (send *workspace* :inter-string-unhappiness)))

       ((eq structure-category 'rule)
        (setq probability 
	      (if* (null *rule*) 
	       then 100 else (send *rule* :total-weakness))))

	((eq structure-category 'translated-rule)
         (setq probability (if* *rule* then 100 else 0))))

  (/ probability 100))


(defun get-num-of-codelets-to-post (structure-category &aux number)

  (cond ((eq structure-category 'description)
	 (setq number 1))
	
	((eq structure-category 'bond) 
         (setq number (case (send *workspace* :rough-num-of-unrelated-objects)
			    (few 1) (medium 2) (many 3))))

        ((eq structure-category 'group) 
         (setq number
	       (if* (null (send *workspace* :bond-list))
                then 0
	        else (case (send *workspace* 
			         :rough-num-of-ungrouped-objects) 
			         (few 1) (medium 2) (many 3)))))

       ((eq structure-category 'replacement)
        (setq number 
	      (if* *rule*
	       then 0
               else (case (send *workspace* :rough-num-of-unreplaced-objects)
                          (few 1) (medium 2) (many 3)))))


       ((eq structure-category 'correspondence)
         (setq number 
	       (case (send *workspace* :rough-num-of-uncorresponding-objects) 
		     (few 1) (medium 3) (many 3))))

       ((eq structure-category 'rule)
	(setq number 2))


       ((eq structure-category 'translated-rule)
        (setq number (if* (null *rule*) then 0 else 1))))

  number)

