Ir para o conteúdo
thoga31

Permutações e capicuas

Mensagens Recomendadas

thoga31

As permutações são uma das bases da Estatística, mas, como seria de esperar, podem ser objecto de um pouco de diversão.

Descrição: Considere-se o número n. Este é constituído por uma série de dígitos. Seja perm uma qualquer função que retorna um conjunto com todos os números formados pelas permutações dos dígitos de n. Por exemplo:

perm(154) = {154, 145, 415, 451, 514, 541}

Pretende-se saber a soma de perm(n).


Parte 1: Criar obrigatoriamente duas soluções distintas para calcular esta soma. Ver as restrições.

Exemplos I/O: (input na 1ª linha, output na 2ª)

123
1332

2810
73326

15280
4266624

Restrições: se uma das soluções utiliza, por exemplo, as permutações propriamente ditas, a outra não as pode utilizar. Os métodos utilizados nas duas soluções devem ser distintos, e não apenas uma "troca de floreados" no código.


Parte 2: Para o conjunto {1, 2, ..., 1000}, descubram quantos e quais dos somatórios das permutações dos números desse conjunto são capicuas, e quantas delas são distintas.

Por exemplo: para o conjunto {10,...,25}, todos os somatórios são capicuas (15), mas apenas 10 delas são distintas, ou seja, não se repetem.

Dêem 1) quais os números cuja soma de permutações dá capicua (e não as somas em si), e 2) quais dessas somas são distintas (e não os números que lhes deram origem).

Restrições: não há.

Divirtam-se :D

EDIT: Para quem já começou a ler, atenção: foram alteradas e adicionadas pequenas coisas, mas importantes ;)

Editado por thoga31

Knowledge is free! | Occasional Fortnite player

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
HappyHippyHippo

lá vai em C (parte 1):

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#define MIN 10
#define MAX 999999

#define INTOF(a) (a - '0')

unsigned long fact(int n);
unsigned long exp_10(int n);
unsigned int ndigits(int n);

unsigned long solve_1(int n);
unsigned long solve_1_build(int n, unsigned int kindex, unsigned long perms[], unsigned long pindex);

unsigned long solve_2(int n);

int main()
{
   int value, solve = 1, ok = 0;

   printf("Somatorio das permutacoes de N\n");
   printf("\n");
   printf("\tvalor minimo : %d\n", MIN);
   printf("\tvalor maximo : %d\n", MAX);
   printf("\tsair : 0\n");
   printf("\n");


   do
   {
       do
       {
           ok = scanf("%d", &value) && ((value >= MIN && value <= MAX) || value == 0);
           while (getchar() != '\n') /* void */;
       } while (!ok);

       if (value != 0)
       {
           printf("%ld\n", solve ? solve_1(value) : solve_2(value));
           solve = !solve;
       }
   } while (value != 0);

   return 0;
}

unsigned long fact(int n)
{
   if (n < 3) return n;
   return n*fact(n-1);
}

unsigned long exp_10(int n)
{
   if (n == 0) return 1;
   return 10 * exp_10(n - 1);
}

unsigned int ndigits(int n)
{
   if (n < 10) return 1;
   return 1 + ndigits(n / 10);
}

unsigned long solve_1(int n)
{
   int nperms = fact(ndigits(n)), iter = 0;
   unsigned long perms[nperms], solution = 0;

   memset(perms, 0, sizeof(unsigned long) * nperms);

   solve_1_build(n, exp_10(ndigits(n) - 1), perms, 0);

   for (iter = 0; iter < nperms; iter++)
   {
       solution += perms[iter];
   }

   return solution;
}

