Programmeeruitdagingen topic

[EvilBro]

Oplossing voor uitdaging 4:

Verborgen inhoud

Ik zie nog niet hoe je dit efficient kan doen. Dit is wat ik doe: voor alle polyominoes van orde K genereer ik bij elke polyomino een set punten waarvan elk punt met de polyomino een nieuwe polyomino van orde (K+1) is. Dan genereer ik al deze nieuwe polyominoes, normaliseer ze en gooi ik de dubbelen weg.

Code: Selecteer alles

import Data.List

import qualified Data.Set as Set

-- calculate for N=1 to 10

solution1 = map (length . polyominoes) [1..10]

polyominoes 1 = [[(0,0)]]

polyominoes n = myNub . concatMap generateNext $ polyominoes (n - 1)

-- for larger lists this is more efficient than a normal nub

-- myNub = nub

myNub = (Set.toList . Set.fromList)

-- generate all new normalized polyominoes of 1 higher order based on coords.

generateNext coords = myNub $ map (normalize . (:coords)) (newSquares coords)

-- generate the new squares that can be added to the polyomino

newSquares coords = (nub $ concatMap pointsAround coords) \\ coords

where

pointsAround (x,y) = [(x+1,y),(x-1,y),(x,y+1),(x,y-1)]

-- gives a normalized form of the coordinates of a specific polyomino

normalize coords = minimum [moveOrigin coords, rotate90 coords, rotate180 coords, rotate270 coords]

-- rotate and move origin.

rotate90' coords = map (\(x,y) -> (-y,x)) coords

rotate90  = moveOrigin . rotate90'

rotate180 = rotate90 . rotate90'

rotate270 = rotate180 . rotate90'

-- move the origin to the lowest, most left square in the polyomino.

moveOrigin coords = sort $ map (\(x,y) -> (x-g,y-f)) coords

where

(e,f) = minimumBy (\(a,b) (c,d) -> compare b d) coords

(g,h) = minimumBy (\(a,b) (c,d) -> compare a c) (filter ((==f).snd) coords)

Het genereren van de oplossingen voor N=1 t/m 10 duurt ongeveer 20 seconden.

[EvilBro]

Net iets betere oplossing voor uitdaging 4:

Verborgen inhoud

Paar kleine aanpassingen, echter geen verandering van het algoritme.

Code: Selecteer alles

module Main where 

import Data.List

import qualified Data.Set as Set

main = print solution2

-- calculate for N=1 to 10: takes 10 seconds. compiled ~3 seconds

-- calculate for N=1 to 11: takes 52 seconds. compiled ~12 seconds

solution2 = map (length . polyominoes) [1..10]

polyominoes 1 = [[(0,0)]]

polyominoes n = myNub . concatMap generateNext $ polyominoes (n - 1)

-- for larger lists this is more efficient than a normal nub

-- myNub = nub

myNub = (Set.toList . Set.fromList)

-- generate all new normalized polyominoes of 1 higher order based on coords.

generateNext coords = myNub $ map (normalize . (:coords)) (newSquares coords)

-- generate the new squares that can be added to the polyomino

newSquares coords = (nub $ concatMap squaresAround coords) \\ coords

where

squaresAround (x,y) = [(x+1,y),(x-1,y),(x,y+1),(x,y-1)]

-- gives a normalized form of the coordinates of a specific polyomino

normalize coords = minimum $ map moveOrigin [coords, rotate90 coords, rotate180 coords, rotate270 coords]

-- rotate

rotate90  = map (\(x,y) -> (-y,x))

rotate180 = map (\(x,y) -> (-x,-y))

rotate270 = map (\(x,y) -> (y,-x))

-- line up axis with most left and lowest squares

moveOrigin coords = sort $ map (\(x,y) -> (x-g,y-f)) coords

where

g = minimum $ map fst coords

f = minimum $ map snd coords

