(define (vizinhos n g) (vector-ref g n))

;----------------------------------------
; busca em profundidade (criando arvore geradora)

(define (prof g n a p)
  (if (not (vector-ref a n))
    (begin (vector-set! a n p)
           (for-each (lambda (x) (prof g x a n))
                     (vizinhos n g)))))

(define (mprof g n)
  (let ((a (make-vector (vector-length g) #f)))
    (prof g n a -1)
    a))

;----------------------------------------
; busca em largura (criando arvore geradora)

(define (largura g l a)
  (if (not (null? l))
    (let* ((n (car l))
          (v (marca-vizinhos (vizinhos n g) a n)))
      (largura g (append (cdr l) v) a))))

(define (marca-vizinhos v a p)
  (cond ((null? v) '())
        ((vector-ref a (car v)) (marca-vizinhos (cdr v) a p))
        (else (vector-set! a (car v) p)
              (cons (car v) (marca-vizinhos (cdr v) a p)))))

(define (mlarg g n)
  (let ((a (make-vector (vector-length g) #f)))
    (vector-set! a n -1)
    (largura g (list n) a)
    a))

;----------------------------------------
; coloracao de grafos

(define (menor-livre l i)
  (if (not (member i l))
      i
      (menor-livre l (+ i 1))))

(define (colore-prof g n a)
  (if (not (vector-ref a n))
    (let ((cores-vizinhos (map (lambda (x) (vector-ref a x)) (vizinhos n g))))
      (vector-set! a n (menor-livre cores-vizinhos 0))
      (for-each (lambda (x) (colore-prof g x a)) (vizinhos n g)))))

(define (colore2 g)
  (let ((a (make-vector (vector-length g) #f)))
    (colore-prof g 0 a)
    a))

;----------------------------------------
; ciclos em grafos

(define (soma l a inc)
  (if (not (null? l))
      (begin (vector-set! a (car l) (+ inc (vector-ref a (car l))))
             (soma (cdr l) a inc))))

(define (acha-zero cont i)
  (cond ((= i (vector-length cont)) #f)
        ((zero? (vector-ref cont i)) i)
        (else (acha-zero cont (+ i 1)))))
    
(define (tira-um g cont)
  (let ((z (acha-zero cont 0)))
  (if z
      (begin (vector-set! cont z -1)
             (soma (vizinhos z g) cont -1)
             (tira-um g cont)))))

(define (cria-cont g)
  (let ((cont (make-vector (vector-length g) 0)))
    (do ((i 0 (+ i 1)))
        ((= i (vector-length g)) cont)
      (soma (vizinhos i g) cont 1))))

(define (ciclos g)
  (let ((cont (cria-cont g)))
    (tira-um g cont)
    cont))
    
;----------------------------------------
; arvore geradora de custo minimo

(define origem car)
(define destino cadr)
(define custo caddr)
(define (arcos n g) (vector-ref g n))

(define (pertence? no conjunto) (vector-ref conjunto no))
(define (insere no conjunto) (vector-set! conjunto no #t))

(define (arco-barato l)
  (if (null? (cdr l))
      (car l)
      (let ((m (arco-barato (cdr l))))
        (if (< (custo (car l)) (custo m))
            (car l)
            m))))

(define (filtra l a)
  (cond ((null? l) '())
        ((pertence? (destino (car l)) a) (filtra (cdr l) a))
        (else (cons (car l) (filtra (cdr l) a)))))

(define (loop g l dentro)
  (if (null? l)
      '()
      (let* ((m (arco-barato l))
             (n (destino m)))
        (insere n dentro)
        (let ((novo-l (filtra (append (arcos n g) l) dentro)))
          (cons m (loop g novo-l dentro))))))

(define (cria-arvore g)
  (let ((dentro (make-vector (vector-length g) #f)))
    (insere 0 dentro)
    (loop g (arcos 0 g) dentro)))