3—Számítógépek alkalmazása a matematika tanításában

Véges/végtelen (nemtriviális) minták felismerése, limeszek megsejtése

Relatív prímek gyakorisága

Kérdés: Milyen gyakran fordulnak elô relatív prímek, azaz mi a valószínûsége, hogy ha valaki véletlenszerûen választ két természetes számot, akkor azok relatív prímek lesznek?

A megoldáshoz a Mathematica built–in függvényét is használhatjuk.

?CoprimeQ

EvenQ[13]

EvenQ[10]

OddQ[11]

PrimeQ[34]

Mintahívások

CoprimeQ[2,4]

CoprimeQ[2,5]

M=10;

Table[n^3,{n,1,M}]

TableForm[Table[{j,k},{j,1,4},{k,1,j}]]

TableForm[Table[Binomial[j,k],{j,0,6},{k,0,j}]]

TableForm[Table[{j,k},{j,1,M},{k,1,M/2}]]

Véges mintát generálunk, vizsgájuk azon  síkbeli (n,m) rácspontokat, melyekre: 1≤m,n≤M

Show[Graphics[{Red,PointSize[.02],Point[Flatten[Table[{m,n},{m,5},{n,5}],1]]}],AxesOrigin->{0,0},Axes->True]

Teljesen eveszti a struktúrát

Flatten[{{1,2},{3,4}}]

TreeForm[{{1,2},{3,4}}]

Csak bizonyos szintig történik meg az “egyszerûsítés

Flatten[{{1,{2}},{3,4},{5,{6}}},1]

1. lehetséges megközelítés: 
— A rendezett párról eldöntjük a tulajdonságot (True/False), majd konvertájuk az informaciót (0/1)-re, majd összegzünk

Length[Flatten[Table[{n,m},{n,M},{m,M}],1]]

x^2+2x+5/.x->-1

(Plus@@Flatten[Table[CoprimeQ[n,m],{n,M},{m,M}],1]/.{True->1,False->0})/M^2

M=10^3;

(Plus@@Flatten[Table[CoprimeQ[n,m],{n,M},{m,M}],1]/.{True->1,False->0})/M^2

Remove[M];

Table[M=10^n;(Plus@@Flatten[Table[CoprimeQ[n,m],{n,M},{m,M}],1]/.{True->1,False->0})/M^2,{n,1,3}]

N[%]

Azt sejthetjük, hogy van limesze a sorozatunknak, talán a határértéket is megsejthetjük (6/(π^2))

N[6/π^2,10]

Kitérô: algebrai számok rekonsrukciója közelítô értékek alapján (RootApproximant)

N[Sqrt[2]+1,10]

RootApproximant[2.414213562]

2. lehetséges megközelítés: 
—Szelektáljuk a tulajdonság alapján a “jó” párokat majd megszámoljuk ôket (lsd Cases vagy Select)

Length[Cases[Flatten[Table[CoprimeQ[n,m],{n,M},{m,M}],1],True]]

Length[Cases[Flatten[Table[CoprimeQ[n,m],{n,M},{m,M}],1],True]]/M^2

