Números pitagóricos e primários

[thoga31 571]

Título: Números pitagóricos e primários

Descrição:

Só se pode definir trios de números pitagóricos pois estes números estão relacionados com o Teorema de Pitágoras. Ou seja, um trio de números A, B e C é pitagórico se e só se respeitar duas condições:

• A²+B²=C²
  
• A < B < C
  

Este trio será primário se, considerando gcd uma função que dá o maior divisor comum de dois números:

• gcd(A,B) = gcd(B,C) = gcd(A,C) = 1
  

Prova-se matematicamente que, pelas relações entre os números que compõem um trio pitagórico, bastará verificar que um destes pares de números tem como gcd=1. Ou seja, basta verificar, por exemplo, que gcd(A,B)=1, e isto garante-nos que gcd(B,C)=gcd(A,C)=1

Objectivos:

• Determinar quantos trios pitagóricos existem para um perímetro máximo, P, e quantos destes trios são primários.
  
• Desenvolver dois modos de input:
  
  1. Introdução de apenas um perímetro P por parte do utilizador
     
  2. Introdução de vários perímetros P a analisar sequencialmente
     

  [*]Dar a opção ao utilizador se quer ver quais são os trios de números, e incluir nessa lista a informação se é um trio primário.

Restrições:

• A+B+C <= P
  
• O modo de fazer I/O é à escolha de cada um, desde que cumpra os objectivos
  
• Evitem grandes códigos de validação de input, simplifiquem assumindo sempre que o utilizador introduziu tudo correctamente
  
• Não se pretende obrigatoriamente uma solução optimizada. É opcional.
  

Exemplo I/O:

CASO 1

Input:

Perímetro máximo? 50
Mostrar trios? S

Output:

(6, 3)              // (quantos nºs pitagoreanos, quantos primários)
(True, 3, 4, 5)     // Lista de trios pitagóricos
(True, 5, 12, 13)
(False, 6, 8, 10)
(True, 8, 15, 17)
(False, 9, 12, 15)
(False, 12, 16, 20)

CASO 2

Input:

Perímetros máximos?
50 100
Mostrar trios? N

Output:

50: (6, 3)
100: (17, 7)

Força no teclado

Edited June 1, 2013 by thoga31

[thoga31 571]

Adicionadas duas "restrições" que simplificam o serviço.

[thoga31 571]

Em Haskell a solução é compacta no que diz respeito ao algoritmo central da questão. O problema chega na hora de implementar as soluções I/O, pelo que nesta LP o desafio está, a meu ver, precisamente nessa parte.

-- Algoritmo
pitag n = let lista = [1..n] in [(gcd a b == 1, a, b, c) | a <- lista, b <- lista, c <- lista, a<b && b<c, a^2 + b^2 == c^2, a+b+c <= n]

-- Início da interacção com o utilizador:
-- Pergunta qual o modo de input pretendido
main :: IO()
main = do
   putStrLn "1 = Introduzir um perímetro máximo\n2 = Introduzir lista de perímetros"
   opcao <- (readLn :: IO Int)
   if opcao == 1 then mainpitag1 else if opcao == 2 then mainpitag2 else putStrLn "Opção inexistente."

-- Hipótese de saída nº 1:
-- Pede perímetro máximo, mostrar números opcional
mainpitag1 :: IO()
mainpitag1 = do
   putStrLn $ "Perímetro máximo?"
   n <- (readLn :: IO Int)
   putStrLn $ "Mostrar trios? (0 = NÃO, outro = SIM)"
   mostrar <- (readLn :: IO Int)
   mapM_ putStrLn $ let res = pitag n in ("(pitagoreanos, primários) -> " ++
       show (length $ res, length . filter (\(a, _, _, _) -> a == True) $ res)) :
       (if mostrar /= 0 then map (("   * " ++) . show) res else [])