Het genereren van de oplossingen voor N=1 t/m 10 duurt ongeveer nu nog maar 10 seconden. Gecompileerd doet het programma er 3 seconden over (12 seconden om ook nog N=11 te berekenen).

[Rogier]

Ik heb een random permutatie van de getallen 1 t/m 32768 gemaakt en daar de eerste 10000 van genomen. Oplossing 3 en 4 doen daar 2.2 seconden over. Dat is niet gecompileerd maar vanuit ghci (maar dat zal wel een of andere JIT-compilatie techniek gebruiken).

Oh dan is dat Haskell sneller dan ik dacht. Ik vind het erg fraai hoe je met hele korte krachtige expressies veel voor elkaar kunt krijgen in Haskell, en dat het dan nog prima snel loopt ook.

Ik had voor nr.1 nog een ander algoritme geprobeerd in PHP, die deed er 20000 in minder dan een seconde, maar een gecompileerde Haskell versie zal dan nog wel sneller zijn. Nu is PHP niet bepaald een snelle taal (interpreted script rommel) maar puur qua algoritme kan het volgens mij haast niet sneller. Ik houd een lijstje bij van optimale deelrijen van verschillende lengte, gesorteerd op lengte, en ieder volgend getal komt bij de beste rij (voor dat getal) erbij. Da's een oplopende search, dus binair, ter lengte van hoogstens de langste rij tot dan toe. Dus da's iets van O(n*log(log(n))) ofzo. Ik doorgrond jouw Haskell oplossingen niet helemaal (ken de taal nauwelijks, heb sowieso weinig ervaring met functioneel programmeren) maar het resultaat lijkt minstens zo optimaal.