Length[Select[Flatten[Table[{n,m},{n,M},{m,M}],1],CoprimeQ[Sequence@@#]&]]/(M^2)

M=10;

Length[Select[Flatten[Table[{n,m},{n,M},{m,M}],1],CoprimeQ[#[[1]],#[[2]]]&]]/(M^2)

Kitérô: “Tiszta függvények”

f2[x_]:=x^2

f2[5]

(#^2)&[5]

Function[{x},x^2][6]

{2,3}

Map[#^2-2&,{3,7,2,13}]

f[n_]:=If[PrimeQ[n],n+5,n^2]

f[5]

Graphics[{PointSize[.02],Flatten[Table[{If[CoprimeQ[m,n],Red,Blue],Point[{m,n}]},{m,M},{n,M}],1]},AxesOrigin->{0,0},Axes->True]

Kaptunk egy rel. gyakoriságot. Kísérlet: növeljük M értékét, mit lehet megfigyelni (HF), milyen mintát kapunk?

Kiegészítô magyarázatok a felhasznált Mathematica függvényekhez.

A. Cases (szintaktikai minta)

Cases[{1+I,5,7-I,Sqrt[2],10,12},x_Complex]

B. Select (szemantikai minta)

Select[{1,5,7,9,10,12},EvenQ[#]&]

Select[{1,5,7,9,10,12},EvenQ]

Select[Table[n,{n,100}],PrimeQ]

Négyzetmentes számok gyakorisága

Hasonló módszerrel dolgozd fel a négyzetmentes számok gyakoriságára vonatkozó kérdést!
Memo: SQRFreeQ(a)⟺ Ha a kanonikus felbontában legfeljebb elsô hatványon szerepel minden prím.
Hint: SquareFreeQ[a]

TableForm[Table[{n,SquareFreeQ[n],FactorInteger[n]},{n,15}]]

M=100;

Length[Select[Table[n,{n,1,M}],SquareFreeQ]]/M

N[%]

Remove[M]

Table[Length[Select[Table[n,{n,1,M}],SquareFreeQ]]/M,{M,{10^2,10^3,10^4,10^5,10^6}}]

N[%,4]

Újból azt sejthetjük, hogy van limesze a sorozatunknak, talán a határértéket is megsejthetjük (6/(π^2))

N[6/π^2]

Length[{5,6,1}]

Table[n,{n,1,M}]

Select[Table[n,{n,1,M}],SquareFreeQ]

*Kitérô (abc)

A matematika (számelmélet) egyik fontos (könnyen érthetô) sejtése az abc sejtés. Azt mondja, hogy Ha a+b=c (gcd(a,b)=1) akkor  c<sqrtfp(abc) majdnem minden rendezett hármasra.
Vagy ami ezzel ekvialens: q(a,b,c):=log(c)/log(sqrfp(a b c))=1+ϵ csak nagyon kevés  (véges sok) számra teljesül. 

Nemrég egy japán matematikus  ismét bejeletette, hogy megvan a bizonyítás. 

http://en.wikipedia.org/wiki/Abc_conjecture

http://index.hu/tudomany/2012/09/12/meglehet_a_primszamok _kozotti _kapcsolat/

Az eddigiekkel szemben most a tulajdonságunkat/predikátumunkat magunk programozzuk le, nincs beépített Mathematica függvény erre.
A függvény egy egész szám négyetmentes részét adja meg, felhasználja a Mathematica faktorizáló függvényét (FactorInteger). 
Erre épül rá a q (quality) mennyiség definíciója.

SquareFreePart[a_]:=Times@@FactorInteger[a][[All,1]]

SquareFreePart[300]

FactorInteger[300]

q[{a_,b_}]:=N[Log[a+b]/Log[SquareFreePart[a b (a+b)]]]

q[{4,127}]

q[{3,125}]

* Rekonstruáljuk/ellenôrizzük a leideni projekt elsô két sorát (c<(10^3)) (lsd wiki)!

T1=Flatten[Table[{a,b},{a,1,100},{b,a+1,100}],1];

T1[[1]]

Last[T1]

Length[T1]

T2=Select[T1,CoprimeQ[#[[1]],#[[2]]]&];

Length[T2]

T3=Select[T2,#[[1]]+#[[2]]<100&];

Select[T3,q[#]>1&]

WS1=Table[Length[Select[T3,q[#]>qq&]],{qq,{1,1.05,1.1,1.2,1.3,1.4}}]

T1=Flatten[Table[{a,b},{a,1,1000},{b,a+1,1000}],1];

T1[[1]]

Last[T1]

Length[T1]

T2=Select[T1,CoprimeQ[#[[1]],#[[2]]]&];

Length[T2]

T3=Select[T2,#[[1]]+#[[2]]<1000&];

Select[T3,q[#]>1&]

WS2=Table[Length[Select[T3,q[#]>qq&]],{qq,{1,1.05,1.1,1.2,1.3,1.4}}]

TableForm[{WS1,WS2},TableHeadings->{{"(10^2)","(10^3)"},{1,1.05,1.1,1.2,1.3,1.4}}]