-- {**************************************************************** -- * * -- * Programm zur Loesung des Pentomino-Problems ( Hoppe/Meyer ). * -- * * -- ***************************************************************** -- * * -- * Programm : Penta * -- * * -- * Datum : 30. 3.85 => 23.02.2025 .. 25.02.2025 Ada JMH * -- * 21.03.2025 JMH Init-Fehler in proc erstesvorzeichen behoben * -- * 22.03.2025 JMH 3 oder 4 Dimensionen? => quader.dimension * -- * 24.03.2025 JMH PENTO.DAT: Keine Leerzeichen an Zeilenenden * -- * 25.03.2025 JMH Kosmetik * -- * * -- ****************************************************************} with text_io ; with integer_text_io ; with ada.command_line ; procedure penta is dimension : constant := 4 ; d1 : constant := 20 ; d2 : constant := 9 ; d3 : constant := 5 ; d4 : constant := 2 ; maxsteinzahl : constant := 5 ; maxfigurenzahl : constant := 16 ; maxlagenzahl : constant := 196 ; type achsen is array (1 .. dimension) of integer ; type ntupel is record koordinate : achsen ; end record ; type raum is array (1 .. d1, 1 .. d2, 1 .. d3, 1 .. d4) of boolean ; type ntupel_at is array (1 .. maxsteinzahl) of ntupel ; type einzelfigur is record einzelstein : ntupel_at ; passt : raum ; end record ; type einzelfigur_at is array (1 .. maxlagenzahl) of einzelfigur ; type figurenblock is record kennung : character ; steinanzahl : positive ; grundfigur : einzelfigur ; drehanzahl : natural ; drehfigur : einzelfigur_at ; end record ; type figurenblock_at is array (1 .. maxfigurenzahl) of figurenblock ; type datenblock is record anzahl : positive ; daten : figurenblock_at ; end record ; type zielfigur is record dimension : positive ; maximum : ntupel ; ausdehnung : ntupel ; kubus : raum ; end record ; type moeglichelage is record tausch : achsen ; ungerade : boolean ; end record ; type vorzeichenkombination is array (1 .. dimension) of boolean ; type string_pt is access string ; figuren : datenblock ; quader : zielfigur ; figurenname : string_pt ; quadername : string_pt ; datei : text_io.file_type ; moeglich : boolean ; aufruf_falsch : exception ; procedure figurenlesen is zeile : string (1 .. 256) ; ende : natural ; begin text_io.open (datei, text_io.in_file, figurenname.all) ; declare anzahl : positive renames figuren.anzahl ; daten : figurenblock_at renames figuren.daten ; begin zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; integer_text_io.get (zeile, anzahl, ende) ; if anzahl > maxfigurenzahl then text_io.new_line ; text_io.put_line ("Kerl ! Das sind mir zu viele Pentominos !") ; moeglich := false ; else for i in 1 .. anzahl loop if moeglich then declare kennung : character renames daten (i).kennung ; steinanzahl : positive renames daten (i).steinanzahl ; grundfigur : einzelfigur renames daten (i).grundfigur ; drehanzahl : natural renames daten (i).drehanzahl ; einzelstein : ntupel_at renames grundfigur.einzelstein ; passt : raum renames grundfigur.passt ; begin text_io.skip_line (datei) ; zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; kennung := zeile (1) ; integer_text_io.get (zeile (2 .. zeile'last), steinanzahl, ende) ; text_io.skip_line (datei) ; if steinanzahl > maxsteinzahl then text_io.new_line ; text_io.put_line ("Zu viele Steine, du Depp !") ; moeglich := false ; else for j in 1 .. steinanzahl loop declare koordinate : achsen renames einzelstein (j).koordinate ; begin zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; ende := 0 ; for k in 1 .. dimension loop integer_text_io.get (zeile ((ende + 1) .. zeile'last), koordinate (k), ende ) ; end loop ; end ; end loop ; end if ; for x1 in 1 .. d1 loop for x2 in 1 .. d2 loop for x3 in 1 .. d3 loop for x4 in 1 .. d4 loop passt (x1, x2, x3, x4) := false ; end loop ; end loop ; end loop ; end loop ; drehanzahl := 0 ; end ; end if ; end loop ; end if ; end ; text_io.close (datei) ; end figurenlesen ; procedure quaderlesen is zeile : string (1 .. 256) ; ende : natural ; begin text_io.open (datei, text_io.in_file, quadername.all) ; declare maximum : ntupel renames quader.maximum ; ausdehnung : ntupel renames quader.ausdehnung ; kubus : raum renames quader.kubus ; begin declare koordinate : achsen renames maximum.koordinate ; begin koordinate (1) := d1 ; koordinate (2) := d2 ; koordinate (3) := d3 ; koordinate (4) := d4 ; end ; declare koordinate : achsen renames ausdehnung.koordinate ; begin zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; ende := 0 ; for i in 1 .. dimension loop if moeglich then integer_text_io.get (zeile ((ende + 1) .. zeile'last), koordinate (i), ende ) ; if koordinate (i) > maximum.koordinate (i) then text_io.new_line ; text_io.put_line ("Mann ! Der Quader ist zu gross !") ; moeglich := false ; end if ; end if ; end loop ; if moeglich then if koordinate (4) > 1 then quader.dimension := 4 ; else quader.dimension := 3 ; end if ; for x4 in 1 .. koordinate (4) loop text_io.skip_line (datei) ; for x3 in 1 .. koordinate (3) loop text_io.skip_line (datei) ; for x2 in reverse 1 .. koordinate (2) loop zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; for x1 in 1 .. koordinate (1) loop kubus (x1, x2, x3, x4) := ( zeile (x1) = '.' ) ; end loop ; end loop ; end loop ; end loop ; end if ; end ; end ; text_io.close (datei) ; end quaderlesen ; procedure raumlagen is procedure allelagen (daten : in out figurenblock) is figur : einzelfigur ; lage : moeglichelage ; vorzeichen : vorzeichenkombination ; procedure erstelage is begin declare tausch : achsen renames lage.tausch ; ungerade : boolean renames lage.ungerade ; begin for i in 1 .. dimension loop tausch (i) := i ; end loop ; ungerade := false ; end ; end erstelage ; procedure erstesvorzeichen is begin vorzeichen (1) := lage.ungerade ; for i in 2 .. dimension loop vorzeichen (i) := false ; end loop ; end erstesvorzeichen ; procedure figurerzeugen is k : natural ; begin declare steinanzahl : positive renames daten.steinanzahl ; grundfigur : einzelfigur renames daten.grundfigur ; begin figur := grundfigur ; declare einzelstein : ntupel_at renames figur.einzelstein ; tausch : achsen renames lage.tausch ; begin for i in 1 .. steinanzahl loop declare koordinate : achsen renames einzelstein (i).koordinate ; begin for j in 1 .. dimension loop k := koordinate (j) ; koordinate (j) := koordinate (tausch (j)) ; koordinate (tausch (j)) := k ; end loop ; for j in 1 .. dimension loop if vorzeichen (j) then koordinate (j) := - koordinate (j) ; end if ; end loop ; end ; end loop ; end ; end ; end figurerzeugen ; procedure sortieren is stein : ntupel ; k : integer ; raus : boolean ; begin declare steinanzahl : positive renames daten.steinanzahl ; einzelstein : ntupel_at renames figur.einzelstein ; begin for i in 1 .. ( steinanzahl - 1 ) loop for j in ( i + 1 ) .. steinanzahl loop raus := false ; k := 1 ; loop if einzelstein (i).koordinate (k) > einzelstein (j).koordinate (k) then stein := einzelstein (i) ; einzelstein (i) := einzelstein (j) ; einzelstein (j) := stein ; raus := true ; else if einzelstein (i).koordinate (k) = einzelstein (j).koordinate (k) then k := k + 1 ; else raus := true ; end if ; end if ; exit when raus or ( k > dimension ) ; end loop ; if k > dimension then text_io.new_line ; text_io.put_line ("Ha ! Da sind zwei Steine gleich !") ; moeglich := false ; end if ; end loop ; end loop ; end ; end sortieren ; procedure zurechtruecken is begin declare steinanzahl : positive renames daten.steinanzahl ; einzelstein : ntupel_at renames figur.einzelstein ; begin for i in reverse 1 .. steinanzahl loop declare koordinate : achsen renames einzelstein (i).koordinate ; begin for j in 1 .. dimension loop koordinate (j) := koordinate (j) - einzelstein (1).koordinate (j) ; end loop ; end ; end loop ; end ; end zurechtruecken ; function nochnichtda return boolean is nichtda : boolean ; verschieden : boolean ; begin nichtda := true ; declare steinanzahl : positive renames daten.steinanzahl ; drehanzahl : natural renames daten.drehanzahl ; drehfigur : einzelfigur_at renames daten.drehfigur ; begin for i in 1 .. drehanzahl loop declare einzelstein : ntupel_at renames drehfigur (i).einzelstein ; begin verschieden := false ; for j in 1 .. steinanzahl loop declare koordinate : achsen renames einzelstein (j).koordinate ; begin for k in 1 .. dimension loop if koordinate (k) /= figur.einzelstein (j).koordinate (k) then verschieden := true ; end if ; end loop ; end ; end loop ; nichtda := nichtda and verschieden ; end ; end loop ; end ; return nichtda ; end nochnichtda ; function figurpasstinquader return boolean is xmin : achsen ; xmax : achsen ; gehtrein : boolean ; begin declare steinanzahl : positive renames daten.steinanzahl ; ausdehnung : ntupel renames quader.ausdehnung ; kubus : raum renames quader.kubus ; einzelstein : ntupel_at renames figur.einzelstein ; passt : raum renames figur.passt ; begin xmin := einzelstein (1).koordinate ; xmax := xmin ; for i in 1 .. dimension loop for j in 2 .. steinanzahl loop declare koordinate : achsen renames einzelstein (j).koordinate ; begin if xmin (i) > koordinate (i) then xmin (i) := koordinate (i) ; end if ; if xmax (i) < koordinate (i) then xmax (i) := koordinate (i) ; end if ; end ; end loop ; xmin (i) := 1 - xmin (i) ; xmax (i) := ausdehnung.koordinate (i) - xmax (i) ; end loop ; gehtrein := false ; for x1 in xmin (1) .. xmax (1) loop for x2 in xmin (2) .. xmax (2) loop for x3 in xmin (3) .. xmax (3) loop for x4 in xmin (4) .. xmax (4) loop passt (x1, x2, x3, x4) := true ; for i in 1 .. steinanzahl loop declare koordinate : achsen renames einzelstein (i).koordinate ; begin passt (x1, x2, x3, x4) := passt (x1, x2, x3, x4) and not kubus (( koordinate (1) + x1 ), ( koordinate (2) + x2 ), ( koordinate (3) + x3 ), ( koordinate (4) + x4 ) ) ; end ; end loop ; gehtrein := gehtrein or passt (x1, x2, x3, x4) ; end loop ; end loop ; end loop ; end loop ; end ; return gehtrein ; end figurpasstinquader ; function letztesvorzeichen return boolean is i : natural ; fertig : boolean ; sammel : boolean ; begin loop i := 0 ; loop i := i + 1 ; vorzeichen (i) := not vorzeichen (i) ; exit when vorzeichen (i) or ( i = quader.dimension ) ; end loop ; fertig := not vorzeichen (i) and ( i = quader.dimension ) ; sammel := false ; for i in 1 .. dimension loop if vorzeichen (i) then sammel := not sammel ; end if ; end loop ; exit when fertig or ( sammel = lage.ungerade ) ; end loop ; return fertig ; end letztesvorzeichen ; function letztelage return boolean is i : natural ; raus : boolean ; begin i := 0 ; raus := false ; declare tausch : achsen renames lage.tausch ; ungerade : boolean renames lage.ungerade ; begin loop i := i + 1 ; tausch (i) := tausch (i) + 1 ; if tausch (i) > dimension then tausch (i) := i ; else raus := true ; end if ; exit when raus or ( i = dimension ) ; end loop ; ungerade := false ; for i in 1 .. dimension loop if tausch (i) /= i then ungerade := not ungerade ; end if ; end loop ; end ; return not raus ; end letztelage ; begin erstelage ; loop erstesvorzeichen ; loop figurerzeugen ; sortieren ; zurechtruecken ; if nochnichtda then if figurpasstinquader then declare drehanzahl : natural renames daten.drehanzahl ; drehfigur : einzelfigur_at renames daten.drehfigur ; begin drehanzahl := drehanzahl + 1 ; drehfigur (drehanzahl) := figur ; end ; end if ; end if ; exit when letztesvorzeichen or not moeglich ; end loop ; exit when letztelage or not moeglich ; end loop ; end allelagen ; begin declare anzahl : positive renames figuren.anzahl ; daten : figurenblock_at renames figuren.daten ; begin for i in 1 .. anzahl loop if moeglich then declare kennung : character renames daten (i).kennung ; drehanzahl : natural renames daten (i).drehanzahl ; begin allelagen (daten (i)) ; text_io.new_line ; text_io.put ("Figur '" & kennung & "' ") ; if drehanzahl = 0 then text_io.put_line ("passt nicht rein !") ; moeglich := false ; else if drehanzahl = 1 then text_io.put_line ("hat 1 Lage im Raum.") ; else text_io.put ("hat ") ; integer_text_io.put (drehanzahl, 1) ; text_io.put_line (" Lagen im Raum.") ; end if ; end if ; end ; end if ; end loop ; end ; end raumlagen ; procedure speicherschreiben is begin text_io.create (datei, text_io.out_file, "PENTO.DAT") ; text_io.put_line (datei, figurenname.all) ; text_io.put_line (datei, quadername.all) ; declare anzahl : positive renames figuren.anzahl ; daten : figurenblock_at renames figuren.daten ; begin integer_text_io.put (datei, anzahl, 1) ; declare koordinate : achsen renames quader.ausdehnung.koordinate ; begin for i in 1 .. dimension loop integer_text_io.put (datei, koordinate (i), 3) ; end loop ; end ; text_io.new_line (datei) ; for i in 1 .. anzahl loop declare kennung : character renames daten (i).kennung ; steinanzahl : positive renames daten (i).steinanzahl ; drehanzahl : natural renames daten (i).drehanzahl ; drehfigur : einzelfigur_at renames daten (i).drehfigur ; begin text_io.new_line (datei) ; text_io.put (datei, kennung) ; integer_text_io.put (datei, steinanzahl, 3) ; integer_text_io.put (datei, drehanzahl, 4) ; text_io.new_line (datei) ; for j in 1 .. drehanzahl loop declare einzelstein : ntupel_at renames drehfigur (j).einzelstein ; passt : raum renames drehfigur (j).passt ; begin for k in 1 .. steinanzahl loop declare koordinate : achsen renames einzelstein (k).koordinate ; begin for l in 1 .. dimension loop integer_text_io.put (datei, koordinate (l), 4) ; end loop ; text_io.new_line (datei) ; end ; end loop ; declare koordinate : achsen renames quader.ausdehnung.koordinate ; begin for x4 in 1 .. koordinate (4) loop for x2 in reverse 1 .. koordinate (2) loop for x3 in 1 .. koordinate (3) loop for x1 in 1 .. koordinate (1) loop if passt (x1, x2, x3, x4) then text_io.put (datei, '*') ; else text_io.put (datei, '.') ; end if ; end loop ; if x3 < koordinate (3) then text_io.put (datei, ' ') ; end if ; end loop ; text_io.new_line (datei) ; end loop ; text_io.new_line (datei) ; end loop ; end ; end ; end loop ; end ; end loop ; end ; text_io.close (datei) ; end speicherschreiben ; begin text_io.new_line ; text_io.put ("**********************************") ; text_io.put_line ("*******************************") ; text_io.put ("* ") ; text_io.put_line (" *") ; text_io.put ("* Hier ist der Pentomino-Loesungsalgorithmus ") ; text_io.put_line ("( Teil A ). *") ; text_io.put ("* ") ; text_io.put_line (" *") ; text_io.put ("**********************************") ; text_io.put_line ("*******************************") ; text_io.put ("* ") ; text_io.put_line (" *") ; text_io.put ("* Ich berechne die Drehfiguren und ihre ") ; text_io.put_line ("Lagemoeglichkeiten. *") ; text_io.put ("* Die Ergebnisse speichere ich in 'PENTO.DAT'.") ; text_io.put_line (" *") ; text_io.put ("* ") ; text_io.put_line (" *") ; text_io.put ("* Quadergroesse dieser Pentomino-Version : ") ; integer_text_io.put (d1, 2) ; text_io.put (" * ") ; integer_text_io.put (d2, 2) ; text_io.put (" * ") ; integer_text_io.put (d3, 2) ; text_io.put (" * ") ; integer_text_io.put (d4, 2) ; text_io.put_line (". *") ; text_io.put ("* ") ; text_io.put_line (" *") ; text_io.put ("**********************************") ; text_io.put_line ("*******************************") ; if ada.command_line.argument_count /= 2 then raise aufruf_falsch ; end if ; figurenname := new string' (ada.command_line.argument (1)) ; quadername := new string' (ada.command_line.argument (2)) ; moeglich := true ; figurenlesen ; if moeglich then quaderlesen ; end if ; if moeglich then raumlagen ; end if ; if moeglich then speicherschreiben ; end if ; text_io.new_line ; exception when aufruf_falsch => text_io.new_line ; text_io.put ("penta ") ; text_io.put_line ("") ; raise ; when others => raise ; end penta ;