#! /usr/bin/env guile
!#
;
  Atomspace deduplication repair script
;
; Due to bugs, the SQL backend can end up with multiple copies of
; atoms. This script will find them, merge them, and sum the counts
; on the associated count truth values.  Its up to you to recompute
; anything else.
;
; This script focuses on single-words and the pairs they appear in.

(load "common.scm")

; ------------------------------------------------
(define (find-pairs wuid)
"
  find-pairs -- given a uuid of single word, find all word-pairs
  which contain the word.  The wuid must be the uuid of a WordNode.

  Returns a list of ListLink pairs that contain the WordNode.
"
	(define row #f)
	(define pair-list (list))

  type=8 is the 
	(define qry "SELECT * FROM atoms WHERE type=8")
	(dbi-query conxion qry)

	(set! row (dbi-get_row conxion))
	(while (not (equal? row #f))

  Extract the outgoing set of the 
		(let ((outset (cdr (assoc "outgoing" row))))
			(if (any (lambda (x) (eq? x wuid)) outset)
				(begin
					; (display "contains ")(display outset)(newline)
					(set! pair-list (cons outset pair-list))
				)
			)
			(set! row (dbi-get_row conxion))
		)
	)
	; Return the list of pairs
	pair-list
)

(define (find-list-link pair)
"
  Given a pair of UUID's, get the uuid of the ListLink that holds it.
  Return that UUID, else return zero
"
	(define luid 0)
	(define row #f)
	(define qry (string-append
		"SELECT * FROM atoms WHERE type=8 AND outgoing="
		(make-outgoing-str pair)))
  ( display qry)(newline )
	(dbi-query conxion qry)

	(set! row (dbi-get_row conxion))
	(while (not (equal? row #f))
		(set! luid (cdr (assoc "uuid" row)))
		(set! row (dbi-get_row conxion))
	)
  ( display "  : " ) ( display luid)(newline )
	luid
)

(define (sum-up-eval-counts wuid auid pair-list)
"
  sum-up-eval-counts -- look for identical word-pairs
  wuid -- uuid of a word node
  auid -- uuid of another word node (holding same word)
  pair-list -- list of uuid-pairs, one of which is wuid.

  Given a list of pairs containing wuid, find the ListLinks
  correspodning tio them.  Also: find the ListLinks that hold
  the corresponding auid.  Then find the EvaluationLinks that
  correspond to these, sum up the count TV's on them and then
  delete the ListLink and EvalLink that correspond to auid.
"
	; Replace wuid by auid in the pair
	(define (replace wuid auid pair)
		(if (eq? wuid (car pair))
			(list auid (cadr pair))
			(list (car pair) auid)
		)
	)
	; Create list of pairs with the alternate pair in it
	(define alt-list (map (lambda (x) (replace wuid auid x)) pair-list))

  Create parallel lists of UUID 's of the ListLinks of the pairs
	(define luid-list (map find-list-link pair-list))
	(define laid-list (map find-list-link alt-list))

  Get the column value on the EvalLink that holds the  UUID
	(define (get-col colm uuid)
		(define row #f)
		(define val 0)
		(define qry (string-append
			"SELECT * FROM atoms WHERE type="
			EvalLinkType
			" AND outgoing="
			(make-outgoing-str (list uuid-of-any uuid))))
  ( display qry)(newline )
		(dbi-query conxion qry)

		(set! row (dbi-get_row conxion))
		(while (not (equal? row #f))
			(set! val (cdr (assoc colm row)))
			(set! row (dbi-get_row conxion))
		)
		val
	)

  Get the stv - count on the EvalLink that holds the  UUID
	(define (get-count uuid) (get-col "stv_count" uuid))

  Get the uuid of the EvalLink that holds the  UUID
	(define (get-eval-uuid uuid) (get-col "uuid" uuid))

	; Sum the counts
  Given :  the uuid of a  containing a word pair ,
         laid the uuid of a  containing alternative word - pair
  Then : the EvaluationLinks holding  , laid are found ,
  the stv_counts on them are sumed ,
  the count on the evlink holding luid is updated
	; the laid and the evlink holding laid are deleted.
	(define (sum-counts luid laid)
		(if (and (< 0 luid) (< 0 laid))
  eud contains uuid of EvaluationLink holding luid
			; aud ... etc.. holdings laid
			(let* ((eud (get-eval-uuid luid))
					(aud (get-eval-uuid laid))
				)
				(if (and (< 0 eud) (< 0 aud))
					(let* ((lcnt (get-count luid))
							(acnt (get-count laid))
							(scnt (+ lcnt acnt))
							(upd (string-append
								"UPDATE atoms SET stv_count="
								(number->string scnt)
								" WHERE uuid="
								(number->string eud)
								";"))
							(apd (string-append
								"DELETE FROM atoms WHERE uuid="
								(number->string aud)
								";"))
							(alt (string-append
								"DELETE FROM atoms WHERE uuid="
								(number->string laid)
								";"))
						)
						;(display "summo cnt ") (display lcnt)
						;(display " + ") (display acnt)
( display " = " ) ( display scnt )
						;(display " for ") (display luid)
						;(display "(") (display eud)
						;(display ") and ") (display laid)
						;(display "(") (display aud) (display ")")
						;(newline)
						;(display upd) (newline)
						(dbi-query conxion upd)
( display ( dbi - get_status conxion ) ) ( newline )
						(flush-query)
( display apd ) ( newline )
						(dbi-query conxion apd)
( display ( dbi - get_status conxion ) ) ( newline )
						(flush-query)
						;(display alt) (newline)
						(dbi-query conxion alt)
( display ( dbi - get_status conxion ) ) ( newline )
						(flush-query)
						scnt
					)
					;(begin
	 ( display " Missing eval i d " ) ( display eud )
					;	(display "(for ")(display luid)
					;	(display ") and ") (display aud)
					;	(display "(for ")(display laid)
					;	(display ")")(newline)
						#f
					;)
				)
			)
			(begin
				;(display "Missing list-alt id for ") (display luid)
				;(newline)
				#f
			)
		)
	)

	; Discard alternates
	; XXX technically, this is wrong, we should be renaming these...
	(define (bug-cleanup laid)
		(if (< 0 laid)
;			(let* ((aud (get-eval-uuid laid)))
;				(if (< 0 aud)
					 ( let * ( ( apd ( string - append
;								"DELETE FROM atoms WHERE uuid="
;								(number->string aud)
;								";")))
						 ( display  ) ( newline )
;						(dbi-query conxion apd)
						 ( display ( dbi - get_status conxion ) ) ( newline )
;						(flush-query)
;					)
;				)
;			)
			(let ((alt (string-append
						"DELETE FROM atoms WHERE uuid="
						(number->string laid)
						";")))
				(display alt) (newline)
				(dbi-query conxion alt)
				(display (dbi-get_status conxion)) (newline)
				(flush-query)
				#t
			)
			#f
		)
	)

	(define cnt-list (filter-map sum-counts luid-list laid-list))
	; (define cnt-list (filter-map bug-cleanup laid-list))

	; (display alt-list) (newline)
	(display "num of word-pairs: ") (display (length pair-list))(newline)
	(display "num of alt-pairs: ") (display (length alt-list))(newline)
	(display "num luids (ListLinks): ") (display (length luid-list))(newline)
	(display "num of laids (listLinks holding alts): ") (display (length
		(filter (lambda (x) (< 0 x)) laid-list)))(newline)
	(display "num actually fixed up: ") (display (length cnt-list))(newline)
	(newline)
)

(define (swap-alts altid wantid pair-list)
"
  swap-alts -- fix up the uuids -- replace altid by wantid in
  the ListLink that contains the altid.  This modifies the
  ListLink; it usually should not create any duplicates, as
  long as the pair-list was previously de-duped. However, for
  multiple lists, this may be violated :-(

  altid is the uuid of the unwanted WordNode
  wantid is the uuid of the correct WordNode
  pair-list is the list of uuid-pairs, one of which is altid.
"
	; Replace wuid by auid in the pair
	(define (replace wuid auid pair)
		(if (eq? wuid (car pair))
			(list auid (cadr pair))
			(list (car pair) auid)
		)
	)
  The laid - list is the list of ListLinks that contain the
	; wrong word UUID.
	(define laid-list (map find-list-link pair-list))

	; Create list of pairs with the fixed pair in it
	(define fix-list (map (lambda (x) (replace altid wantid x)) pair-list))

  fixup  laid by inserting fix into it
	(define (fixup laid fix)
		(define upd (string-append
			"UPDATE atoms SET outgoing="
			(make-outgoing-str fix)
			" WHERE uuid="
			(number->string laid)
			";"))
		;(display upd) (newline)
		(dbi-query conxion upd)
( display ( dbi - get_status conxion ) ) ( newline )
		(flush-query)
	)

	(for-each fixup laid-list fix-list)

	(display "Num of relabeled ListLinks: ")
	(display (length laid-list)) (newline)
	(newline)
	(flush-output-port (current-output-port))
)

( define pair - list ( find - pairs 6844 ) )
;(display "Found word pairs: ") (display (length pair-list))(newline)
( sum - up - eval - counts 6844 27942 pair - list )

( define alt - list ( find - pairs 27942 ) )
;(display "Found alt pairs: ") (display (length alt-list))(newline)
( swap - alts 27942 6844 alt - list )

( define pair - list ( find - pairs 42673 ) )
;(display "Found word pairs: ") (display (length pair-list))(newline)
( sum - up - eval - counts 42673 367746 pair - list )

( define alt - list ( find - pairs 367746 ) )
;(display "Found alt pairs: ") (display (length alt-list))(newline)
( swap - alts 367746 42673 alt - list )

( define pair - list ( find - pairs 28019 ) )
;(display "Found word pairs: ") (display (length pair-list))(newline)
( sum - up - eval - counts 28019 270920 pair - list )

( define alt - list ( find - pairs 270920 ) )
;(display "Found alt pairs: ") (display (length alt-list))(newline)
( swap - alts 270920 28019 alt - list )
; --------------------------------------------------------------

(define (escape-quote word)
"
  If word has a single-quote in it, then escape it!
"
	(define qk (string-index word #\'))
	(if qk
		(string-replace word "''" qk (+ qk 1))
		word
	)
)

(define (get-word-uuids word)
"
  Given a word (string), get the UUID's of all WordNodes holding
  that word. Return these as a list.
"
	(define row #f)
	(define wuid-list (list))
	(define qry (string-append
		"SELECT uuid FROM atoms WHERE type=" WordNodeType
			" AND name='" (escape-quote word) "';"))
	(display qry)(newline)
	(dbi-query conxion qry)

	(set! row (dbi-get_row conxion))
	(while (not (equal? row #f))
		(set! wuid-list (cons (cdr (assoc "uuid" row)) wuid-list))
		(set! row (dbi-get_row conxion))
	)
	(display "Word ")(display word)
	(display " has uuids ")(display wuid-list) (newline)
	wuid-list
)

(define (sum-word-counts word)
"
  Given a word (string), sum up the stv-count of all WordNodes holding
  that word. Return the sum
"
	(define row #f)
	(define sum 0)
	(define qry (string-append
		"SELECT uuid,stv_count FROM atoms WHERE type=" WordNodeType
			" AND name='" (escape-quote word) "';"))
	(display qry)(newline)
	(dbi-query conxion qry)

	(set! row (dbi-get_row conxion))
	(while (not (equal? row #f))
		(set! sum (+ (cdr (assoc "stv_count" row)) sum))
		(set! row (dbi-get_row conxion))
	)
	(display "Word ")(display word)
	(display " has sum ")(display sum) (newline)
	sum
)

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

(define duplicate-word-list
	(look-for-dupes (string-append
		"SELECT uuid, name FROM atoms WHERE type="
		WordNodeType) "name"))

(display "The duplicate word list is: ")
(display duplicate-word-list) (newline)
(flush-output-port (current-output-port))

;(define dup-wuid-lists
;	(map get-word-uuids duplicate-word-list))

(define (dedupe-word word)
"
  Deduplicate the word. This sums up counts on the EvaluationLinks
  that contain the duplicted words. It also relabels the ListLinks
  that use the wrong word uid.  Basically it does everything except
  to sum up the WordNodes themselves.
"
  First , get a list of the uuid 's associated with the word .
	(define wuid-list (get-word-uuids word))

  Next , find the smallest uuid in that list
	(define (get-smallest-uuid uuid-list)
		(define sma 6123456123123)
		(for-each (lambda (x) (if (< x sma) (set! sma x))) uuid-list)
		(display "smallest wuid is ")(display sma)(newline)
		sma
	)
	(define smallest-wuid (get-smallest-uuid wuid-list))

  Next , remove the smallest uuid from the list   ...
	(define bad-wuid-list
		(remove (lambda (x) (eq? x smallest-wuid)) wuid-list))

	; Get a list of all word-pairs that have the smallest-wuid in it.
	; This is a list of uuid-pairs; these uuid-pairs occur in some
	; ListLink somewhere.
	(define wuid-word-pairs (find-pairs smallest-wuid))

  Fixup ListLinks holding the bad WordNode .
	; This sums and removes duplicates, and relabels the rest.
	; This is the final, mster routine.
	(define (fixup-bad bad)
		(define alt-list (list))
  First , remove duplicates
		(sum-up-eval-counts smallest-wuid bad wuid-word-pairs)
  Next , relabel the rest
		(set! alt-list (find-pairs bad))
		(display "Need to relabel bad pairs: ")
		(display (length alt-list))(newline)
		(swap-alts bad smallest-wuid alt-list)
		(flush-output-port (current-output-port))
	)

	(display "Number of word-pairs: ")
	(display (length wuid-word-pairs))(newline) (newline)
	(flush-output-port (current-output-port))

  Finally , walk over the bad - wuid - list , and dupe each of these ,
	; one at a time, to the smallest wuid.
	(display "The bad wuids: ")(display bad-wuid-list)(newline)
	(for-each fixup-bad bad-wuid-list)
)

( for - each dedupe - word duplicate - word - list )

; --------------------------------------------------------------
; Finally, sum up the word-counts.

(define (dedupe-sum-word-counts word)
"
  sum-word-counts -- Given the (string) word, find all WordNodes that
  hold this word, sum up the counts on all of them, assign the count to
  the one with the smallest uuid, and delete the rest.
"
  First , get a list of the uuid 's associated with the word .
	(define wuid-list (get-word-uuids word))

  Next , find the smallest uuid in that list
	(define (get-smallest-uuid uuid-list)
		(define sma 6123456123123)
		(for-each (lambda (x) (if (< x sma) (set! sma x))) uuid-list)
		(display "smallest wuid is ")(display sma)(newline)
		sma
	)
	(define smallest-wuid (get-smallest-uuid wuid-list))

  Next , remove the smallest uuid from the list   ...
	(define bad-wuid-list
		(remove (lambda (x) (eq? x smallest-wuid)) wuid-list))

  Next , sum up the counts
	(define sum-of-counts (sum-word-counts word))

  Next , update the master count
	(define upd (string-append
		"UPDATE atoms SET stv_count="
		(number->string sum-of-counts)
		" WHERE uuid="
		(number->string smallest-wuid)
		";"))

	(display upd)(newline)
	(dbi-query conxion upd)
	(display (dbi-get_status conxion)) (newline)
	(flush-query)

	; Now, delete the bad words.
	(delete-atoms bad-wuid-list 0 #t)
)

(for-each dedupe-sum-word-counts duplicate-word-list)



 Due to bugs, the SQL backend can end up with multiple copies of
 atoms. This script will find them, merge them, and sum the counts
 on the associated count truth values.  Its up to you to recompute
 anything else.

 This script focuses on single-words and the pairs they appear in.
 ------------------------------------------------
 (display "contains ")(display outset)(newline)
 Return the list of pairs
 Replace wuid by auid in the pair
 Create list of pairs with the alternate pair in it
 Sum the counts
 the laid and the evlink holding laid are deleted.
 aud ... etc.. holdings laid
(display "summo cnt ") (display lcnt)
(display " + ") (display acnt)
(display " for ") (display luid)
(display "(") (display eud)
(display ") and ") (display laid)
(display "(") (display aud) (display ")")
(newline)
(display upd) (newline)
(display alt) (newline)
(begin
	(display "(for ")(display luid)
	(display ") and ") (display aud)
	(display "(for ")(display laid)
	(display ")")(newline)
)
(display "Missing list-alt id for ") (display luid)
(newline)
 Discard alternates
 XXX technically, this is wrong, we should be renaming these...
			(let* ((aud (get-eval-uuid laid)))
				(if (< 0 aud)
								"DELETE FROM atoms WHERE uuid="
								(number->string aud)
								";")))
						(dbi-query conxion apd)
						(flush-query)
					)
				)
			)
 (define cnt-list (filter-map bug-cleanup laid-list))
 (display alt-list) (newline)
 it usually should not create any duplicates, as
 Replace wuid by auid in the pair
 wrong word UUID.
 Create list of pairs with the fixed pair in it
(display upd) (newline)
(display "Found word pairs: ") (display (length pair-list))(newline)
(display "Found alt pairs: ") (display (length alt-list))(newline)
(display "Found word pairs: ") (display (length pair-list))(newline)
(display "Found alt pairs: ") (display (length alt-list))(newline)
(display "Found word pairs: ") (display (length pair-list))(newline)
(display "Found alt pairs: ") (display (length alt-list))(newline)
 --------------------------------------------------------------
 --------------------------------------------------------------
(define dup-wuid-lists
	(map get-word-uuids duplicate-word-list))
 Get a list of all word-pairs that have the smallest-wuid in it.
 This is a list of uuid-pairs; these uuid-pairs occur in some
 ListLink somewhere.
 This sums and removes duplicates, and relabels the rest.
 This is the final, mster routine.
 one at a time, to the smallest wuid.
 --------------------------------------------------------------
 Finally, sum up the word-counts.
 Now, delete the bad words.
#! /usr/bin/env guile
!#
  Atomspace deduplication repair script

(load "common.scm")

(define (find-pairs wuid)
"
  find-pairs -- given a uuid of single word, find all word-pairs
  which contain the word.  The wuid must be the uuid of a WordNode.

  Returns a list of ListLink pairs that contain the WordNode.
"
	(define row #f)
	(define pair-list (list))

  type=8 is the 
	(define qry "SELECT * FROM atoms WHERE type=8")
	(dbi-query conxion qry)

	(set! row (dbi-get_row conxion))
	(while (not (equal? row #f))

  Extract the outgoing set of the 
		(let ((outset (cdr (assoc "outgoing" row))))
			(if (any (lambda (x) (eq? x wuid)) outset)
				(begin
					(set! pair-list (cons outset pair-list))
				)
			)
			(set! row (dbi-get_row conxion))
		)
	)
	pair-list
)

(define (find-list-link pair)
"
  Given a pair of UUID's, get the uuid of the ListLink that holds it.
  Return that UUID, else return zero
"
	(define luid 0)
	(define row #f)
	(define qry (string-append
		"SELECT * FROM atoms WHERE type=8 AND outgoing="
		(make-outgoing-str pair)))
  ( display qry)(newline )
	(dbi-query conxion qry)

	(set! row (dbi-get_row conxion))
	(while (not (equal? row #f))
		(set! luid (cdr (assoc "uuid" row)))
		(set! row (dbi-get_row conxion))
	)
  ( display "  : " ) ( display luid)(newline )
	luid
)

(define (sum-up-eval-counts wuid auid pair-list)
"
  sum-up-eval-counts -- look for identical word-pairs
  wuid -- uuid of a word node
  auid -- uuid of another word node (holding same word)
  pair-list -- list of uuid-pairs, one of which is wuid.

  Given a list of pairs containing wuid, find the ListLinks
  correspodning tio them.  Also: find the ListLinks that hold
  the corresponding auid.  Then find the EvaluationLinks that
  correspond to these, sum up the count TV's on them and then
  delete the ListLink and EvalLink that correspond to auid.
"
	(define (replace wuid auid pair)
		(if (eq? wuid (car pair))
			(list auid (cadr pair))
			(list (car pair) auid)
		)
	)
	(define alt-list (map (lambda (x) (replace wuid auid x)) pair-list))

  Create parallel lists of UUID 's of the ListLinks of the pairs
	(define luid-list (map find-list-link pair-list))
	(define laid-list (map find-list-link alt-list))

  Get the column value on the EvalLink that holds the  UUID
	(define (get-col colm uuid)
		(define row #f)
		(define val 0)
		(define qry (string-append
			"SELECT * FROM atoms WHERE type="
			EvalLinkType
			" AND outgoing="
			(make-outgoing-str (list uuid-of-any uuid))))
  ( display qry)(newline )
		(dbi-query conxion qry)

		(set! row (dbi-get_row conxion))
		(while (not (equal? row #f))
			(set! val (cdr (assoc colm row)))
			(set! row (dbi-get_row conxion))
		)
		val
	)

  Get the stv - count on the EvalLink that holds the  UUID
	(define (get-count uuid) (get-col "stv_count" uuid))

  Get the uuid of the EvalLink that holds the  UUID
	(define (get-eval-uuid uuid) (get-col "uuid" uuid))

  Given :  the uuid of a  containing a word pair ,
         laid the uuid of a  containing alternative word - pair
  Then : the EvaluationLinks holding  , laid are found ,
  the stv_counts on them are sumed ,
  the count on the evlink holding luid is updated
	(define (sum-counts luid laid)
		(if (and (< 0 luid) (< 0 laid))
  eud contains uuid of EvaluationLink holding luid
			(let* ((eud (get-eval-uuid luid))
					(aud (get-eval-uuid laid))
				)
				(if (and (< 0 eud) (< 0 aud))
					(let* ((lcnt (get-count luid))
							(acnt (get-count laid))
							(scnt (+ lcnt acnt))
							(upd (string-append
								"UPDATE atoms SET stv_count="
								(number->string scnt)
								" WHERE uuid="
								(number->string eud)
								";"))
							(apd (string-append
								"DELETE FROM atoms WHERE uuid="
								(number->string aud)
								";"))
							(alt (string-append
								"DELETE FROM atoms WHERE uuid="
								(number->string laid)
								";"))
						)
( display " = " ) ( display scnt )
						(dbi-query conxion upd)
( display ( dbi - get_status conxion ) ) ( newline )
						(flush-query)
( display apd ) ( newline )
						(dbi-query conxion apd)
( display ( dbi - get_status conxion ) ) ( newline )
						(flush-query)
						(dbi-query conxion alt)
( display ( dbi - get_status conxion ) ) ( newline )
						(flush-query)
						scnt
					)
	 ( display " Missing eval i d " ) ( display eud )
						#f
				)
			)
			(begin
				#f
			)
		)
	)

	(define (bug-cleanup laid)
		(if (< 0 laid)
					 ( let * ( ( apd ( string - append
						 ( display  ) ( newline )
						 ( display ( dbi - get_status conxion ) ) ( newline )
			(let ((alt (string-append
						"DELETE FROM atoms WHERE uuid="
						(number->string laid)
						";")))
				(display alt) (newline)
				(dbi-query conxion alt)
				(display (dbi-get_status conxion)) (newline)
				(flush-query)
				#t
			)
			#f
		)
	)

	(define cnt-list (filter-map sum-counts luid-list laid-list))

	(display "num of word-pairs: ") (display (length pair-list))(newline)
	(display "num of alt-pairs: ") (display (length alt-list))(newline)
	(display "num luids (ListLinks): ") (display (length luid-list))(newline)
	(display "num of laids (listLinks holding alts): ") (display (length
		(filter (lambda (x) (< 0 x)) laid-list)))(newline)
	(display "num actually fixed up: ") (display (length cnt-list))(newline)
	(newline)
)

(define (swap-alts altid wantid pair-list)
"
  swap-alts -- fix up the uuids -- replace altid by wantid in
  the ListLink that contains the altid.  This modifies the
  long as the pair-list was previously de-duped. However, for
  multiple lists, this may be violated :-(

  altid is the uuid of the unwanted WordNode
  wantid is the uuid of the correct WordNode
  pair-list is the list of uuid-pairs, one of which is altid.
"
	(define (replace wuid auid pair)
		(if (eq? wuid (car pair))
			(list auid (cadr pair))
			(list (car pair) auid)
		)
	)
  The laid - list is the list of ListLinks that contain the
	(define laid-list (map find-list-link pair-list))

	(define fix-list (map (lambda (x) (replace altid wantid x)) pair-list))

  fixup  laid by inserting fix into it
	(define (fixup laid fix)
		(define upd (string-append
			"UPDATE atoms SET outgoing="
			(make-outgoing-str fix)
			" WHERE uuid="
			(number->string laid)
			";"))
		(dbi-query conxion upd)
( display ( dbi - get_status conxion ) ) ( newline )
		(flush-query)
	)

	(for-each fixup laid-list fix-list)

	(display "Num of relabeled ListLinks: ")
	(display (length laid-list)) (newline)
	(newline)
	(flush-output-port (current-output-port))
)

( define pair - list ( find - pairs 6844 ) )
( sum - up - eval - counts 6844 27942 pair - list )

( define alt - list ( find - pairs 27942 ) )
( swap - alts 27942 6844 alt - list )

( define pair - list ( find - pairs 42673 ) )
( sum - up - eval - counts 42673 367746 pair - list )

( define alt - list ( find - pairs 367746 ) )
( swap - alts 367746 42673 alt - list )

( define pair - list ( find - pairs 28019 ) )
( sum - up - eval - counts 28019 270920 pair - list )

( define alt - list ( find - pairs 270920 ) )
( swap - alts 270920 28019 alt - list )

(define (escape-quote word)
"
  If word has a single-quote in it, then escape it!
"
	(define qk (string-index word #\'))
	(if qk
		(string-replace word "''" qk (+ qk 1))
		word
	)
)

(define (get-word-uuids word)
"
  Given a word (string), get the UUID's of all WordNodes holding
  that word. Return these as a list.
"
	(define row #f)
	(define wuid-list (list))
	(define qry (string-append
		"SELECT uuid FROM atoms WHERE type=" WordNodeType
			" AND name='" (escape-quote word) "';"))
	(display qry)(newline)
	(dbi-query conxion qry)

	(set! row (dbi-get_row conxion))
	(while (not (equal? row #f))
		(set! wuid-list (cons (cdr (assoc "uuid" row)) wuid-list))
		(set! row (dbi-get_row conxion))
	)
	(display "Word ")(display word)
	(display " has uuids ")(display wuid-list) (newline)
	wuid-list
)

(define (sum-word-counts word)
"
  Given a word (string), sum up the stv-count of all WordNodes holding
  that word. Return the sum
"
	(define row #f)
	(define sum 0)
	(define qry (string-append
		"SELECT uuid,stv_count FROM atoms WHERE type=" WordNodeType
			" AND name='" (escape-quote word) "';"))
	(display qry)(newline)
	(dbi-query conxion qry)

	(set! row (dbi-get_row conxion))
	(while (not (equal? row #f))
		(set! sum (+ (cdr (assoc "stv_count" row)) sum))
		(set! row (dbi-get_row conxion))
	)
	(display "Word ")(display word)
	(display " has sum ")(display sum) (newline)
	sum
)


(define duplicate-word-list
	(look-for-dupes (string-append
		"SELECT uuid, name FROM atoms WHERE type="
		WordNodeType) "name"))

(display "The duplicate word list is: ")
(display duplicate-word-list) (newline)
(flush-output-port (current-output-port))


(define (dedupe-word word)
"
  Deduplicate the word. This sums up counts on the EvaluationLinks
  that contain the duplicted words. It also relabels the ListLinks
  that use the wrong word uid.  Basically it does everything except
  to sum up the WordNodes themselves.
"
  First , get a list of the uuid 's associated with the word .
	(define wuid-list (get-word-uuids word))

  Next , find the smallest uuid in that list
	(define (get-smallest-uuid uuid-list)
		(define sma 6123456123123)
		(for-each (lambda (x) (if (< x sma) (set! sma x))) uuid-list)
		(display "smallest wuid is ")(display sma)(newline)
		sma
	)
	(define smallest-wuid (get-smallest-uuid wuid-list))

  Next , remove the smallest uuid from the list   ...
	(define bad-wuid-list
		(remove (lambda (x) (eq? x smallest-wuid)) wuid-list))

	(define wuid-word-pairs (find-pairs smallest-wuid))

  Fixup ListLinks holding the bad WordNode .
	(define (fixup-bad bad)
		(define alt-list (list))
  First , remove duplicates
		(sum-up-eval-counts smallest-wuid bad wuid-word-pairs)
  Next , relabel the rest
		(set! alt-list (find-pairs bad))
		(display "Need to relabel bad pairs: ")
		(display (length alt-list))(newline)
		(swap-alts bad smallest-wuid alt-list)
		(flush-output-port (current-output-port))
	)

	(display "Number of word-pairs: ")
	(display (length wuid-word-pairs))(newline) (newline)
	(flush-output-port (current-output-port))

  Finally , walk over the bad - wuid - list , and dupe each of these ,
	(display "The bad wuids: ")(display bad-wuid-list)(newline)
	(for-each fixup-bad bad-wuid-list)
)

( for - each dedupe - word duplicate - word - list )


(define (dedupe-sum-word-counts word)
"
  sum-word-counts -- Given the (string) word, find all WordNodes that
  hold this word, sum up the counts on all of them, assign the count to
  the one with the smallest uuid, and delete the rest.
"
  First , get a list of the uuid 's associated with the word .
	(define wuid-list (get-word-uuids word))

  Next , find the smallest uuid in that list
	(define (get-smallest-uuid uuid-list)
		(define sma 6123456123123)
		(for-each (lambda (x) (if (< x sma) (set! sma x))) uuid-list)
		(display "smallest wuid is ")(display sma)(newline)
		sma
	)
	(define smallest-wuid (get-smallest-uuid wuid-list))

  Next , remove the smallest uuid from the list   ...
	(define bad-wuid-list
		(remove (lambda (x) (eq? x smallest-wuid)) wuid-list))

  Next , sum up the counts
	(define sum-of-counts (sum-word-counts word))

  Next , update the master count
	(define upd (string-append
		"UPDATE atoms SET stv_count="
		(number->string sum-of-counts)
		" WHERE uuid="
		(number->string smallest-wuid)
		";"))

	(display upd)(newline)
	(dbi-query conxion upd)
	(display (dbi-get_status conxion)) (newline)
	(flush-query)

	(delete-atoms bad-wuid-list 0 #t)
)

(for-each dedupe-sum-word-counts duplicate-word-list)