-- Hipótese de saída nº 2:
-- Pede lista de perímetros, mostrar números de cada um opcional
mainpitag2 :: IO()
mainpitag2 = do
   putStrLn $ "Lista de perímetros máximos? (e.g., \"[50, 100, 24]\"):"
   n <- (readLn :: IO [int])
   putStrLn $ "Mostrar trios? (0 = NÃO, outro = SIM)"
   mostrar <- (readLn :: IO Int)
   putStrLn $ "Perímetro -> (pitagoreanos, primários)"
   mapM_ putStrLn $ resultado n mostrar
       where
           resultado n mst = map (\x -> let res = pitag x in show x ++ " -> " ++
               show (length $ res, length . filter (\(a, _, _, _) -> a == True) $ res) ++
               (if mst /= 0 then "\n" ++ (concat . map (("   * " ++) . (++ "\n") . show) $ res) else [])) $ n

http://ideone.com/p8xuN7

[HappyHippyHippo 1,162]

não venham com coisas, ProLog é rei

/* Calculo do GCD através da subtracção recursiva */
gcd(X, X, X) :- !.                                             /* solução (! = operador cut, elimina as restantes hipóteses da avaliaçãodo predicado) */
gcd(X, Y, D) :- X < Y,                                         /* X é menor que Y */
               Z is Y - X,                                    /* calcular o resultado da subração recursiva */
               gcd(X, Z, D).                                  /* avaliação com o resultado da subtração recursiva */
gcd(X, Y, D) :- X > Y,                                         /* Y é menor que X */
               gcd(Y, X, D).                                  /* avaliar com os valores invertidos */

/* predicado de verificação se o GCD é 1 */
is_gcd_one(X, Y, true) :- gcd(X, Y, 1).                        /* avaliação do GCD com o resultado a 1 */
is_gcd_one(X, Y, false) :- gcd(X, Y, Z), Z =\= 1.              /* avaliação do GCD mas com o resultado diferente de 1 */

/* predicado de validação dos valores do triângulo de pitágulas */
pitag(X, Y, Z) :- float(Z) =:= sqrt(X*X + Y*Y),                /* triangulo de pitágoras */
                 X < Y, Y < Z.                                /* oredem dos valores */

/* predicado do validação dos números pitagóricos de 1 até Max */
pp_cal(Max, {Pri, A, B, C}) :- between(1, Max, A),             /* dar valores a A de 1 a Max (sim sei que poderia ser até Max/3) */
                              between(A, Max, B),             /* dar valores a B de A a Max */
                              between(B, Max, C),             /* dar valores a C de B a Max */
                              Sum is A + B + C,               /* Calcular o Perimetro */
                              Sum =< Max,                     /* Verificar se o perímetro não ultrapassa o máximo */
                              pitag(A, B, C),                 /* avaliar o triângulo de pitágoas dos valroes de A, B e C */
                              is_gcd_one(A, B, Pri).          /* verificar se é primário */

/* predicado de optenção da lista de resultados */
pp_list(Max, List) :- bagof(Sol, pp_cal(Max, Sol), List).      /* opter a lista de soluções */

/* predicado de contagem de resultados primários */
pp_pri([], 0).                                                 /* lista vazia = contagem a zero */
pp_pri([{true, _, _, _}|List], Count) :- pp_pri(List, Dec),    /* o elemento à cabeça é primário, calcular o restante da lista */
                                        Count is Dec + 1.     /* incrementar o resultado */
pp_pri([{false, _, _, _}|List], Count) :- pp_pri(List, Count). /* o elemento à cabeça é primário, calcular o restante da lista */

/* predicado de calculo sem retorno da lista de resultados */
pp(Max, {Count, Prims}) :- pp_list(Max, List),                 /* obter a lista de resultados */
                          length(List, Count),                /* calcular o número de resultados */
                          pp_pri(List, Prims).                /* obter o número de resultados primários */

/* predicado de calculo com retorno da lista de resultados */
pp(Max, {Count, Prims}, List) :- pp_list(Max, List),           /* obter a lista de resultados */
                                length(List, Count),          /* calcular o número de resultados */
                                pp_pri(List, Prims).          /* obter o número de resultados primários */

Edited June 1, 2013 by HappyHippyHippo

