validador.rkt

#lang racket

(provide (all-defined-out))

(require redex
         rackunit
         rackcheck
         "classico.rkt"
         "gerador.rkt"
         "struct.rkt"
         "structCYK.rkt"
         "cfggen/main.rkt"
         "cfggen/cyk.rkt"
         )

; Quantidade de testes
(define num-tests 1000)
; Quatidade de palavras 
(define num-words 20)
; Tamanho máximo de cada palavra 
(define max-wrd-size 5)

; Gera os terminais
(define gen:trms
  (gen:let ([num-trms (gen:integer-in min-trms max-trms)])
  (generate-trms num-trms)))

; Gera os não-terminais
(define gen:nts
  (gen:let ([num-nts (gen:integer-in min-nts max-nts)])
  (generate-nts num-nts)))

; Gera a gramática
(define gen:grammar
  (gen:let ([trms gen:trms]
            [nts gen:nts])
  (generate-grammar trms nts)))

; Unifica as produções geradas por um mesmo não-trm
(define gen:grammar-unified
  (gen:let ([grammar gen:grammar])
  (unify-prds grammar)))

; Ordena o rhs das produções
(define gen:grammar-ordered
  (gen:let ([grammar gen:grammar-unified])
  (ord-rhs grammar)))


;---- Funções auxiliares ----
; Verifica se na gramática existe alguma produção recursiva à esquerda
(define (has-left-recursion? grammar)
  (define prds (car (cdr grammar)))
  (define orders (car grammar))
   
  (ormap
    (lambda (prd)
      (define head (car prd))
      (define rhs (car(cdr prd)))
      (or  (is-left-recursive-d head rhs) (is-left-recursive-i head rhs orders)))
    prds))

; Verifica se uma produção é recursiva à esquerda  de forma direta
(define (is-left-recursive-d term rhs)
  (ormap
    (lambda (seq)
      (if (eq? seq '()) #f
        (if (equal? (car seq) term) #t #f)))
    rhs))

; Verifica se uma produção possui possibilidade de recursão à esquerda indireta
(define (is-left-recursive-i  head rhs orders)
  (define pre-order (before-list orders head ))
  (if (eq? pre-order '()) #f
    (ormap
      (lambda (seq)
          (if (eq? seq '()) #f
            (ormap
              (lambda (term)                
                (define head-ord (car term))
                (if (equal? head-ord (car seq)) #t #f))
              pre-order)
          ))
      rhs)))

; Verifica se um elemento está contido em uma lista, se sim, retorna os elementos anteriores a ele 
(define (before-list list element)
  (if (member element list)
    (before-list-aux list element)
    '()))

; Verifica se um elemento está contido em uma lista
(define (member element list)
  (ormap
    (lambda (el)
      (if (equal? (car el) element) #t #f))
    list))

; Retorna os elementos de uma lista anteriores a um elemento
(define (before-list-aux list element)
  (cond
    [(null? list) '()]
    [(equal? (car (car list)) element) '()] 
    [else (cons (car list) (before-list-aux (cdr list) element))]))

; Verifica se a gramática se termos aceitos por gf são aceitos por gs
(define (accepts? gf gs ws)
    (define g-first  (format-input (car (cdr gf))))
    (define g-second (format-input (car (cdr gs))))

    (andmap
      (lambda (term)
        ;(displayln (car (cdr gs)))
        ;(displayln term)
        ;(displayln (accept-on-cyk g-second term 'S))
        ;#t
        (if (not (equal? term ∅))
            (if (and (accept-on-cyk g-first term 'S)
                     (accept-on-cyk g-second term 'S))
                #t
                (begin (display "Wrd = ") (display term) (display "G = ") (displayln gf ) #f))
          #t)) 
      ws))

; Verifica se a gramática se termos Não aceitos por gf não são aceitos por gs
(define (not-accepts? gf gs ws)

    (define g-first  (format-input (car (cdr gf))))
    (define g-second (format-input (car (cdr gs))))

    (andmap
      (lambda (term)
        (if (not (equal? term ∅))
            (if (and (not (accept-on-cyk g-first term 'S))
                     (not (in-grammar? g-second term #:starting-NT 'S) ))
                #t
                (begin (display "Wrd = ") (display term) (display "G = ") (displayln gf ) #f))
          #t)) 
      ws))

(define (Σg g) g ;gramática --> Conjunto de terminais
   (remove-duplicates (filter (lambda (y) (number? y))
                              (car (map (lambda (x) (flatten (cdr x))) (cdr g))))))

(define (gen:random-words Σ maxlen)
   (gen:list (gen:one-of Σ) #:max-length  maxlen))

(define (words-not-in g ws)
   (filter (lambda (w) (not (accept-on-cyk g w 'S))) ws))



(define levada '(((S 0) (A 0) (B 0))
                 
                 ((S ((2 1) (S B 2) (S S 1)))
                  (A ((2 2) (A 2)))
                  (B ((1) (B 1) (A 1)))))
  )
 
(define nacc-ws '(2 2 1 2 2 2 2 2 1 2))
(define acc-ws (sample (gen:word-from-grammar (format-input  (car (cdr levada)))) 10))
(define levada-nrec (car (apply-reduction-relation* i--> levada)))
(define hlr? (has-left-recursion? levada-nrec))
(define acc? (accepts? levada levada-nrec acc-ws))


; Testes
(check-property (make-config #:tests num-tests
                              #:deadline (* (+ (current-inexact-milliseconds) 3600000) 24))
    (property recursaoRemovida ([g1 gen:grammar-ordered])
      ; Constrói uma lista de palavras aceitas por g1
      (define acc-ws (sample (gen:word-from-grammar (format-input (car (cdr g1)))) num-words))

      ; Constrói uma lista de palavras não aceitas por g1
      (define nacc-ws (filter (lambda (w) (not (accept-on-cyk (format-input (car (cdr g1))) w 'S)))
                              (sample (gen:random-words (Σg g1) max-wrd-size) num-words) ))   

      ; Aplica a remoção de recursão à esquerda
      (define g2 (car (apply-reduction-relation* i--> g1)))

      (check-equal? (has-left-recursion? g2) #f "Verifica se as recursões à esquerda foram removidas")

      (check-equal? (accepts? g1 g2 acc-ws) #t "Verifica se termos aceitos por g1 são aceitos por g2")

      ;(check-equal? (not-accepts? g1 g2 nacc-ws) #t "Verifica se os termos NÃO aceitos por g1 são aceitos por g2")
      
      ; Constrói uma lista de palavras aceitas por g2
      (define acc-ws2 (sample (gen:word-from-grammar (format-input (car (cdr g2))) #:starting-NT 'S) num-words))
      

      ; Constrói uma lista de palavras não aceitas por g2
      #;(define nacc-ws2 (filter (lambda (w) (not (accept-on-cyk (format-input (car (cdr g2))) w 'S)))
                               (sample (gen:random-words (Σg g2) max-wrd-size) num-words) ))

      (check-equal? (accepts? g1 g2 acc-ws2) #t "Verifica se termos aceitos por g2 são aceitos por g1")
       
      ;(check-equal? (not-accepts? g1 g2 nacc-ws2) #t "Verifica se os termos NÃO aceitos por g2 são aceitos por g1")     
))