unsigned long solve_1_build(int n, unsigned int kindex, unsigned long perms[], unsigned long pindex)
{
   int key = n % (kindex * 10);
   unsigned long iter1, iter2, inc;

   if (ndigits(kindex) < 2)
   {
       perms[pindex] = key;
       perms[pindex + 1] = key / 10 + (key % 10) * 10;
   }
   else
   {
       iter1 = 0;
       do
       {
           inc = solve_1_build(key, kindex / 10, perms, pindex);

           for (iter2 = 0; iter2 < inc; iter2++)
           {
               perms[pindex + iter2] += key - (key % kindex);
           }
           pindex += inc;

           key = (key % kindex) * 10 + (key / kindex);
           iter1++;
       } while (iter1 < ndigits(kindex));
   }

   return fact(ndigits(kindex));
}

unsigned long solve_2(int n)
{
   int part1 = 0, part2 = 0, part3 = 0, iter = 0;
   char buffer[10];

   part1 = fact(ndigits(n) - 1);

   sprintf(buffer, "%d", n);
   for (iter = 0; iter < ndigits(n); iter++)
   {
       part2 += buffer[iter] - '0';
       part3 += exp_10(iter);
   }

   return part1 * part2 * part3;
}

Editado por HappyHippyHippo

IRC : sim, é algo que ainda existe >> #p@p

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
mogers

HHH, esse código só funciona se o input for um número sem digitos repetidos - não estás a calcular as permutações.

E.g. se N = 11 a resposta é 11.


"What we do for ourselves dies with us. What we do for others and the world, remains and is immortal.", Albert Pine

Blog pessoal : contém alguns puzzles, algoritmos e problemas para se resolver com programação.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
HappyHippyHippo

HHH, esse código só funciona se o input for um número sem digitos repetidos - não estás a calcular as permutações.

E.g. se N = 11 a resposta é 11.

opa ... é o que dá fazer à pressa ... eu vejo isso logo à noite


IRC : sim, é algo que ainda existe >> #p@p

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
thoga31

Aqui vai uma solução em Haskell. http://ideone.com/EaYrNn (versão corrigida mais à frente)

import Data.List (permutations, nub)

-- Parte 1, Solução 1
somaPerm :: (Integral a, Read a, Show a) => a -> a
somaPerm = sum . map read . permutations . show

-- Parte 1, Solução 2
somaPerm2 n = fact ((length $ show n) - 1) * (sum $ digs n) * (ones $ length $ show n)
 where
   fact n = product [1..n]

   digs 0 = []
   digs n = (n `mod` 10) : digs (n `div` 10)

   ones n = (1+) . sum . map (10^) $ [1..n-1]

-- Parte 2
capicua n = (show n) == (reverse $ show n)
soma1000cap = nub $ filter capicua $ map somaPerm [1..1000]
capicuas = let cap x = capicua $ somaPerm x in nub $ filter cap [1..1000]

main :: IO()
main = do
 n <- (readLn :: IO Int)
 putStrLn $ "Metodo 1: " ++ (show $ somaPerm n)
 putStrLn $ "Metodo 2: " ++ (show $ somaPerm2 n)
 putStrLn $ "1 a 1000, quais dao capicuas: " ++ show capicuas
 putStrLn $ "Capicuas distintas, de 1 a 1000: " ++ show soma1000cap

@Happy, gostei de ver que a segunda solução que pedi não causou estranheza. Era exactamente isso que eu pretendia. Agora só falta ver a Parte 2 em C. :)

Editado por thoga31
Aviso para versão corrigida

Knowledge is free! | Occasional Fortnite player

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
mogers

Aqui vai uma solução em Haskell. http://ideone.com/EaYrNn

A tua solução também não respeita o teu enunciado :X O facto de pedires as permutações dos digitos é que tornava o desafio dificil de fazer para números grandes.


"What we do for ourselves dies with us. What we do for others and the world, remains and is immortal.", Albert Pine

Blog pessoal : contém alguns puzzles, algoritmos e problemas para se resolver com programação.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
thoga31

A tua solução também não respeita o teu enunciado :X O facto de pedires as permutações dos digitos é que tornava o desafio dificil de fazer para números grandes.