[pwseo 234]

Optei por considerar que "apenas um" perímetro é simplesmente uma lista de perímetros com apenas um elemento.

Provavelmente poderia estar melhor mas... preguiça...

import Control.Monad

pitag n = do
 a <- [    1..n]
 b <- [a + 1..n]
 c <- [b + 1..n]
 guard $ sum [a, b, c] <= n
 guard $ a^2 + b^2 == c^2
 return ( (gcd a b == 1), a, b, c )

--8<-- a lógica termina aqui ---8<----8<----8<----8<----8<----8<---

isPrimary (p,_,_,_) = p

short p = (length p, length (filter isPrimary p))

workit n = do
 putStrLn $ "\nPara o número " ++ show n 
 let r = pitag n
 let s = short r
 print s
 if fst s > 0
   then triples r
   else return ()                      

triples a = do
 putStr "Mostrar triplos? "
 c <- getLine
 case c of
   "S" -> mapM_ print a
   "N" -> return ()

main = do
 putStr "Perímetro(s)? "
 ps <- getLine
 mapM_ workit (map read . words $ ps)

[thoga31 571]

@pwseo, o teu código é definitivamente mais limpo que o meu, que eu ainda não lido a 100% com I/O

@Happy, estás a alimentar muito a minha curiosidade em Prolog... adoro estas linguagens

Mas queria ver se ainda percebia melhor o Haskell nos entretantos (por isso é que ando a resolver os desafios que encontro em Haskell, porque em Pascal não me seria tão "desafiante").

[thoga31 571]

Fartei-me do estudo e meti-me a resolver isto em Pascal. Torna-se interessante organizar a informação recolhida na análise, mas um pouco de arrays dinâmicos, array of array e um "atalho" com TStringList's na obtenção do input resolvem bem a coisa...

Mas o código não tem tanta "beleza" como Prolog ou Haskell.

{$mode objfpc}
program numerospitagoricos;
uses classes, sysutils;

type TPerMax = array of integer;
    TTrios = array of array [0..2] of integer;
    TPrim = array of boolean;
    TPitag = record
       perimetro : integer;
       primario : TPrim;
       numeros : TTrios;
    end;
    TPitagList = array of TPitag;

procedure Split(const st : string; const sep : char; var ast : TStringList);
var j : integer;
   t : string;
begin
   t := '';
   for j:=1 to length(st) do begin
       if ((st[j] = sep) and not(t = '')) or (j = length(st)) then begin
           if (j = length(st)) then t := t + st[j];
           ast.Append(t);
           t := '';
       end else
           t := t + st[j];
   end;
end;

function Str2Int(s : string) : integer;
begin
   val(s, Str2Int);
end;

function Int2Str(i : integer) : string;
begin
   str(i, Int2Str);
end;

procedure ObterPerimetros(var lista : TPerMax);
var linha : string;
   temp : TStringList;
   i : integer;
begin
   write('Perimetros maximos? ');
   readln(linha);
   temp := TStringList.Create;
   Split(linha, ' ', temp);
   SetLength(lista, temp.count);
   for i:=0 to Length(lista) - 1 do lista[i] := Str2Int(temp[i]);
   temp.Destroy;
end;

function gcd(u, v: integer): integer;
begin
   if u mod v <> 0 then gcd := gcd(v, u mod v) else gcd := v;
end;

procedure ObterPitagoricos(per : TPerMax; var pit : TPitagList);
var p, a, b, c : integer;
begin
   for p in per do begin
       SetLength(pit, Length(pit) + 1);
       pit[Length(pit)-1].perimetro := p;
       for a:=1 to p-2 do
           for b:=a+1 to p-1 do
               for c:=b+1 to p do begin
                   if ((a<b) and (b<c)) and (sqr(c) = sqr(b) + sqr(a)) and (a+b+c <= p) then begin
                       SetLength(pit[Length(pit)-1].numeros, Length(pit[Length(pit)-1].numeros) + 1);
                       pit[Length(pit)-1].numeros[Length(pit[Length(pit)-1].numeros)-1][0] := a;
                       pit[Length(pit)-1].numeros[Length(pit[Length(pit)-1].numeros)-1][1] := b;
                       pit[Length(pit)-1].numeros[Length(pit[Length(pit)-1].numeros)-1][2] := c;
                       SetLength(pit[Length(pit)-1].primario, Length(pit[Length(pit)-1].primario) + 1);
                       pit[Length(pit)-1].primario[Length(pit[Length(pit)-1].primario)-1] := gcd(a,b) = 1;
                   end;
               end;
   end;
