# Em última instância, em qualquer seção do R, programamos, o R, no sentido que
# enviamos instruções para o computador através do R. Todavia, usaremos o termo
# programar para descrever o ato de gerar um conjunto de instruções que poderão
# ser executadas posteriormente.

# Os programas podem ser armazenados em funções, que são objetos do R, ou em
# arquivos. Nos dois casos, armazenamos um conjunto de instruções que poderão
# ser executadas quando a função ou o arquivo for chamado.

# Exemplo: uma função que calcula 2 + 2
doisedois <- function(){
	return(2 + 2)
}
doisedois()


# Explicação: empregamos a função function para criar um objeto do tipo
# function. Entre parênteses, devem constar os nomes dos argumentos conforme
# tratados dentro da definiçõa da função. Após fechado o parênteses, segue-se
# a definição da função. Caso essa definição seja dividida em mais de uma
# linha, ele deve ser delimitada por duas chaves.

# Você tabém poderia escrever
doiseois <- function() return(2 + 2)


# As funções podem ter argumentos, por exemplo, a função abaixo retorna o
# dobro de seu argumento:
dobro <- function(x){
	return(2 * x)
}

# Experimente agora digitar
dobro(5)
dobro(pi)
dobro(exp(1))

# Tanto nas funções quanto nos scripts, é comum termos que executar testes. O
# controle 'if' é usada fazer algo caso uma expressão seja verdadeira
# por exemplo, a função a seguir retorna o dobro de seu argumento, caso este
# seja um inteiro ímpar

dobraimpar <- function(x){
	if(x %% 2 == 1) x <- 2*x
	return(x)
}

# a variável x recebe seu nome apenas no escopo da função:
x <- 3
dobraimpar(x)
x # esse comando deve ainda retornar 3
x <- dobraimpar(x) 
x # agora, o comando deve retornar 6

# É frequente o uso do controle if else:
# A função abaixo testa se um número é par ou ímpar
# o operador %% retorna o resto da divisão de um número por outro
# x%%1 será igual a zero apenas quando x é inteiro
# x%%2 será igual a zero apenas caso x seja par

parouimpar <- function(x){
	if(is.numeric(x)){
		if (x%%1 !=0) print('Arredondando para inteiro mais próximo')
		x <- as.integer(round(x,0))
		if (x%%2 == 0) 'par' else 'ímpar'
	} else {
		print('Não é possível determinar se um dado não numérico é par ou ímpar')
	}
}

# Você pode usar a função stop() para fazer o R sair da função e imprimir um
# erro, e a função warning() para fazer o R imprimir um aviso:

parouimpar <- function(x){
	if(is.numeric(x)){
		if (x%%1 !=0) warning('Arredondando para inteiro mais próximo',
				      immediate.=T)
		x <- round(x,0)
		if (x%%2 == 0) 'par' else 'ímpar'
	} else {
		stop('Não é possível determinar se um dado não numérico é par ou ímpar')
	}
}

# a opção immediate.=T foi acrescentada para que o aviso fosse impresso antes
# do resultado da função
# Agora experimente

parouimpar(-24)
parouimpar(pi)
parouimpar('a')
parouimpar(1:4)

# A função par ou impar acima só é capaz de avaliar um escalar. Se x for um
# vetor com mais de um elemento, ela falhará. Para evitar isso, tente a função
# a seguir

parouimpar <- function(x){
	if(!is.numeric(x)){
		stop('Não é possível determinar se um dado não numérico é par ou ímpar')
	}
	if (any(x%%1 !=0)) {
		warning('Números não inteiros arredondados para inteiro mais próximo')
		x <- round(x,0)
	}
	pr <- x%%2
	return(c('par', 'ímpar')[pr + 1])
}

# \n acrescenta uma nova linha no texto da mensagem de alerta
# tente agora

parouimpar(1:5)
parouimpar(c(3, exp(1), pi + 1))

# Nos exemplos a seguir, vamos recorrentemente testar se um dado numérico é
# negativo, positivo, e inteiro. Segue-se uma função que faz esses testes:

npi <- function(x){
	# a função stop termina a execução do código e emite uma mensagem 
	# de erro
	if(!is.numeric(x)) stop('Dado não numérico')
	# testando se o número é negativo
	res  <- x < 0 # acrescenta ao vetor res TRUE caso x < 0 e FALSE caso contrário
	res  <- c(res, x > 0) # idem se x > 0
	res  <- c(res, x %% 1 == 0) # idem se x é inteiro
	names(res) <- c('negativo', 'positivo', 'inteiro')
	return(res)
}