Voor nr.4 (de polyonimo's) zie ik ook geen andere methode, maar n=10 in 3 seconden vind ik indrukwekkend snel. Kennelijk zit die compiler wel dusdanig efficient in elkaar dat hij van die hogere orde code slimme optimale lowlevel zooi weet te maken.

[EvilBro]

Ik doorgrond jouw Haskell oplossingen niet helemaal

De algoritmes beschreven:

Voor nr.4 (de polyonimo's) zie ik ook geen andere methode, maar n=10 in 3 seconden vind ik indrukwekkend snel.

Dan heb je mij verkeerd begrepen. Hij rekent n=1 t/m n=10 in 3 seconden uit.

[Rogier]

De algoritmes beschreven:

Dank! Ik ben inmiddels begonnen met een ebook over Haskell, leerzaam dit.

Ik denk dat oplossing 3 en 4 net zoiets zijn als jij gedaan hebt. Volgens mij hoef je geen deelrijen bij te houden. De hoogtes die voor een bepaald aantal hits het laagst zijn is voldoende.

Ah ik zie 't, slim. Je kunt dan niet meer de (of een) optimale deelrij genereren, maar dat hoeft ook niet (alleen het aantal was gevraagd) dus dat scheelt alleen maar tijd, fraai ja!

Dan heb je mij verkeerd begrepen. Hij rekent n=1 t/m n=10 in 3 seconden uit.

Maar die eerste 9 krijg je er gratis bij he

Ik heb om het snelheidsverschil eens te bekijken ook een geoptimaliseerde variant in C++ gemaakt. Is TIG keer zo lang, maar ook tig keer zo snel:

Verborgen inhoud

Code: Selecteer alles

// (windows troep zonodig weghalen voor ander platform)

#define WIN32_MEAN_AND_LEAN

#include <windows.h>

//------------------------------------------------------------------------------

typedef unsigned __int64 Polyonimo;

typedef unsigned __int64 PolyonimoBits;

typedef __int64 PolyonimoDelta;

#include <vector>

typedef std::vector<Polyonimo> PolyonimoList;

static const PolyonimoBits bit = 1;

//------------------------------------------------------------------------------

PolyonimoDelta inline pMax( const PolyonimoDelta &a, const PolyonimoDelta &b )

{

  // max(a,b) zonder branching (if)

  const PolyonimoDelta c = (a-b)>>(sizeof(a)*8-1);

  return (b&c)|(a&~c);

}

//------------------------------------------------------------------------------

static Polyonimo CreatePolyonimo( unsigned w, unsigned h, PolyonimoBits c )

{

  // normaliseer

  unsigned int s = w*h;

  PolyonimoDelta m = (int)(h-w);

  if (!m)

  {

// vierkant: vergelijk vier orientaties

unsigned int p = (s-1);

unsigned int q = s-w;

unsigned int r = w-1;

PolyonimoBits zz = bit<<p;

PolyonimoBits x1,x2,y1,y2;

x1 = x2 = y1 = y2 = 0;

unsigned int zx,zy,z;

for (zx=zy=z=0; z<s; z++)

{

  if ((c>>z)&1) x1 |= zz;

  if ((c>>p)&1) x2 |= zz;

  if ((c>>(q+zy-zx))&1) y1 |= zz;

  if ((c>>(r+zx-zy))&1) y2 |= zz;

  m = pMax(y1,y2)-pMax(x1,x2);

  if (m) break;

  if ((zx+=w)>=s) { zx=0; zy++; }

  p--;

  zz >>= 1;

}

  }

  if (m>0) // roteer 90 indien nodig

  {

PolyonimoBits c2=0;

unsigned int x,y,z=0;

for (y=h-1;;)

{

  for (x=0; x<s; x+=h)

  {

if ((c>>(z++))&1) c2 |= bit<<(x+y);

  }

  if (!y) break;

  y--;

}

c = c2;

z = w;

w = h;

h = z;

  }

  //roteer 180 indien nodig

  PolyonimoBits i = 1;

  PolyonimoBits j = bit<<(--s);

  for (bool r=0;;)

  {

PolyonimoBits ci = c & i;

PolyonimoBits cj = c & j;

if (ci || cj)

{

  if (!r) { if (!cj) break; if (!ci) r = true; }

  if (r) c = (c & ~(i|j)) | (ci<<s) | (cj>>s);

}

i += i;

j >>= 1;

if (s<2) break;

s -= 2;

  }

  return c | (((PolyonimoBits)((w<<4)|h))<<56);

}

//------------------------------------------------------------------------------

static void AddToList( PolyonimoList *list, const Polyonimo &p )

{

  // voeg toe indien nog niet in lijst

  unsigned int n = (unsigned int) list->size();

  unsigned int b = 1;

  while (b<n) b+=b;

  unsigned int i;

  for (i=0; b; b>>=1 ) // (binary search)

  {

unsigned int j = i+b;

if (j>n) continue;

PolyonimoDelta d = p - (*list)[j-1];

if (!d) return; // zat al in lijst

if (d>0) i = j;

  }

  list->insert(list->begin()+i,p);

}

//------------------------------------------------------------------------------

static void AddExtensions( const Polyonimo &p, PolyonimoList *dest )

{

  // voeg alle uitbreidingen toe aan lijst

  unsigned int w = (unsigned int) (p>>56);

  unsigned int h = w & 0xf;

  w >>= 4;

  PolyonimoBits c = p & 0xffffffffffffff;

  unsigned int x,y;

  unsigned int w1 = w-1;

  unsigned int h1 = h-1;

  PolyonimoBits mz = 1;

  for (y=0; y<h; y++) // voeg binnenin blokje toe

  {

PolyonimoBits bx = y ? (mz>>w) : 0;

if (y<h1) bx |= mz<<w;

for (x=0; x<w; x++)

{

  if (!(c&mz)) // dit vakje nog niet bezet?

  {

// check buren

PolyonimoBits b = bx<<x;

if (x) b |= mz>>1;

if (x<w1) b |= mz<<1;

if (c & b) AddToList(dest,CreatePolyonimo(w,h,c|mz));

  }

  mz += mz;

}

  }

  for (unsigned int i=0; i<2; i++)

  {

// twee keer links en rechts blokjes toevoegen

if (i) // tweede keer geroteerd (nu eigenlijk boven & onder)

{

  unsigned int z,q = w*h;

  PolyonimoBits c2 = 0;

  y = h1;

  for(z=0;;)

  {

for (x=0; x<q; x+=h)

{

  if ((c>>(z++))&1) c2 |= bit<<(x+y);

}

if (!y) break;

y--;

  }

  c = c2;

  z = w;

  w = h;

  h = z;

}

// voeg lege kolom toe

PolyonimoBits r = (bit<<w)-1;

PolyonimoBits c2 = 0;

for (y=0; y<h;)

{

  c2 |= (c&r) << (++y);

  r <<= w;

}

// voeg links/rechts blokjes toe

w1 = w+1;

PolyonimoBits k1 = 2;

PolyonimoBits k2 = bit<<w;

for (y=0;;)

{

  if (c2 & k1) AddToList(dest,CreatePolyonimo(w1,h,c2|(k1>>1)));

  if (c2 & k2) AddToList(dest,CreatePolyonimo(w1,h,(c2>>1)|k2));

  if ((++y)>=h) break;

  k1 <<= w1;

  k2 <<= w1;

}

  }

}

//------------------------------------------------------------------------------

static unsigned int GetPolyonimos( unsigned int n, PolyonimoList *dest )

{

  if (n==1) AddToList(dest,CreatePolyonimo(1,1,1));

  else

  {

PolyonimoList prev;

unsigned int np = GetPolyonimos(n-1,&prev);

for (size_t i=0; i<np; i++) AddExtensions(prev[i],dest);

  }

  return (unsigned int) dest->size();

}

//------------------------------------------------------------------------------

static unsigned int CountPolyonimos( unsigned int n )

{

  PolyonimoList dummy;

  return GetPolyonimos(n,&dummy);

}

//------------------------------------------------------------------------------

#pragma comment (lib,"winmm.lib")

static int milliTime() { return timeGetTime(); }

//------------------------------------------------------------------------------

int __stdcall WinMain(HINSTANCE hInst, HINSTANCE hInstPrev, LPSTR cmdLine, int nCmdShow)

{

  int k = 12;

  int t = milliTime();

  int n = CountPolyonimos(k);

  t = milliTime()-t;

  char s[100];

  sprintf(s,"%d: %d (%d msec)",k,n,t);

  MessageBoxA(NULL,s,"",0);

  return 0;

}

(pas op, hele lap code)

Deze volgt hetzelfde principe (iedere polyomino van orde n op alle mogelijke manieren met 1 blokje uitbreiden, normaliseren, en aan lijst toevoegen als hij er nog niet in stond) maar ik sla de polyomino's nu binair op (als een 64-bit int). Dat komt de snelheid bepaald ten goede: n=1 t/m n=11 duurt ongeveer 0.1 sec, t/m 12 duurt nog geen 1 sec, en t/m 13 (476270 stuks) duurt nog geen 10 sec.

[EvilBro]

Maar die eerste 9 krijg je er gratis bij he

Yup

Ik heb om het snelheidsverschil eens te bekijken ook een geoptimaliseerde variant in C++ gemaakt. Is TIG keer zo lang, maar ook tig keer zo snel:

Daar zit volgens mij ook een beetje het euvel. Het lukt lang niet altijd om simpele code ook nog eens snel te laten runnen met Haskell. Ik heb het wel eens bij project euler vraagstukken. Ik gebruik dan hetzelfde algoritme in java (of c) als ik in Haskell gebruik, maar in java komt het wel binnen afzienbare tijd tot een goed antwoord (en bij Haskell niet). Overigens is het meestal wel mogelijk om Haskell code snel te laten lopen, maar meestal gaan dan alle voordelen, mijn inziens, verloren. Maar misschien vloeit dit wel voort uit mijn onervarenheid...

[jhnbk]

Bon, loopt zeer vlot hier zo

Ik neem aan dat 4 correct is opgelost? Dan maar een volgende uit de mouw schudden ...

Uitdaging 5:

Het n-queens probleem is ongetwijfeld een bekende voor de meeste informatici: plaats n dames op een n x n schaakbord zondanig dat elke dame geen enkele andere kan slaan. Een kleine variant hierop:

We nemen aan dat elke dame ook nog kan bewegen als een paard. Hoeveel van zulke dames kunnen er dan maximaal op een 8 x 8 schaakbord geplaatst worden zonder dat deze elkaar kunnen slaan? Geef ook een mogelijke opstelling!

[EvilBro]

Oplossing uitdaging 5:

Verborgen inhoud

Code: Selecteer alles

import Data.List



sizeBoard = 8



solution1 = maxInfo (placeNext 1 [[]])

	where 

		maxInfo = foldl (\(m,s) t -> if length t > m then (length t, t) else (m,s)) (0,[])

		placeNext c p | c > sizeBoard = p

					  | otherwise = placeNext (c+1) (addPiece c p)

		

threatens (x,y) = queenThreats ++ knightThreats

	where

		queenThreats  = rookThreats ++ bishopThreats

		rookThreats   = [(x,n) | n <- [1..(y-1)]]

		bishopThreats = [(x-n,y-n) | n <- [1..(y-1)], x-n > 0] ++ 

						[(x+n,y-n) | n <- [1..(y-1)], x+n <= sizeBoard]

		knightThreats = [(x-2, y-1), (x+2, y-1), (x-1, y-2), (x+1, y-2)]

				  

addPiece nextCol placed = placed ++ [(x, nextCol) : p | p <- placed, x <- [1..sizeBoard], not $ any (`elem` p) (threatens (x, nextCol))]

Als je een oplossing wilt voor de gewone puzzel dan hoef je enkel '++ knightThreats' weg te halen.

[jhnbk]

Mijn oplossing voor uitdaging 5:

Verborgen inhoud

Ik vind een maximum van 6 zulke dames. Heb jij dat ook EvilBro? (Ik heb enkel haskell op mijn linux dus ik kan nu even niet testen.

Code: Selecteer alles

#een solution is een list met per rij de index waar een queen staan

#indien die index -100 is wordt er op die rij geen queen gezet

def freeSquares(solution):

	free=[i for i in range(8) if i not in solution]

	for x in solution:

		y=solution.index(x)

		i=0

		#detecteer diagonalen

		while i<len(free):

			if (y-len(solution))==(x-free[i]) or (y-len(solution))==-1*(x-free[i]):

				del free[i]

			else:

				i+=1

		i=0

		#detecteer paarden sprong

		while i<len(free):

			if len(solution)>=2:

				if abs(free[i]-solution[-1])==2 or abs(free[i]-solution[-2])==1:

					del free[i]

				else:

					i+=1

			else:

				if abs(free[i]-solution[-1])==2:

					del free[i]

				else:

					i+=1

	free.append(-100) #lege rij is altijd een mogelijkheid

	return free

def solve():	

	solutions=[[i] for i in range(8)]

	solutions.append([-100])#eerste rij ook leeglaten

	for j in range(7):

		newsolutions=[]

		for solution in solutions:

			free = freeSquares(solution)

			if len(free)>0:

				for square in free:

					temp=solution[:]

					temp.append(square)

					newsolutions.append(temp)

		solutions=newsolutions[:]

	return solutions

solutions=solve()

maximum=max([8-i.count(-100) for i in solutions])

print "Maximaal: ",maximum

for i in solutions:

	if 8-i.count(-100)==maximum:

		print i

		break

[EvilBro]

Verborgen inhoud

Ik heb ook 6. Er zijn 728 oplossingen (minder als je spiegelingen en rotaties elimineert).

[jhnbk]

Ok. Dan lijkt het opgelost te zijn. Mijn script kan wel efficiënter met backtracking maar daar ga ik niet aan beginnen.

[EvilBro]

Uitdaging 6

Bij project Euler probleem 49 wordt gesteld dat er slechts twee 'arithmetic sequences' zijn waarvoor geldt:

1. Alle elementen van de arithmetic sequence zijn priemgetallen.

2. Alle elementen van de arithmetic sequence bestaan uit 4 cijfers.

3. Alle elementen van de arithmetic sequence zijn een permutatie van elkaar.

Een voorbeeld is 1487, 4817, 8147. Elk van deze getallen is een priemgetal, ze bestaan allemaal uit 4 cijfers, ze zijn allemaal een permutatie van elkaar en het is natuurlijk een arithmetic sequence (verschil is 3330 tussen twee opvolgende getallen).

Verander nu de tweede voorwaarde naar dat elk element uit de arithmetic sequence uit 5 cijfers moet bestaan. Hoeveel arithmetic sequences zijn er die dan aan deze voorwaarden voldoen?

[jhnbk]

Ik vond na een herschrijving van mijn oude code (voor projecteuler in 2007) een trage oplossing. Ik moet nog eens kijken naar een efficiëntere oplossing.

Verborgen inhoud

Code: Selecteer alles

from primes import primes 

def anagrams(s):

if s == "":

return [s]

else:

ans = []

for an in anagrams(s[1:]):

for pos in range(len(an)+1):

ans.append(an[:pos]+s[0]+an[pos:])

return ans

primes100000=primes(100000)

def test(n):

global primes100000

p=sorted([int(i) for i in anagrams(str(n)) if int(i) in primes100000 and int(i)>n])

if len(p)<3:

return []

solutions=[]

for i in range(len(p)-1):

for j in range(i+1,len(p)):

if p[i]-n==p[j]-p[i]:

if not str(n)+" "+str(p[i])+" "+str(p[j]) in solutions:

solutions.append(str(n)+" "+str(p[i])+" "+str(p[j]))

return solutions

n=0

for prime in primes100000:

if prime>9999:

#print prime

for t in test(prime):

print t

n+=1

print "Aantal: ",n

Antwoord: 53 stuks.

Noot: zeer vreemde 'bug' die ik nog niet kon verklaren. Indien ik "if not str(n)+" "+str(p)+" "+str(p[j]) in solutions:" weglaat krijg ik sommige antwoorden vier maal. Totaal geen idee waar het misloopt aangezien na testen blijkt dat dezelfde oplossing komt voor een verschillende i en j.

[jhnbk]

Een andere aanpak werkt perfect voor het originele probleem. Helaas nog trager dan vorige poging:

Verborgen inhoud

Code: Selecteer alles

from primes import primes 

def isPerm(a,b):

	return len([0 for i,j in zip(sorted([i for i in str(a)]),sorted([i for i in str(b)])) if i!=j])==0





p=primes(99999)

n=0

for i in range(len(p)):

	if p[i]>9999:

		for j in range(i+1,len(p)):

			if isPerm(p[i],p[j]):

				for k in range(j+1,len(p)):

					if isPerm(p[j],p[k]):

						if p[j]-p[i]==p[k]-p[j]:

							print p[i],p[j],p[k]

							n+=1

print n

Mogelijk zal binair zoeken de derde lus vermijden en iets sneller zijn

[EvilBro]

Wat is traag in deze context?

Verder zie ik nog een probleem aan mijn probleemomschrijving. Ter verduidelijking: een arithmetic sequence kan uit meer dan 3 elementen bestaan, maar heeft er minstens 3. De arithmetic sequence [1,3,5,7] bevat bijvoorbeeld 4 elementen. De groep [1,3,5,7] levert dus als arithmetic sequences [1,3,5], [3,5,7] en [1,3,5,7].