rendered paste body(defvar numero_estados 0)
(defvar numero_ligacoes 0)
(defvar array_ligacoes 0)
(defvar debugging nil)
(defvar array_de_cores 0)
(defvar maior 0)
;; FOR - DO CODIGO DO AIMA DA UNIV BERKELEY.
(defmacro for (var = start to end do &body body)
"Execute body with var bound to succesive integers."
(declare (ignore do to =)) ; Evitar warnings de variavel inutilizada, ja que o nosso professor nos chumba se tivermos um warning que seja.
(let ((end-var (gensym "END")))
`(do ((,var ,start (+ 1 ,var)) (,end-var ,end))
((> ,var ,end-var) nil)
,@body)))
;; FIM CODIGO DO AIMA - FOR / FOR-EACH
(defun existe-na-lista (lista bixo)
(setq auxiliar_existe_na_lista nil)
(for i = 0 to (- (list-length lista) 1) do
(progn
(if (equalp (nth i lista) bixo)
(setq auxiliar_existe_na_lista t))))
auxiliar_existe_na_lista)
(defun despeja-ficheiro (ficheiro)
(with-open-file (stream ficheiro)
(do ((line (read-line stream nil)
(read-line stream nil)))
((null line))
(trata-linha line))))
(defun escreve-no-ficheiro (ficheiro linha)
(with-open-file (stream ficheiro :direction :output
:if-exists :append :if-does-not-exist :create)
(write-line linha stream)))
(defun esvazia-ficheiro (ficheiro)
(with-open-file (stream ficheiro :direction :output
:if-exists :supersede :if-does-not-exist :create)
(write-line "c inicio do ficheiro de CNF" stream)))
(defun trata-linha (line)
(let ((fc (char line 0)))
(cond ((equalp fc #\c) ())
((equalp fc #\p) (trata-p line))
((equalp fc #\e) (trata-e line)))))
(defun trata-p (line)
(if (equalp (subseq line 0 6) "p edge")
(progn
(for i = 8 to (length line) do
(progn
(if (equalp (char line i) #\Space)
(progn
(setq numero_estados (parse-integer (subseq line 7 i)))
(setq oldi i)
(setq i (length line))))))
(setq numero_ligacoes (parse-integer (subseq line (+ 1 oldi) (length line))))
(setf array_ligacoes (make-array numero_estados))
(for i = 0 to (- numero_estados 1) do
(setf (aref array_ligacoes i) '())))))
(defun trata-e (line)
(for i = 3 to (length line) do
(progn
(if (equalp (char line i) #\Space)
(progn
(setq arg1 (parse-integer (subseq line 2 i)))
(setq arg2 (parse-integer (subseq line (+ 1 i) (length line))))
(setq i (length line))
))))
(trata-e-2 arg1 arg2))
(defun trata-e-2 (arg1 arg2)
(setf (aref array_ligacoes (- arg1 1)) (append (aref array_ligacoes (- arg1 1)) (list arg2)))
(setf (aref array_ligacoes (- arg2 1)) (append (aref array_ligacoes (- arg2 1)) (list arg1))))
(defun cria-lista-ordenada ()
(setf lista_ordenada ())
(setf array_de_cenas (make-array numero_estados))
(for j = 0 to (- numero_estados 1) do
(progn
(for i = 0 to (- numero_estados 1) do
(if (not (aref array_de_cenas i))
(progn
(setf maior i)
(setq i (- numero_estados 1)))))
(for i = 0 to (- numero_estados 1) do
(progn
(if debugging
(progn
(princ "A ler a posicao: ")
(princ i)
(princ ", com valor no array de ligacoes de ")
(princ (aref array_ligacoes i))
(princ " e com valor no array de cenas de ")
(princ (aref array_de_cenas i))
(terpri)))
(if (and (>= (list-length (aref array_ligacoes i)) (list-length (aref array_ligacoes maior))) (not (aref array_de_cenas i)))
(progn
(setf maior i)))))
(setf lista_ordenada (append lista_ordenada (list (+ 1 maior))))
(setf (aref array_de_cenas maior) t)))
lista_ordenada)
(defun muda-lista-ordenada ()
(setf lista_ordenada (append (rest lista_ordenada) (list (first lista_ordenada)))))
(defun atribui-cores-a-cenas (numero_de_cores)
(setf houve_erro nil)
(setf limite_cores numero_de_cores)
(setf array_de_cores (make-array limite_cores))
(setf copia_lista_ordenada (concatenate 'array lista_ordenada))
(for i = 0 to (- numero_estados 1) do
(progn
(setf elemento (nth i lista_ordenada))
(setf worked nil)
(for cori = 0 to (- limite_cores 1) do
(if (pode-ser elemento cori)
(progn
(setf worked t)
(setf (aref copia_lista_ordenada i) cori)
(setf (aref array_de_cores cori) (append (aref array_de_cores cori) (list elemento)))
(setq cori (- limite_cores 1)))))
(if (not worked)
(mensagem-de-erro))))
(if houve_erro
nil
t))
(defun pode-ser (elemento cor)
(setq podemos t)
(setq elemento (- elemento 1))
(for j = 0 to (- (list-length (aref array_ligacoes elemento)) 1) do
(progn
(if debugging
(progn
(princ "A verificar se existe na lista: ")
(princ (aref array_de_cores cor))
(princ " o valor: ")
(princ (nth j (aref array_ligacoes elemento)))
(terpri)))
(if (existe-na-lista (aref array_de_cores cor)
(nth j (aref array_ligacoes elemento)))
(setq podemos nil))))
podemos)
(defun mensagem-de-erro ()
(setf houve_erro t)
(setq i (- numero_estados 1)))
(defun pringrafo (bixo)
(escreve-no-ficheiro "grafo.cnf" bixo))
(defun print_cnf ()
(setf numcores 0)
(for i = 0 to (- limite_cores 1) do
(if (not (equalp (aref array_de_cores i) nil))
(setf numcores i)))
(esvazia-ficheiro "grafo.cnf")
(pringrafo (concatenate 'string "p cnf " (write-to-string numero_estados) " " (write-to-string (+ 1 numcores))))
(for i = 0 to numcores do
(progn
(setf string_a_imprimir "")
(for j = 0 to (- numero_estados 1) do
(progn
(if (not (existe-na-lista (aref array_de_cores i) (+ 1 j)))
(setf string_a_imprimir (concatenate 'string string_a_imprimir "-")))
(setf string_a_imprimir (concatenate 'string string_a_imprimir (write-to-string (+ 1 j)) " "))))
(setf string_a_imprimir (concatenate 'string string_a_imprimir "0"))
(pringrafo string_a_imprimir))))
(defun faz-tudo (ficheiro numcor)
(setf feito nil)
(despeja-ficheiro ficheiro)
(cria-lista-ordenada)
; (for i = 0 to 4 do
(if (atribui-cores-a-cenas numcor)
; (progn
; (setf i 4)
; (setf feito t))
; (muda-lista-ordenada)))
; (if feito
(print_cnf)
(faz-batota ficheiro)))
;; BATOTA
(defun despeja-ficheiro-batota (ficheiro)
(with-open-file (stream ficheiro)
(do ((line (read-line stream nil)
(read-line stream nil)))
((null line))
(trata-linha-batota line))))
(defun faz-batota (ficheiro)
(despeja-ficheiro-batota ficheiro))
(defun trata-linha-batota (line)
(let ((fc (char line 0)))
(cond ((equalp fc #\c) ())
((equalp fc #\p) (trata-p_b line))
((equalp fc #\e) (trata-e_b line)))))
(defun trata-p_b (line)
(if (equalp (subseq line 0 6) "p edge")
(progn
(for i = 8 to (length line) do
(progn
(if (equalp (char line i) #\Space)
(progn
(setq numero_estados (parse-integer (subseq line 7 i)))
(setq oldi i)
(setq i (length line))))))
(setq numero_ligacoes (parse-integer (subseq line (+ 1 oldi) (length line))))
(esvazia-ficheiro "grafo.cnf")
(pringrafo (concatenate 'string "p cnf " (write-to-string numero_ligacoes) " " (write-to-string numero_estados)))
)))
(defun trata-e_b (line)
(for i = 3 to (length line) do
(progn
(if (equalp (char line i) #\Space)
(progn
(setq arg1 (parse-integer (subseq line 2 i)))
(setq arg2 (parse-integer (subseq line (+ 1 i) (length line))))
(setq i (length line))
))))
(trata-e-2_b arg1 arg2))
(defun trata-e-2_b (arg1 arg2)
(pringrafo (concatenate 'string (write-to-string arg1) " -" (write-to-string arg2) " 0")))