end;

function CountTrue(arr : TPrim) : integer;
var elem : boolean;
begin
   CountTrue := 0;
   for elem in arr do
       if elem then Inc(CountTrue);
end;

var perimetros : TPerMax;
   pitagoricos : TPitagList;
   elem : TPitag;
   mostrar : boolean = true;
   i : integer;

begin
   TRY
   ObterPerimetros(perimetros);
   write('Mostrar trios? (0=nao, outro=sim) ');
   readln(i);
   mostrar := i <> 0;

   ObterPitagoricos(perimetros, pitagoricos);

   for elem in pitagoricos do begin
       writeln(elem.perimetro, ' -> (', Length(elem.numeros), ', ', CountTrue(elem.primario), ')');
       if mostrar then
           for i:=0 to Length(elem.numeros)-1 do begin
               writeln('   * (', elem.primario[i],', ', elem.numeros[i][0], ', ', elem.numeros[i][1], ', ', elem.numeros[i][2], ')');
           end;
   end;

   readln; // pausa

   EXCEPT
       ON EX:EXCEPTION DO BEGIN
           WRITELN(EX.CLASSNAME, ': ', EX.MESSAGE);
           READLN;
       END;
   END;
end.

[HappyHippyHippo 1,162]

@Happy, estás a alimentar muito a minha curiosidade em Prolog... adoro estas linguagens

Mas queria ver se ainda percebia melhor o Haskell nos entretantos (por isso é que ando a resolver os desafios que encontro em Haskell, porque em Pascal não me seria tão "desafiante").

epá !! não te percas agora noutra linguagem por minha causa !!

fica pelo haskell que eu fico a relembrar o Prolog

se bem que estou a ter umas ideias no uso do SWI-ProLog. estou a ver os docs para começar a integrar nos sites que faço, para fazer queries super complexos à base de dados.

[thoga31 571]

epá !! não te percas agora noutra linguagem por minha causa !!

fica pelo haskell que eu fico a relembrar o Prolog

Don't worry, eu cá me oriento no Verão. Prolog está definitvamente na lista... xD

Mas... oh @Happy, a tua solução não tem input?

Edited June 1, 2013 by thoga31

[HappyHippyHippo 1,162]

Don't worry, eu cá me oriento no Verão. Prolog está definitvamente na lista... xD

Mas... oh @Happy, a tua solução não tem input?

tens de chamar o predicado, neste caso seria:

/* ficas com o número de combinações em "count" */
/* ficas com o número de combinações primárias em "Prims" */
/* ficas com a lista de soluções em "List" */
pp(50, {Count, Prims}, List).

existe também o predicado para não retornar a lista:

/* ficas com o número de combinações em "count" */
/* ficas com o número de combinações primárias em "Prims" */
pp(50, {Count, Prims}).

[KTachyon 276]

Objective-C:

#import <Foundation/Foundation.h>

#define MAX_INPUT 1024

NSArray * readPerimetros();
NSArray * getTriplets(int biggest);

@interface TriPlet : NSObject
@property int A, B, C;
@property BOOL P;

- (void) print;
- (int) sum;
- (id) initWithA:(int)a B:(int)b C:(int)c;
@end

@implementation TriPlet
@synthesize A, B, C, P;

- (void) print { NSLog(@"(%@, %d, %d, %d)", P ? @"True" : @"False", A, B, C); }
- (int) sum { return A + B + C; }

