-- {**************************************************************** -- * * -- * Programm zur Loesung des Pentomino-Problems ( Hoppe/Meyer ). * -- * * -- ***************************************************************** -- * * -- * Programm : Pentb * -- * * -- * Datum : 29. 3.85 => 23.02.2025 .. 25.02.2025 Ada JMH * -- * 26.03.2025 JMH Eingabe von rechentiefe => Kommandozeile * -- * 29.03.2025 JMH PENTO.INF: Keine Leerzeichen an Zeilenenden * -- * 31.03.2025 JMH PENTO.INF: Bessere Ausgabe bei keiner Loesung * -- * * -- ****************************************************************} with text_io ; with integer_text_io ; with ada.command_line ; procedure pentb 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 verbraucht : boolean ; kennung : character ; steinanzahl : positive ; drehanzahl : positive ; 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 ausdehnung : ntupel ; kubus : raum ; erstesfeld : ntupel ; end record ; type zielfiguren is array (0 .. maxfigurenzahl) of zielfigur ; type zaehleinheit is record figur : positive ; drehung : natural ; lage : ntupel ; end record ; type zaehlliste is array (1 .. maxfigurenzahl) of zaehleinheit ; type ausgabe is array (1 .. d1, 1 .. d2, 1 .. d3, 1 .. d4) of character ; type string_pt is access string ; figuren : datenblock ; quader : zielfiguren ; figurenname : string_pt ; quadername : string_pt ; datei : text_io.file_type ; rechentiefe : integer ; ende : natural ; procedure speicherlesen is zeile : string (1 .. 256) ; begin text_io.open (datei, text_io.in_file, "PENTO.DAT") ; zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; figurenname := new string' (zeile (1 .. ende)) ; zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; quadername := new string' (zeile (1 .. ende)) ; text_io.new_line ; text_io.put_line ("Die Figuren kommen aus : " & figurenname.all) ; text_io.put_line ("Die Zielfigur kommt aus : " & quadername.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) ; declare koordinate : achsen renames quader (0).ausdehnung.koordinate ; begin for i in 1 .. dimension loop integer_text_io.get (zeile ((ende + 1) .. zeile'last), koordinate (i), ende ) ; end loop ; end ; for i in 1 .. anzahl loop declare kennung : character renames daten (i).kennung ; steinanzahl : positive renames daten (i).steinanzahl ; drehanzahl : positive renames daten (i).drehanzahl ; drehfigur : einzelfigur_at renames daten (i).drehfigur ; 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) ; integer_text_io.get (zeile ((ende + 1) .. zeile'last), drehanzahl, ende ) ; 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 zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; ende := 0 ; for l in 1 .. dimension loop integer_text_io.get (zeile ((ende + 1) .. zeile'last), koordinate (l), ende ) ; end loop ; end ; end loop ; declare koordinate : achsen renames quader (0).ausdehnung.koordinate ; begin for x4 in 1 .. koordinate (4) loop for x2 in reverse 1 .. koordinate (2) loop zeile := (others => ' ') ; text_io.get_line (datei, zeile, ende) ; for x3 in 1 .. koordinate (3) loop for x1 in 1 .. koordinate (1) loop passt (x1, x2, x3, x4) := (zeile (x1 + (x3 - 1) * (koordinate (1) + 1)) = '*') ; end loop ; end loop ; end loop ; text_io.skip_line (datei) ; end loop ; end ; end ; end loop ; end ; end loop ; end ; text_io.close (datei) ; end speicherlesen ; procedure quaderlesen is zeile : string (1 .. 256) ; begin text_io.open (datei, text_io.in_file, quadername.all) ; text_io.skip_line (datei) ; declare ausdehnung : ntupel renames quader (0).ausdehnung ; kubus : raum renames quader (0).kubus ; erstesfeld : ntupel renames quader (0).erstesfeld ; koordinate : achsen renames ausdehnung.koordinate ; begin 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 ; text_io.close (datei) ; end quaderlesen ; procedure loesungsuchen is anfang : achsen ; zaehler : zaehlliste ; ebene : natural ; rechenschritte : natural ; loesungen : natural ; moeglich : boolean ; quadervoll : boolean ; procedure erstesfreiesfeld (quader : in out zielfigur) is x1 : positive ; x2 : positive ; x3 : positive ; x4 : positive ; begin x1 := anfang (1) ; x2 := anfang (2) ; x3 := anfang (3) ; x4 := anfang (4) ; quadervoll := true ; declare ausdehnung : ntupel renames quader.ausdehnung ; kubus : raum renames quader.kubus ; erstesfeld : ntupel renames quader.erstesfeld ; begin loop loop loop loop if not kubus (x1, x2, x3, x4) then declare koordinate : achsen renames erstesfeld.koordinate ; begin koordinate (1) := x1 ; koordinate (2) := x2 ; koordinate (3) := x3 ; koordinate (4) := x4 ; quadervoll := false ; end ; end if ; x4 := x4 + 1 ; exit when not quadervoll or ( x4 > ausdehnung.koordinate (4) ) ; end loop ; x4 := 1 ; x3 := x3 + 1 ; exit when not quadervoll or ( x3 > ausdehnung.koordinate (3) ) ; end loop ; x3 := 1 ; x2 := x2 + 1 ; exit when not quadervoll or ( x2 > ausdehnung.koordinate (2) ) ; end loop ; x2 := 1 ; x1 := x1 + 1 ; exit when not quadervoll or ( x1 > ausdehnung.koordinate (1) ) ; end loop ; end ; end erstesfreiesfeld ; procedure naechstefigureinsetzen (xpos : in out achsen) is x : achsen ; hilfsquader : zielfigur ; i : natural ; raus : boolean ; begin moeglich := false ; raus := false ; declare anzahl : positive renames figuren.anzahl ; daten : figurenblock_at renames figuren.daten ; figur : positive renames zaehler (ebene).figur ; drehung : natural renames zaehler (ebene).drehung ; begin loop drehung := drehung + 1 ; if drehung > daten (figur).drehanzahl then figur := figur + 1 ; drehung := 1 ; raus := ( figur > anzahl ) ; end if ; if not raus then declare verbraucht : boolean renames daten (figur).verbraucht ; steinanzahl : positive renames daten (figur).steinanzahl ; drehfigur : einzelfigur_at renames daten (figur).drehfigur ; einzelstein : ntupel_at renames drehfigur (drehung).einzelstein ; passt : raum renames drehfigur (drehung).passt ; kubus : raum renames hilfsquader.kubus ; begin if not verbraucht then if passt (xpos (1), xpos (2), xpos (3), xpos (4)) then hilfsquader := quader (ebene) ; moeglich := true ; i := 0 ; loop i := i + 1 ; declare koordinate : achsen renames einzelstein (i).koordinate ; begin for j in 1 .. dimension loop x (j) := xpos (j) + koordinate (j) ; end loop ; if kubus (x (1), x (2), x (3), x (4)) then moeglich := false ; else kubus (x (1), x (2), x (3), x (4)) := true ; end if ; end ; exit when not moeglich or ( i = steinanzahl ) ; end loop ; if moeglich then quader (ebene) := hilfsquader ; raus := true ; end if ; end if ; end if ; end ; end if ; exit when raus ; end loop ; end ; end naechstefigureinsetzen ; procedure loesungausgeben is montage : ausgabe ; x : achsen ; begin loesungen := loesungen + 1 ; text_io.new_line (datei) ; text_io.put (datei, "Loesung ") ; integer_text_io.put (datei, loesungen, 1) ; text_io.put_line (datei, " :") ; integer_text_io.put (datei, rechenschritte, 1) ; text_io.put_line (datei, " Rechenschritte.") ; declare koordinate : achsen renames quader (0).ausdehnung.koordinate ; begin for x1 in 1 .. koordinate (1) loop for x2 in 1 .. koordinate (2) loop for x3 in 1 .. koordinate (3) loop for x4 in 1 .. koordinate (4) loop montage (x1, x2, x3, x4) := '.' ; end loop ; end loop ; end loop ; end loop ; end ; for i in 1 .. rechentiefe loop declare kennung : character renames figuren.daten (zaehler (i).figur ).kennung ; steinanzahl : positive renames figuren.daten (zaehler (i).figur ).steinanzahl ; drehfigur : einzelfigur_at renames figuren.daten (zaehler (i).figur ).drehfigur ; drehung : natural renames zaehler (i).drehung ; lage : ntupel renames zaehler (i).lage ; begin for j in 1 .. steinanzahl loop declare koordinate : achsen renames drehfigur (drehung). einzelstein (j).koordinate ; begin for k in 1 .. dimension loop x (k) := lage.koordinate (k) + koordinate (k) ; end loop ; montage (x (1), x (2), x (3), x (4)) := kennung ; end ; end loop ; end ; end loop ; declare koordinate : achsen renames quader (0).ausdehnung.koordinate ; begin for x4 in 1 .. koordinate (4) loop text_io.new_line (datei) ; for x2 in reverse 1 .. koordinate (2) loop for x3 in 1 .. koordinate (3) loop for x1 in 1 .. koordinate (1) loop text_io.put (datei, montage (x1, x2, x3, x4)) ; end loop ; if x3 < koordinate (3) then text_io.put (datei, ' ') ; end if ; end loop ; text_io.new_line (datei) ; end loop ; end loop ; end ; end loesungausgeben ; begin text_io.create (datei, text_io.out_file, "PENTO.INF") ; text_io.put_line (datei, figurenname.all) ; text_io.put_line (datei, quadername.all) ; text_io.new_line ; declare anzahl : positive renames figuren.anzahl ; daten : figurenblock_at renames figuren.daten ; begin for i in 1 .. anzahl loop declare verbraucht : boolean renames daten (i).verbraucht ; kennung : character renames daten (i).kennung ; drehanzahl : positive renames daten (i).drehanzahl ; begin verbraucht := false ; text_io.put ("Figur '" & kennung & "' hat ") ; integer_text_io.put (drehanzahl, 2) ; if drehanzahl = 1 then text_io.put_line (" Lage im Raum.") ; else text_io.put_line (" Lagen im Raum.") ; end if ; end ; end loop ; end ; loop exit when ( 0 < rechentiefe ) and ( rechentiefe <= figuren.anzahl ) ; text_io.new_line ; text_io.put ("Wieviele Figuren soll ich einsetzen ? ") ; integer_text_io.get (rechentiefe) ; end loop ; ebene := 1 ; rechenschritte := 0 ; loesungen := 0 ; for i in 1 .. dimension loop anfang (i) := 1 ; end loop ; erstesfreiesfeld (quader (0)) ; declare figur : positive renames zaehler (1).figur ; drehung : natural renames zaehler (1).drehung ; lage : ntupel renames zaehler (1).lage ; begin figur := 1 ; drehung := 0 ; lage := quader (0).erstesfeld ; end ; loop rechenschritte := rechenschritte + 1 ; if ( rechenschritte mod 1000000 ) = 0 then text_io.new_line ; text_io.put ("Bis jetzt ") ; integer_text_io.put (rechenschritte, 1) ; text_io.put_line (" Rechenschritte.") ; for i in 1 .. ( ebene - 1 ) loop declare kennung : character renames figuren.daten (zaehler (i).figur ).kennung ; drehung : natural renames zaehler (i).drehung ; lage : ntupel renames zaehler (i).lage ; koordinate : achsen renames lage.koordinate ; begin text_io.put (kennung & " in Drehlage ") ; integer_text_io.put (drehung, 3) ; text_io.put (". ") ; integer_text_io.put (koordinate (1), 4) ; integer_text_io.put (koordinate (2), 4) ; integer_text_io.put (koordinate (3), 4) ; integer_text_io.put (koordinate (4), 4) ; text_io.new_line ; end ; end loop ; end if ; quader (ebene) := quader (ebene - 1) ; naechstefigureinsetzen (quader (ebene).erstesfeld.koordinate) ; if not moeglich then ebene := ebene - 1 ; if ebene > 0 then figuren.daten (zaehler (ebene).figur).verbraucht := false ; end if ; else if ebene = rechentiefe then loesungausgeben ; else anfang := zaehler (ebene).lage.koordinate ; erstesfreiesfeld (quader (ebene)) ; if quadervoll then loesungausgeben ; else figuren.daten (zaehler (ebene).figur).verbraucht := true ; ebene := ebene + 1 ; declare figur : positive renames zaehler (ebene).figur ; drehung : natural renames zaehler (ebene).drehung ; lage : ntupel renames zaehler (ebene).lage ; begin figur := 1 ; drehung := 0 ; lage := quader (ebene - 1).erstesfeld ; end ; end if ; end if ; end if ; exit when ( ebene = 0 ) or ( loesungen = 1 ) ; end loop ; if loesungen = 0 then text_io.new_line (datei) ; text_io.put_line (datei, "Keine Loesung :") ; integer_text_io.put (datei, rechenschritte, 1) ; text_io.put_line (datei, " Rechenschritte.") ; end if ; text_io.close (datei) ; text_io.new_line ; if loesungen = 0 then text_io.put_line ("Keine Loesung !") ; else text_io.put_line ("Probieren beendet !") ; end if ; text_io.new_line ; integer_text_io.put (rechenschritte, 1) ; text_io.put_line (" Rechenschritte.") ; text_io.new_line ; end loesungsuchen ; 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 B ). *") ; 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 bin das eigentliche Probierprogramm.") ; text_io.put_line (" *") ; text_io.put ("* Die Ergebnisse speichere ich in 'PENTO.INF'.") ; 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 = 1 then integer_text_io.get (ada.command_line.argument (1), rechentiefe, ende) ; else rechentiefe := 0 ; end if ; speicherlesen ; quaderlesen ; loesungsuchen ; end pentb ;