Somador Completo de 1bit em prolog

and(1,1).

not(0).

or(1,1).

or(1,0).

or(0,1).

xor(1,0).

xor(0,1).

xnor(0,0).

xnor(1,1).

correto(1).

sum(P,Q,Cin):-xor(P,Q),not(Cin).

sum(P,Q,Cin):-xnor(P,Q),correto(Cin).

carryOut(P,Q,Cin):-and(P,Q),not(Cin).

carryOut(P,Q,Cin):-or(P,Q),correto(Cin).

Função map implementada recursivamente

A função mapR aplica a função f a cada elemento da lista (x:xs).

mapR f [] = []
mapR f (x:xs) = (f x):(mapR f xs)

Separação de um texto em palavras

Na função principal é necessário passar duas listas, a string com o texto e a lista com os caracteres que serão usados para separar palavras.

separa ts separadores = separa' ts [] [] separadores

separa' [] ps lps separadores =
                    if ps /= []
                    then
                        (ps:lps)
                    else
                        lps
separa' (t:ts) ps lps separadores =
                    if verificaExistencia t separadores
                    then
                        if ps /= []
                        then
                            separa' ts [] (ps:lps) separadores
                        else
                            separa' ts [] lps separadores
                    else
                        separa' ts (ps++[t]) lps separadores


verificaExistencia y [] = False
verificaExistencia y (x:xs) =
                        if y == x
                        then
                            True
                        else
                            verificaExistencia y xs

Teste:

Agora com caixinha para o código, veja só ehn...
Valeu Marcola.

Ordenação e contagem

insord y [] = [y]
insord y (x:xs) =
if y < x
then
y:x:xs
else
x:(insord y xs)

ordena2 [] ys = ys
ordena2 (x:xs) ys = ordena2 xs (insord x ys)

ordena xs = ordena2 xs []

corta xs i j = [xs!!k | k <- [i..(j-1)]]

separa xs = separa2 xs [] 0 0

separa2 xs ys i j =
if j == length xs
then
(corta xs i j):ys
else
if (xs!!j) == '.' || (xs!!j) == ',' || (xs!!j) == '?' || (xs!!j) == '!' || (xs!!j) == ';' || (xs!!j) == ':' || (xs!!j) == ' '
then
if i == j
then
separa2 xs ys (i + 1) (j + 1)
else
separa2 xs ((corta xs i j):ys) (j+1) (j+1)
else
separa2 xs ys i (j+1)

ordenaTexto xs = ordena (separa xs)

conta xs = conta2 xs []

conta2 [] ys = ys
conta2 (x:xs) [] = conta2 xs [(x,1)]
conta2 (x:xs) ys =
if (fst (last ys)) == x
then
conta2 xs ((tail ys) ++ [(fst (last ys), (snd (last ys))+1)])
else
conta2 xs (ys++[(x,1)])

repeticoes xs = conta (ordenaTexto xs)

Números Feios

Abaixo minha solução para esse probleminha. Ela não resolve para números grandes, mas foi interessante relembrar um pouco de haskell.


divide2 n =
if (mod n 2) == 0
then
divide2 (div n 2)
else
n

divide3 n =
if (mod n 3) == 0
then
divide3 (div n 3)
else
n

divide5 n =
if (mod n 5) == 0
then
divide5 (div n 5)
else
n

--Faz o mdc do número n e verifica se é um número feio
numeroFeio n = (divide5 (divide3 (divide2 n))) == 1

achaProxNumeroFeio num =
if numeroFeio (num + 1)
then
num + 1
else
achaProxNumeroFeio (num + 1)

achaNumeroFeioPosicaoN i n num =
if i /= n
then
achaNumeroFeioPosicaoN (i + 1) n (achaProxNumeroFeio num)
else
num

enesimoNumeroFeio n = achaNumeroFeioPosicaoN 1 n 1

flw