- (id) initWithA:(int)a B:(int)b C:(int)c {
   self = [super init];

   if (self) {
       A = a, B = b, C = c;

       while (a != 0) {
           int c = a;
           a = b % a;
           b = c;
       }

       P = (b == 1) ? YES : NO;
   }

   return self;
}
@end

int main(int argc, const char * argv[]) {
   char c;
   BOOL mostrarTrios = NO;

   NSLog(@"Perímetros máximos?");
   NSArray *perimetros = readPerimetros();

   NSLog(@"Mostrar trios?");
   scanf(" %c", &c);

   if (c == 'S' || c == 's')
       mostrarTrios = YES;

   NSArray *sortedPerimetros = [perimetros sortedArrayUsingComparator:^NSComparisonResult(NSString *a, NSString *b) {
       int first = [a intValue], second = [b intValue];
       return first > second;
   }];

   NSArray *results = getTriplets([[sortedPerimetros lastObject] intValue]);

   NSArray *sortedResults = [results sortedArrayUsingComparator:^NSComparisonResult(TriPlet *a, TriPlet *b) {
       int first = [a sum], second = [b sum];
       return first > second;
   }];

   int trios = 0, primarios = 0, pos = 0;

   for (NSString *perimetro in sortedPerimetros) {
       while (pos < sortedResults.count) {
           TriPlet *t = sortedResults[pos];

           if ([t sum] > [perimetro intValue])
               break;

           trios++;
           primarios += t.P ? 1 : 0;
           pos++;
       }

       NSLog(@"%d: (%d, %d)", [perimetro intValue], trios, primarios);
   }

   if (mostrarTrios)
       for (TriPlet *res in results)
           [res print];

   return 0;
}

NSArray * getTriplets(int biggest) {
   NSMutableArray *results = [NSMutableArray new];

   for (int c = 1; c < biggest; c++) {
       int cc = c * c;

       for (int b = 1; b + c < biggest && b < c; b++) {
           int bb = b * b, aa = cc - bb, a = sqrt(aa);
           aa = a * a;

           if (a < b && a + b + c <= biggest && aa + bb == cc) {
               [results addObject:[[TriPlet alloc] initWithA:a B:b C:c]];
           }
       }
   }

   return results;
}

NSArray * readPerimetros() {
   char * line = malloc(MAX_INPUT), * linep = line, c;

   while (1)
       if ((c = fgetc(stdin)) == EOF || (*line++ = c) == '\n')
           break;

   *line = '\0';

   NSArray *perimetros = [[NSString stringWithCString:linep encoding:NSASCIIStringEncoding] componentsSeparatedByString:@" "];
   free(linep);

   return perimetros;
}

[HappyHippyHippo 1,162]

Mas... oh @Happy, a tua solução não tem input?

ontem foi um dia cheio e não deu para responder.

acho que com com input estarias a referir ao método convencional de pergunta/resposta na consola.

pois ... eu adicionei predicados para isso no código seguinto:

/* Calculo do GCD através da subtracção recursiva */
gcd(X, X, X) :- !.                                             /* solução (! = operador cut, elimina as restantes hipóteses da avaliaçãodo predicado) */
gcd(X, Y, D) :- X < Y,                                         /* X é menor que Y */
               Z is Y - X,                                    /* calcular o resultado da subração recursiva */
               gcd(X, Z, D).                                  /* avaliação com o resultado da subtração recursiva */
gcd(X, Y, D) :- X > Y,                                         /* Y é menor que X */
               gcd(Y, X, D).                                  /* avaliar com os valores invertidos */

/* predicado de verificação se o GCD é 1 */
is_gcd_one(X, Y, true) :- gcd(X, Y, 1).                        /* avaliação do GCD com o resultado a 1 */
is_gcd_one(X, Y, false) :- gcd(X, Y, Z), Z =\= 1.              /* avaliação do GCD mas com o resultado diferente de 1 */

/* predicado de validação dos valores do triângulo de pitágulas */
pitag(X, Y, Z) :- float(Z) =:= sqrt(X*X + Y*Y),                /* triangulo de pitágoras */
                 X < Y, Y < Z.                                /* oredem dos valores */