Não entendi... Onde não respeita?

EDIT: eu não pedi as permutações. Apenas queria saber a soma das permutações. Pedia igualmente 2 métodos. Imagina que conseguias arranjar 2 métodos distintos sem nunca obter as permutações: tinhas o desafio feito.

Se queres descobrir as permutações todas, é uma opção tua. Eu fiz aquele código antes de ter pensado em qualquer desafio, isto veio de uma pequena brincadeira que fiz no Carnaval e que me lembrei que poderia ser interessante para ver os resultados obtidos, como este: para 1234, a soma é 66660. Para números com 5 dígitos, regra geral, tens 3 dígitos consecutivos na soma que são iguais. E assim em diante. E são várias aquelas que dão capicuas, as quais se repetem imenso.

Editado por thoga31

Knowledge is free! | Occasional Fortnite player

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
mogers

Talvez não tenhas visto o meu outro post e não percebeste o que eu disse.

Seja perm uma qualquer função que retorna um conjunto com todos os números formados pelas permutações dos dígitos de n.

A diferença é que tendo em conta as permutações, os calculos ficam mais complicados porque tens de retirar repetidos. Toma como exemplo N = 11 como já referi noutro post anterior. perm(11) = {11} , ou seja a resposta é 11 apenas. Estás a considerar todas hipóteses de mudar os digitos de sitio, contando o 11 duas vezes.


"What we do for ourselves dies with us. What we do for others and the world, remains and is immortal.", Albert Pine

Blog pessoal : contém alguns puzzles, algoritmos e problemas para se resolver com programação.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
thoga31

A diferença é que tendo em conta as permutações, os calculos ficam mais complicados porque tens de retirar repetidos. Toma como exemplo N = 11 como já referi noutro post anterior. perm(11) = {11} , ou seja a resposta é 11 apenas. Estás a considerar todas hipóteses de mudar os digitos de sitio, contando o 11 duas vezes.

Ahh, isso. Comecei por considerar que 11 tinha 2 permutações (considerei cada "1" como um número diferente) quando estava a brincar com isto, e nunca mais me lembrei desse pormenor... My bad, obrigado pelo aviso.

Nada mais simples de resolver, então... :P

http://ideone.com/KVv9Rj

import Data.List (permutations, nub)

-- Parte 1, Solução 1, corrigida
somaPerm :: (Integral a, Read a, Show a) => a -> a
somaPerm = sum . map read . nub . permutations . show

-- Parte 1, Solução 2, corrigida
somaPerm2 n = fact ((ndig n) - diff n) * (sum . digs $ n) * (ones $ length $ show n)
 where
   diff n = (ndig n) - (length $ nub . show $ n) + 1
   ndig n = length $ show n

   fact n = product [1..n]

   digs 0 = []
   digs n = (n `mod` 10) : digs (n `div` 10)

   ones n = (1+) . sum . map (10^) $ [1..n-1]

-- Parte 2
capicua n = (show n) == (reverse $ show n)
soma1000cap = nub $ filter capicua $ map somaPerm [10..1000]
capicuas = let cap x = capicua $ somaPerm x in nub $ filter cap [10..1000]

main :: IO()
main = do
 n <- (readLn :: IO Int)
 putStrLn $ "Metodo 1: " ++ (show $ somaPerm n)
 putStrLn $ "Metodo 2: " ++ (show $ somaPerm2 n)
 putStrLn $ "10 a 1000, quais dao capicuas: " ++ show capicuas
 putStrLn $ "Capicuas distintas, de 10 a 1000: " ++ show soma1000cap

Input: 223
Output: 777


Knowledge is free! | Occasional Fortnite player

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
mogers

Não é assim tão simples :P

input:

12321

output:

Metodo 1: 599994

Metodo 2: 199998

Logo por aqui não bate certo. A resposta certa é 599994


"What we do for ourselves dies with us. What we do for others and the world, remains and is immortal.", Albert Pine

