# Homework 24. 22-April-2012. Pat Devlin # # I don't care about keeping my work private # Help:=proc(): print(`findExamples(N), PerrinMatrixLargeExponent(base, exponent)`): print(`PseudoPrime(A,B,N), PseudoPrimeMillerChallenge(A,B,N)`): print(`Mul(p1, p2)`): print(`Gp(S), badGenerators(S), applyGenerators(S, element)`): end proc: HelpAll:=proc(): end proc: ############# # Problem 1 # ############# findExamples:=proc(N) local un, un1, un2, un3, n, L: un:=3: un1:=0: un2:=2: L:=[]: for n from 0 to N do un3:=un1+un: if(not (isprime(n+3))) then if(type(un3/(n+3),integer)) then L:=[op(L), n+3]: print(n+3): fi: fi: un:=un1: un1:=un2: un2:=un3: od: return L: end proc: with(LinearAlgebra): PerrinMatrixLargeExponent:=proc(base, exponent) local M, i: M:=Matrix(<<0,0,1>|<1,0,1>|<0,1,0>>): for i from 1 to exponent do M:=M^base: od: return (M.<3,0,2>)[1]: end proc: # This takes quite a while running remotely. The only counterexample smaller # than 500,000 is 271,441 # # P(2^20) has a lot of digits, and it's about 4.907486624 * 10^128055 ############# # Problem 2 # ############# PseudoPrime:=proc(A,B,N) local un, un1, un2, un3, n: un:=3: un1:=0: un2:=2*A: for n from 0 to N do un3:=A*un1+B*un: if(not (isprime(n+3))) then if(type(un3/(n+3),integer)) then print(n+3, un3): fi: fi: un:=un1: un1:=un2: un2:=un3: od: end proc: PseudoPrimeMillerChallenge:=proc(A,B,N) local un, un1, un2, un3, n: un:=3: un1:=0: un2:=2*A: for n from 0 to N do un3:=A*un1+B*un: if(not (isprime(n+3))) then if(type(un3/(n+3),integer) and (not(type(un3/A, integer))) and (not (type(un3/B, integer)))) then print(n+3, un3): fi: fi: un:=un1: un1:=un2: un2:=un3: od: end proc: # Miller's challenge seems difficult. There aren't any 'small' such examples (it would seem) ############# # Problem 3 # ############# Mul:=proc(p1, p2) local i, L: if(not(nops(p1) = nops(p2))) then return FAIL: fi: for i from 1 to nops(p1) do if((p1[i] < 1) or (p1[i] > nops(p2)) or (p2[i]<1) or (p2[i]>nops(p1))) then return FAIL: fi: od: return [seq(p2[p1[i]], i=1..nops(p1))]: end proc: ############# # Problem 4 # ############# Gp:=proc(S) local elements, checkedElements, newElements, newCheckedElements, L, i, generators: if(badGenerators(S)) then return FAIL: fi: generators:=[op(S)]: elements:=S: checkedElements:={}: while(not (elements = checkedElements)) do newElements:={}: newCheckedElements:={}: L:=[op(elements minus checkedElements)]: for i from 1 to nops(L) do newElements:=newElements union applyGenerators(generators, L[i]): newCheckedElements:=newCheckedElements union {L[i]}: od: elements:=elements union newElements: checkedElements:=checkedElements union newCheckedElements: od: return elements: end proc: badGenerators:=proc(S) local s, L, i, compareTo: if(not (nop(seq(nops(s), s in S)) = 1)) then return false: fi: L:=[op(S)]: compareTo:={seq(i,i=1..nops(L[1]))}: for i from 1 to nops(S) do if(not ({op(L[i])} = compareTo)) then return false: fi: od: return true: end proc: applyGenerators:=proc(S, element) local theSet, i: theSet:={}: for i from 1 to nops(S) do theSet:=theSet union {Mul(S[i], element)}: od: return theSet: end proc: ############# # Problem 5 # ############# # The group of rigid motions of the cube is... # {[1, 2, 3, 4, 5, 6], [1, 3, 5, 2, 4, 6], [1, 4, 2, 5, 3, 6], # [1, 5, 4, 3, 2, 6], [2, 1, 4, 3, 6, 5], [2, 3, 1, 6, 4, 5], # [2, 4, 6, 1, 3, 5], [2, 6, 3, 4, 1, 5], [3, 1, 2, 5, 6, 4], # [3, 2, 6, 1, 5, 4], [3, 5, 1, 6, 2, 4], [3, 6, 5, 2, 1, 4], # [4, 1, 5, 2, 6, 3], [4, 2, 1, 6, 5, 3], [4, 5, 6, 1, 2, 3], # [4, 6, 2, 5, 1, 3], [5, 1, 3, 4, 6, 2], [5, 3, 6, 1, 4, 2], # [5, 4, 1, 6, 3, 2], [5, 6, 4, 3, 1, 2], [6, 2, 4, 3, 5, 1], # [6, 3, 2, 5, 4, 1], [6, 4, 5, 2, 3, 1], [6, 5, 3, 4, 2, 1]} ############# # Problem 6 # ############# PermToCyc:=proc(p) local cycles, thisCycle, listedElements, i, nextOne: if( not ({op(p)} = {seq(i,i=1..nops(p))})) then return FAIL: fi: cycles:={}: listedElements:={}: for i from 1 to nops(p) do thisCycle:=[]: if(not(member(i, listedElements))) then thisCycle:=[i]: listedElements:=listedElements union {i}: nextOne:=p[i]: while(not(nextOne = i)) do thisCycle:=[op(thisCycle), nextOne]: listedElements:=listedElements union {nextOne}: nextOne:=p[nextOne]: od: cycles:=cycles union {thisCycle}: fi: od: return cycles: end proc: ############# # Problem 7 # ############# Polya:=proc(G, c) local pol: pol:=0: for g in G do pol:=pol+c^(nops(PermToCyc(g))): od: return pol/nops(G): end proc: ############# # Problem 8 # ############# CC:=proc(c): return Polya(Gp({[1, 4, 2, 5, 3, 6], [4, 2, 1, 6, 5, 3], [2, 6, 3, 4, 1, 5]}), c); end proc: # Yes, this sequence is in Sloane