/* predicado do validação dos números pitagóricos de 1 até Max */
pp_cal(Max, {Pri, A, B, C}) :- between(1, Max, A),             /* dar valores a A de 1 a Max (sim sei que poderia ser de Min a Max/3) */
                              between(A, Max, B),             /* dar valores a B de A a Max */
                              between(B, Max, C),             /* dar valores a C de B a Max */
                              Sum is A + B + C,               /* Calcular o Perimetro */
                              Sum =< Max,                     /* Verificar se o perímetro não ultrapassa o máximo */
                              pitag(A, B, C),                 /* avaliar o triângulo de pitágoas dos valroes de A, B e C */
                              is_gcd_one(A, B, Pri).          /* verificar se é primário */

/* predicado de optenção da lista de resultados */
pp_list(Max, List) :- bagof(Sol, pp_cal(Max, Sol), List).      /* opter a lista de soluções */

/* predicado de contagem de resultados primários */
pp_pri([], 0).                                                 /* lista vazia = contagem a zero */
pp_pri([{true, _, _, _}|List], Count) :- pp_pri(List, Dec),    /* o elemento à cabeça é primário, calcular o restante da lista */
                                        Count is Dec + 1.     /* incrementar o resultado */
pp_pri([{false, _, _, _}|List], Count) :- pp_pri(List, Count). /* o elemento à cabeça é primário, calcular o restante da lista */

/* predicado usado para a chamada do predicado de pedido do limite mas sem retorno da lista de soluções */
pp({Count, Prims}) :- pp({Count, Prims}, _).                   /* avaliar o predicado de leitura de limite */

/* predicado de leitura do limite e calculo das soluções */
pp({Count, Prims}, List) :- write('Qual o limite superior do perimetro ? : '),
                           read(Max),
                           pp(Max, {Count, Prims}, List).     /* avaliação do predicado que irá avaliar as soluções para o limite inserido */

/* predicado de calculo sem retorno da lista de resultados */
pp(Max, {Count, Prims}) :- pp_list(Max, List),                 /* obter a lista de resultados */
                          length(List, Count),                /* calcular o número de resultados */
                          pp_pri(List, Prims).                /* obter o número de resultados primários */

/* predicado de calculo com retorno da lista de resultados */
pp(Max, {Count, Prims}, List) :- pp_list(Max, List),           /* obter a lista de resultados */
                                length(List, Count),          /* calcular o número de resultados */
                                pp_pri(List, Prims).          /* obter o número de resultados primários */

agora basta chamar o(s) predicado(s):

pp(Sol).       /* para processo de input e obtenção do número de soluções */
pp(Sol, List). /* para processo de input e obtenção do número de soluções e a lista destas */

[skiller10 0]

Prova-se matematicamente que, pelas relações entre os números que compõem um trio pitagórico, bastará verificar que um destes pares de números tem como gcd=1. Ou seja, basta verificar, por exemplo, que gcd(A,B)=1, e isto garante-nos que gcd(B,C)=gcd(A,C)=1

Podes mostrar aqui a prova sff, fiquei curioso sobre como provar/como chegar a esta conclusão.

[Warrior 68]

gcd(A, B) = 1 significa que A e B são co-primos (ou seja, não existe nenhum número que divida simultaneamente A e B excepto o 1). Também significa que A tem um inverso multiplicativo módulo B, ou seja, existe um número z tal que Az = 1 (mod b).

gcd(A*A, B*B) também terá que ser 1, dado que não acrescentaste nenhum factor novo comum. gcd(A, B*B) também será 1, etc.

Para provares que gcd(A, A*A+B*B) também é 1 devem existir várias formas, mas a forma mais intuitiva para mim é aplicando a existência do inverso multiplicativo: se existe este número z tal que A*Az = 1 (mod B*B), então somar B*B a A*A não muda a solução, ou seja, continua a existir para (A*A+B*B)z = 1 (mod B*B).

Edited June 2, 2013 by Warrior