Blog pessoal : contém alguns puzzles, algoritmos e problemas para se resolver com programação.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
thoga31

EUREKA! :D

O método 2 verdadeiramente corrigido:

import Control.Arrow (&&&)

somaPerm2 n = sum . map sum $ map (multiplica (vezes n)) (soma1 (multiplicadores n) (digitos n))
 where
  ndig n = length $ show n
  
  contadores n = let headStr n = (head n):[] in map (headStr &&& length) . group . sort . map head . nub . permutations . show $ n
  multiplicadores n = map (10^) $ [0 .. (ndig n) - 1]
  vezes n = [snd x | x <- contadores n]
  digitos n = [0 + (read $ fst x) | x <- contadores n]
  
  soma1 [] _ = []
  soma1 (x:xs) y = [map (x*) y] ++ soma1 xs y
  
  multiplica [] _ = []
  multiplica _ [] = []
  multiplica (x:xs) (y:ys) = (x*y) : multiplica xs ys

Tendo a certeza absoluta que o método 1 dá sempre certo, eis o teste em como o método 2 está certo também:

Prelude> (map somaPerm [1..10000]) == (map somaPerm2 [1..10000])
True

Com certeza que haverá formas muito mais elegantes de fazer o mesmo em Haskell, mas como eu só comecei há pouco mais de uma semana e acabei agora mesmo de chegar a este código, considero a solução muito aceitável :P

Se alguém tiver sugestões de optimização, que me diga... quero aprender mais umas maravilhosas maravilhas do Haskell xD

Editado por thoga31

Knowledge is free! | Occasional Fortnite player

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
thoga31

Não tive tempo para mais, tenho plena noção que este código é confuso. Mas enfim, já cumpre na íntegra os requisitos todos. Limitei-me a modificar os contadores de modo a dar o +/- mesmo output que o método antigo, e simplifiquei um pouco pois devolve [(Int, Int)] e não [(String, Int)].

somaPerm2 n = sum . map sum $ map (multiplica (vezes n)) (soma1 (multiplicadores n) (digitos n))
where
 ndig n = length $ show n

 contadores n = convert $ zip ([x:[] | x <- nub . sort . show $ n]) (map (permutacoes n `div`) $ map (`arranjos` digs n) (map fst $ digs n))
  where
   headStr xs = (head xs) : []
   fact n = product [1..n]
   permutacoes n = fact ((length $ show n) - 1)

   arranjos :: Int -> [(Int, Int)] -> Int
   arranjos n [] = 1
   arranjos n (x:xs) = (if n == (fst x) then fact (snd x - 1) else fact $ snd x) * arranjos n xs

   digs n = convert . map (headStr &&& length) . group . sort $ show n

   convert :: [(String, Int)] -> [(Int, Int)]
   convert [] = []
   convert (x:xs) = (0 + (read $ fst x), snd x) : convert xs

 multiplicadores n = map (10^) $ [0 .. (ndig n) - 1]
 vezes n = [snd x | x <- contadores n]
 digitos n = [fst x | x <- contadores n]

 soma1 [] _ = []
 soma1 x y = [map ((head x)*) y] ++ soma1 (tail x) y

 multiplica [] _ = []
 multiplica _ [] = []
 multiplica (x:xs) (y:ys) = (x*y) : multiplica xs ys

Editado por thoga31

Knowledge is free! | Occasional Fortnite player

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites
mogers

não sei grande coisa de haskel, mas o aspecto já parece correcto :)

Editado por mogers

"What we do for ourselves dies with us. What we do for others and the world, remains and is immortal.", Albert Pine

Blog pessoal : contém alguns puzzles, algoritmos e problemas para se resolver com programação.

Partilhar esta mensagem


Ligação para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora

×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade. Este site usa cookies para disponibilizar funcionalidades personalizadas. Para mais informações visite esta página.