# Essa função não funciona, todavia, caso seu argumento seja um vetor numérico
# com mais de um elemento. Para contemplar tal possibilidade, podemos fazer a
# função retornar uma matriz. Para tal, usamos o loop for sua forma é
# for(a in b) na qual a é o nome de uma variável definida internamente e b é
# um vetor ou lista. Dentro desse loop, o R faz o objeto a assumir todos os
# valores em b e realiza operações baseadas nesses valores. No exemplo abaixo,
# usamos o loop for para checar, para cada valor em um vetor se ele é
# positivo, negativo e também se ele é inteiro:

npis <- function(x){
	if(!is.numeric(x)) stop('Dado não numérico')
	res <- c()
	for(n in x){
		res <- rbind(res, c(n<0, n >0, n%%1 == 0))
	}
	colnames(res) <- c('negativo', 'positivo', 'inteiro')
	rownames(res) <- round(x, 4)
	return(res)
}



# Exemplo: uma função o cálculo de fatoriais

# uma função pode chamar a si mesma, desde que em valores para os quais ela já
# tenha sido definida

fat <- function(x){
	if (x==0) return(1) else return(x * fat(x-1))
}

# de fato, a função


# Exemplo: números de Fibonacci
# f(0) = 1, f(1) = 1, f(n) = f(n-2) + f(n-1)
# Qual é o maior número de Fibonacci menor do que x
fib1 <- function(x){
	x <- as.integer(x)
	if (any(x == c(0,1))) return(1) else {
		return(fib1(x-1) + fib1(x-2))}
}

# Esse código é muito ineficiente. Ele começa a falhar com valores muito baixos
# de x.
# Nesse caso é melhor usar um loop. Os loops são
# for (var in seq) expr
# while(cond) expr
# repeat

fib <- function(x){
	merro1 <- ('Dado não numérico. Você deve informar um inteiro positivo')
	merro2 <- ('Números negativos não são admitidos como argumento dessa função')
	maviso <- ('Número não inteiro arredondado para inteiro mais próximo')
	if(!is.numeric(x)) stop(erro1)
	if(x<0) stop(erro2)
	if(x%%1 != 0){
		warning(maviso)
		x <- round(x,0)
	}
	i <- 1 # contador
	a <- 1 # penúltimo número de Fibonacci gerado
	b <- 1 # último número de Fibonacci gerado
	if(any(c(0,1)==x)) return(1) else{
		while(i < x){
			i <- i + 1 # acrescenta 1 ao contador
			c <- a + b # calcula o próximo número de Fibonacci
			a <- b # o último número de Fibonacci passa a ser o penúltimo
			b <- c # o último númeor do Fibonacci passa a ser o próximo
		}
		return(b)
	}
}


# Nossa função fib não é capaz de retornar os números de Fibonacci caso o
# argumento seja um vetor. Por exemplo, tente
fib(c(2, 5, 4))

# Além disso, é possível que se queira ter acesso a todos os números de
# fibonnaci até o n-ésimo número. Podemos armazenar um vetor com esses números
# no resultado da função usando a propriedade attributes. Na função abaixo
# construímos a série dos n primeiros números de Fibonnaci, em que n é o maior
# valor de um vetor numérico x e fazemos a função fibs retornar um objeto cujo
# valor é o valor dos números de Fibonacci de ordem x e cujo atributo
# 'serie' contém todos os n números de Fibonnaci.

fibs <- function(x){
	# inicialmente, testamos se x contém valores numéricos
	if(!is.numeric(x)){
		stop(paste('Dados não numéricos',
		      'você deve entrar um vetor',
		      'de inteiros positivos'))
		# também testamos se há algum valor negativo
	} else if(any(x<0)) {
		stop('Número negativo,os valores devem ser inteiros positivos')
		# e se algum valor é não inteiro
	} else if(any(x%%1 > 0)){
		warning('Um ou mais número não inteiro informado. 
			Convertendo para o inteiro mais próximo')
		x <- round(x,0)
	} 
	# vamos contruir a série de Fibonacci
	n <- max(x) # n é o maior elemento de x
	# se n = 0, só há um número de Fibonnaci a retornar: 1
	if(n==0) fs <- 1 else {
		# caso n > 0
		fs <- c(1, 1)
		if(n > 1){
			for(i in 2:(n + 1)){
				fs[i] <- sum(fs[c(i-1, i-2)])
			}
		}
	}
	# armazenamos no objeto a os números de Fibonacci com ordens dadas
	# pelo vetor x
	a <- fs[x + 1]
	# e, como atributo, desse objeto, os números de Fibonacci, de ordem
	# menor ou igual ao máximo desse vetor
	names(fs) <- 0:n
	attr(a, 'serie')  <- fs
	return(a)
}