#!/usr/pkg/bin/perl ## ## Author: ingwer (at) freeshell.org ## Diabolosches Quadrat nach D.N Lehmer (+ 1938 ) ## fuer n = { 5,7,11,13,17...p } ## ## ## { Xi = i + 2 * [ i / n ] mod n ## | ## { Yi = 2 * i + [ i / n ] mod n ## ## Bug: no test for pseudo prime numbers. ## ############################################################################### ## Copyright (C) 2013 ingwer ## email: ingwer freeshell.org ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2 of the License, or ## (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ############################################################################## use strict; use warnings; my $mod = $ARGV[0] ; my $n = $mod ; if ( ! defined($mod) ) { print "Erwarte Zahl als Argument\n" ;exit ;} if ( ( $n%2 == 0 ) or 2 ** ( $n ) % $n != 2 or $n == 1 or $n == 3 ) { print "Versuchen Sie mit einer Primzahl hoeher als 3\n" ; exit 1 ; } ; my @quadrat =() ; my $sigma = $n * ( $n*$n + 1 ) * 0.5 ; my $i=0 ; while ( $i <= $n*$n - 1 ) { my $f_x = $i + 2 * int($i/$n) ; my $f_y = 2 * $i + int($i/$n) ; my $zeile = $f_x%$mod ; my $spalte = $f_y%$mod ; my $wert = $i ; $quadrat[$zeile][$spalte] = $wert ; $i=$i+1 ; } #print "" ; my $a=0 ; my $summe=0 ; while ( $a <=$n-1 ) { #print "" ; #my $summe=0 ; $summe=0 ; for my $cow ( 0..($n-1) ) { $summe = ( $quadrat[$a][$cow]+1 ) + $summe ; #print " " ; print "",$quadrat[$a][$cow]+1," " ; } print "\n" ; #print "" ; $a = $a+1 ; } print "Summe $summe \n" ; #print "
", $quadrat[$a][$cow]+1," ","
" ; #print "$$quadrat","\n" ; #print ${@{$quadrat[0]}[6]}, "\n" ;