thoga31 570 Posted February 19, 2013 Report Share Posted February 19, 2013 (edited) 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 EDIT: Para quem já começou a ler, atenção: foram alteradas e adicionadas pequenas coisas, mas importantes Edited February 19, 2013 by thoga31 Knowledge is free! Link to post Share on other sites
HappyHippyHippo 1,162 Posted February 20, 2013 Report Share Posted February 20, 2013 (edited) 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; } Edited February 20, 2013 by HappyHippyHippo IRC : sim, é algo que ainda existe >> #p@p Portugol Plus Link to post Share on other sites
mogers 13 Posted February 20, 2013 Report Share Posted February 20, 2013 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. Link to post Share on other sites
HappyHippyHippo 1,162 Posted February 20, 2013 Report Share Posted February 20, 2013 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 Portugol Plus Link to post Share on other sites
thoga31 570 Posted February 20, 2013 Author Report Share Posted February 20, 2013 (edited) 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. Edited February 21, 2013 by thoga31 Aviso para versão corrigida Knowledge is free! Link to post Share on other sites
mogers 13 Posted February 20, 2013 Report Share Posted February 20, 2013 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. Link to post Share on other sites
thoga31 570 Posted February 20, 2013 Author Report Share Posted February 20, 2013 (edited) 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. Edited February 20, 2013 by thoga31 Knowledge is free! Link to post Share on other sites
mogers 13 Posted February 21, 2013 Report Share Posted February 21, 2013 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. Link to post Share on other sites
thoga31 570 Posted February 21, 2013 Author Report Share Posted February 21, 2013 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... 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! Link to post Share on other sites
mogers 13 Posted February 22, 2013 Report Share Posted February 22, 2013 Não é assim tão simples 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. Link to post Share on other sites
thoga31 570 Posted February 22, 2013 Author Report Share Posted February 22, 2013 Os números com dígitos repetidos sofrem de um caso bicudo em que, de vez em quando, é preciso somar 1 à diferença e outras em que não se deve somar. Quando tiver mais tempo investigo mais a fundo este caso. Knowledge is free! Link to post Share on other sites
thoga31 570 Posted February 23, 2013 Author Report Share Posted February 23, 2013 (edited) EUREKA! 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 Se alguém tiver sugestões de optimização, que me diga... quero aprender mais umas maravilhosas maravilhas do Haskell xD Edited February 23, 2013 by thoga31 Knowledge is free! Link to post Share on other sites
thoga31 570 Posted February 23, 2013 Author Report Share Posted February 23, 2013 Esqueci-me que estava a utilizar permutações no início do meu método 2. Isso viola as restrições do enunciado. Já sei qual é a solução sem permutações, mas agora tenho de implementar. Knowledge is free! Link to post Share on other sites
thoga31 570 Posted February 24, 2013 Author Report Share Posted February 24, 2013 (edited) 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 Edited February 24, 2013 by thoga31 Knowledge is free! Link to post Share on other sites
mogers 13 Posted February 25, 2013 Report Share Posted February 25, 2013 (edited) não sei grande coisa de haskel, mas o aspecto já parece correcto Edited February 25, 2013 by 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. Link to post Share on other sites
thoga31 570 Posted February 25, 2013 Author Report Share Posted February 25, 2013 (edited) não sei grande coisa de haskel, mas o aspecto já parece correcto Ainda bem, porque o código está uma vergonha pegada Edited February 25, 2013 by thoga31 Knowledge is free! Link to post Share on other sites
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now