Folien update, Compiler Übung, QS-Doc

This commit is contained in:
M.Scholz 2011-12-18 15:04:21 +01:00
parent 389e4825fa
commit 8ae9900423
6595 changed files with 36611 additions and 687529 deletions

Binary file not shown.

Binary file not shown.

View File

@ -16,6 +16,7 @@
\makeglossaries
%\newglossaryentry{}{name={},description={}}
\newglossaryentry{Agile Softwareentwicklung}{{name=Agile Softwareentwicklung},plural={Agilen Softwareentwicklung},description={Softwareentwicklungsprozess, welcher auf sich ändernde Anforderungen flexibel eingeht.}}
\newglossaryentry{API}{name={API},description={Application Programming Interface: Programmteil, durch den andere Programme die Funktionalität des eigentlichen Programmes nutzen können}}
\newglossaryentry{User-Front-End}{name={User-Front-End},description={Für den Benutzer sichtbarer Teil der Anwendung}}
\newglossaryentry{CO}{name={CO},description={Kohlenstoffmonoxid (chemische Verbindung)}}
@ -39,14 +40,14 @@
\begin{document}
\title{Qualitätssicherungsdokument\\
da\_sense \\
da-sense \\
Wintersemester 2011/2012}
\subtitle{Auftraggeber: Immanuel Schweizer (Telecooperation Group TU Darmstadt) \\
Gruppe 1b: Murat Batu, Ulf Gebhardt, Lulzim Murati, Michael Scholz\\
Teamleiter: Dominik Fischer
}
\subsubtitle{Verison: 0.0.1}
\subsubtitle{Verison: 0.0.9}
\author{Murat Batu, Ulf Gebhardt, Lulzim Murati, Michael Scholz}
@ -65,22 +66,25 @@ In diesem Dokument werden Tests und Prozesse beschrieben, dokumentiert und ausge
\subsection{Das Projekt}
Das Projekt da-sense ist ein großflächiges Sensornetzwerk in Darmstadt. Es besteht aus einer Webapplikation, die dem Nutzer in Zukunft erlauben soll verschiedene Naturerscheinungen wie z.B. Lautstärkepegel (\gls{dB}), \gls{CO}- und \gls{CO2}-Konzentration einzusehen. Die Daten hierfür stammen aus verschiedenen Quellen (Smartphones und Sensoren) und werden in eine Datenbank transferiert, die schließlich über die Webapplikation visualisiert abgerufen werden können. Bisher konnten die Datenbank und die Webapplikation nur mit den von Smartphones gesendeten Daten umgehen. Im Rahmen des Bachelorpraktikums im Wintersemester 2011/2012 sollen folgende Funktionalitäten hinzukommen:
Das Projekt da-sense ist ein großflächiges Sensornetzwerk in Darmstadt. Es besteht aus einer Webapplikation, die dem Nutzer in Zukunft erlauben soll verschiedene Naturerscheinungen wie z.B. Lautstärkepegel (\gls{dB}), \gls{CO}- und \gls{CO2}-Konzentration einzusehen. Die Daten hierfür stammen aus verschiedenen Quellen (Smartphones und \gls{Waspmotes Sensoren}) und werden in eine Datenbank transferiert, die schließlich über die Webapplikation visualisiert abgerufen werden können. Bisher konnten die Datenbank und die Webapplikation nur mit den von Smartphones gesendeten Daten umgehen. Im Rahmen des Bachelorpraktikums im Wintersemester 2011/2012 sollen folgende Funktionalitäten hinzukommen:
\begin{itemize}
\item Datenbank für neue Sensortypen umstrukturieren
\item Umstrukturierung der Datenbank für neue Sensortypen
\item Installation von \gls{Waspmotes Sensoren} auf Straßenbahnen
\item \gls{API} auf neue Datenbank anpassen und neue Visualisierung des \gls{User-Front-End} erstellen
\item Anpassung der \gls{API} auf neue Datenbank und Erstellung einer neue Visualisierung des \gls{User-Front-End}
\item Android-App
\end{itemize}
Da das Projekt auf insgesamt drei Gruppen aufgeteilt wurde, werden in diesem Dokument ausschließlich die Bereiche der Gruppe 1b behandelt. Der Themenbereich umfasst die Umstellung der \gls{API} auf eine neue Datenbank und die Erstellung einer neuen Visualisierung des \gls{User-Front-End}.
Das Projekt wurde auf insgesamt drei Gruppen aufgeteilt. In diesem Dokument werden ausschließlich die Bereiche der Gruppe 1b behandelt.
Der Themenbereich umfasst die Umstellung der \gls{API} auf eine neue Datenbank und die Erstellung einer neuen Visualisierung des \gls{User-Front-End}.
% % % % % % % % % % % % % % % %% % % % % % % % % % % QUALITÄTSZIELE % % % % % % % % % % % % % % % %% % % % % % % % % % % % % % % %
\section{Qualitätsziele}
In diesem Abschnitt werden die zu testenden Qualitätsziele genauer spezifiziert. Dabei werden die Qualitätsmerkmale Funktionalität und Benutzbarkeit besonderst hevorgehoben, da sie für unser Projekt von höchster Priorität sind. Das Merkmal der Funktionalität wird von unserem Auftraggeber gefordert. Die Benutzbarkeit ist unabdingbar, da die neue Visualisierung des \gls{User-Front-End} nach erfolgreichen Abschluss des Projekts einer großen Personengruppe zur Verfügung stehen soll.
%Hier ein zitat mit verweis: >>Damit nur hochwertiges Wissen erzeugt und als Grundlage für weitere Arbeiten nutzbar gemacht wird, gibt es internationale Standards für wissenschaftliche Qualität<< \cite{bss+:2008}
%Als Qualitätziele haben die Merkmale Funktionalität, Benutzbarkeit und Codequalität die höchste Priorität.
%In diesem Abschnitt werden die zu testenden Qualitätsziele genauer spezifiziert. Dabei werden die Qualitätsmerkmale Funktionalität und Benutzbarkeit besonderst hevorgehoben, da sie für unser Projekt von höchster Priorität sind. Das Merkmal der Codequalität soll den nachfolgenden Gruppen, die sich mit dem Projekt da-sense beschäftigen werden, einen besseren Einstieg gewährleisten.
%Die Merkmale sind für ein erfolgreiches Projekt unabdingbar.Das Merkmal der Funktionalität wird von unserem Auftraggeber gefordert. Die %Benutzbarkeit ist unabdingbar, da die neue Visualisierung des \gls{User-Front-End} nach erfolgreichen Abschluss des Projekts einer %großen Personengruppe zur Verfügung stehen soll.
\subsection{Funktionalität}
@ -102,12 +106,12 @@ Die Funktionalit
\subsection{Benutzbarkeit}
\label{subsec:zielBenutzbarkeit}
Als Benutzbarkeit wird der Aufwand definiert, der zum Einsatz der Software von dem Benutzer aufgebracht werden muss. Zudem bedarf es einer individuellen Beurteilung der Benutzung durch eine vorher bestimmte Benutzergruppe.\cite{ISO/IEC 9126}. \\
Als Benutzbarkeit wird der Aufwand definiert, der zum Einsatz der Software von dem Benutzer aufgebracht werden muss. Zudem bedarf es einer individuellen Beurteilung der Benutzung durch eine vorher bestimmte Benutzergruppe \cite{ISO/IEC 9126}. \\
Die Benutzbarkeit lässt sich in die folgenden Punkte gliedern:
\begin{itemize}
\item Verständlichkeit: \\
\textit{Aufzubringender Aufwand des Benutzers, damit sich dieser auf der Weboberfläche zurechtfindet, z.B. verständliche Menüführung.}
\item Erlenbarkeit: \\
\item Erlernbarkeit: \\
\textit{Aufzubringender Aufwand des Benutzers um die Anwendung korrekt zu nutzen.}
\item Bedienbarkeit: \\
\textit{Aufzubringender Aufwand des Benutzers die Anwendung zu bedienen.}
@ -121,7 +125,8 @@ Die Benutzbarkeit l
\subsection{Codequalität}
>>Any fool can write code that a computer can understand. Good programmers write code that humans can understand.<< \cite{fowler}. \\
Die folgenden Anforderungen und Vereinbarungen sollen einen gut lesbaren und gut strukturierten Code zur Folge haben.
Der Quellcode, der im Rahmen des Projekt erstellt wird, soll offen für Erweiterungen sein und wird von weiteren Gruppen genutzt. Daher muss darauf geachtet werden, dass sämtliche Codebausteine auch für Außenstehende lesbar und verständlich sind.
Die folgenden Anforderungen und Vereinbarungen sollen diese Merkmale erfüllen:
\begin{itemize}
\item Kommentare: \\
Jede von uns geschriebene, nicht triviale Funktion muss einen Kommentarkopf der folgenden Form besitzen:\\
@ -131,7 +136,7 @@ Die folgenden Anforderungen und Vereinbarungen sollen einen gut lesbaren und gut
* @return \textit{returntype} \\
* @tested \textit{boolean} \\
**/ \\
Wobei \textit{Description} durch einen funktionsbeschreibenden Text, \textit{paramtype} durch den Parametertyp, \textit{returntype} durch den Rückgabewert und \textit{boolean} durch den Wahrheitswert ''true'' bzw. ''false'' zu ersetzen sind.
Wobei \textit{Description} durch einen funktionsbeschreibenden Text, \textit{paramtype} durch den Parametertyp, \textit{returntype} durch den Rückgabewert und \textit{boolean} durch den Wahrheitswert \glqq true\grqq bzw. \glqq false\grqq zu ersetzen sind.
\item Struktur: \\
Der Code soll folgenden Standards gerecht werden: \\
\begin{itemize}
@ -146,7 +151,8 @@ Die folgenden Anforderungen und Vereinbarungen sollen einen gut lesbaren und gut
% % % % % % % % % % % % % % % %% MAßNAHMEN ZUM ERREICHEN DER QUALITÄTSZIELE % % % % % % % % % % % % % % % %% % % % % % % % % %
\section{Maßnahmen zum Erreichen der Qualitätsziele}
Im folgenden Abschnitt werden die Maßnahmen zum Erreichen der oben genannten Qualitätsziele und die von uns dafür verwendeten Werkzeuge genauer beschrieben. Auch hier werden die Maßnahmen zur Sicherung von Funktionalität und Benutzbarkeit in den Vordergrund gestellt.
Im folgenden Abschnitt werden die Maßnahmen zum Erreichen der oben genannten Qualitätsziele und die von uns dafür verwendeten Werkzeuge genauer beschrieben.
% Auch hier werden die Maßnahmen zur Sicherung von Funktionalität und Benutzbarkeit in den Vordergrund gestellt.
\subsection{Qualitätswerkzeuge}
\begin{itemize}
@ -155,7 +161,7 @@ Dient der Fehlersuche, Bearbeitung und Monitoring des \gls{Webinterface}.
\item Git: \\
Als Versionsverwaltung dient Git. Hierdurch ist ein einfacher Codeaustausch mit den übrigen Gruppen von da-sense möglich, wodurch jede Person stets über den aktuellen Code verfügt.
\item Netbeans:\\
Als integrierte Entwicklungsumgebung (IDE) wird Netbeans verwendet, wodurch Syntxfehler vermieden werden.
Als integrierte Entwicklungsumgebung (IDE) wird Netbeans verwendet, wodurch Syntaxfehler vermieden werden.
\item PHPUnit:\\
Testframework für PHP. Es beinhaltet eine Testumgebung für Datenbankinteraktionen, was für unser Projekt von Vorteil ist. Zudem arbeitet es mit XDebug zusammen und ermöglicht die Erstellung von CodeCoverage Analysen.
\item soapUI:\\
@ -182,9 +188,9 @@ Nach R
\subsection{Benutzbarkeit}
\label{subsec:aktionBenutzbarkeit}
Eine von uns durchgeführte Benutzerstudie stellt das Qualitätsmerkmal der Benutzbarkeit des neuen \glspl{Webinterface} sicher. Dieser Teil des Projekts wird erst am Ende des Projektzeitraums fertig, weshalb auch die Benutzerstudie erst am Ende von uns durchgeführt werden kann. \\
Eine von uns durchgeführte Benutzerstudie stellt das Qualitätsmerkmal der Benutzbarkeit des neuen \glspl{Webinterface} sicher. Dieser Teil des Projekts wird erst am Ende des Projektzeitraums fertig. Aus diesem Grund kann auch die Benutzerstudie erst am Ende von uns durchgeführt werden. \\
Zur Benutzerstudie werden freiwilligen Probanten Bögen ausgeteilt, welche der Bewertung der einzelnen Kriterien (aus Abschnitt \ref{subsec:zielBenutzbarkeit}) der Benutzbarkeit des \glspl{Webinterface} dienen. Zudem werden einzelne Aktionen aller User auf der Webseite protokolliert, um im Anschluss durch eine Logdaten Analyse die Benutzerinteraktionen auswerten zu können. Durch die Benutzerstudie können somit Defizite des \glspl{Webinterface} aufgespürt und beseitigt werden. \\
Das Ziel der Benutzerstudie ist es eine Rückmeldung zu erhalten ob und wie sich der Benutzer auf der Website zurechtfindet. Es gilt herauszufinden ob der User in einer für ihn angemessenen Zeit die gewünschten Informationen abrufen kann. Da das fertige Projekt eine breite Masse an Personen erreichen soll, ist es wichtig, dass die Benutzerstudie möglichst viele verschiedene Personengruppen umfasst. Das heißt es werden Personen mit wenig bis viel Interneterfahrung bzw. junge bis ältere Personen als Probanten gesucht. Zudem können durch die Studie unvorhersehbare Probleme entdeckt werden, da ein Benutzer anders mit der Website umgeht als wir. \newline \\
Das Ziel der Benutzerstudie ist es eine Rückmeldung zu erhalten ob und wie sich der Benutzer auf der Website zurechtfindet. Es gilt herauszufinden, ob der User in einer für ihn angemessenen Zeit die gewünschten Informationen abrufen kann. Da das fertige Projekt eine breite Masse an Personen erreichen soll, ist es wichtig, dass die Benutzerstudie möglichst viele verschiedene Personengruppen umfasst. Das heißt, es werden Personen mit wenig bis viel Interneterfahrung bzw. junge bis ältere Personen als Probanten gesucht. Zudem können durch die Studie unvorhersehbare Probleme entdeckt werden, da ein Benutzer anders mit der Website umgeht als wir. \newline \\
\textbf{Was wollen wir wissen?}
\begin{itemize}
\item Ist die Visualisierung einfach zu verstehen und ansprechend?
@ -195,11 +201,24 @@ Das Ziel der Benutzerstudie ist es eine R
Die Benutzerstudie setzt sich aus den drei Teilen \textit{Beobachtung}, \textit{Fragebogen} und \textit{Logdaten Analyse} zusammen. Somit erhalten wir drei unterschiedliche Informationsquellen, welche in Korrelation zueinander stehen sollten.
\subsubsection{Beobachtung}
Die Beobachtung des Probanden beim Bedienen der Website ist die einfachste Methode zur Evaluation. Hierbei bleibt der Entwickler in der Position des Beobachters und protokoliert. Der Proband surft frei nach seinem Willen durch die Website oder bekommt konkrete Aufgaben gestellt, die er lösen muss.
Die Beobachtung des Probanden beim Bedienen der Website ist die einfachste Methode zur Evaluation. Hierbei bleibt der Entwickler in der Position des Beobachters und protokolliert. Der Proband surft frei nach seinem Willen durch die Website oder bekommt konkrete Aufgaben gestellt, die er lösen muss. \\
Bei der Beobachtung gilt es folgende Stichpunkte zu beachten:
\begin{itemize}
\item Unerwartete Fehler
\item Probleme mit der Bedienung
\item vergangene Zeit bis zum Erhalt der gewünschten Informationen
\item ...
\end{itemize}
\subsubsection{Fragebogen}
\textit{Der folgende Fragebogen kann sich im Laufe des Projekts ändern. Es können neue Fragen hinzukommen oder aber bereits vorhandene geändert bzw. herausgenommen werden.}
Der Fragebogen wird von uns Anfang März 2012 an die teilnehmenden Probanden ausgeteilt. Der genaue Termin wird sich an der Fertigstellung der neuen Visualisierung orientieren. Mit Hilfe des Fragebogens wollen wir Informationen von den verschiedensten Personengruppen aus Sicht eines Nutzers erhalten. Somit ist es möglich auf nutzerspezifische Anforderungen in der letzten Iteration des Projekts einzugehen. Die Fragen sind in drei Kategorien aufteilbar:
\begin{itemize}
\item Informationen über den Nutzer
\item Bewertung der aktuellen Website
\item Verbesserungsvorschläge
\end{itemize}
Durch Punkt eins und zwei können wir nach der Auswertung verschiedene Personengruppen identifizieren und bei ihnen aufgetauchte Probleme analysieren und beseitigen. Punkt drei erlaubt die Anpassung der Website an die nutzerspezifischen Anforderungen. \\
\textit{Der folgende Fragebogen kann sich während des gesamten Projekts ändern, da wir uns für den Prozess der \glspl{Agile Softwareentwicklung} entschieden haben. Es können neue Fragen hinzukommen oder aber bereits vorhandene geändert bzw. herausgenommen werden. Die Entscheidung über die zu stellenden Fragen obliegt dem gesamten Team. Hierdurch erhoffen wir uns, dass wir möglichst viele Bereiche des Projekts abfragen können.}
\begin{enumerate}
\item Wie alt sind Sie?
@ -261,23 +280,37 @@ Die Beobachtung des Probanden beim Bedienen der Website ist die einfachste Metho
\end{enumerate}
\subsubsection{Logdaten Analyse}
Zur Analyse der Logdaten wird das Tool Google Analytics verwendet. Hiermit ist es möglich verschiedenste Statistiken zu erhalten. \\
Zur Analyse der Logdaten wird das kostenlose Tool Google Analytics verwendet, welches uns mit seiner Vielseitigkeit und Flexibilität überzeugt hat. Zudem erfolgt die Bedienung intuitiv, weshalb eine unter Umständen längere Einarbeitungszeit in andere Tools entfällt.
GoogleAnalytics erlaubt es verschiedenste Statistiken zu erhalten, mit deren Hilfe wir die Qualität des \glspl{User-Front-End} weiter erhöhen können. \\
Für uns sind die folgenden Statistiken von großer Bedeutung:
\begin{itemize}
\item Besucherzahlen
\item am meisten aufgerufene Seiten
\item Pfad der besuchten Seiten
\item Ausstiegsseiten
\item ''Absprungsrate''
\item \glqq Absprungsrate\grqq
\item Besuchszeit der einzelnen Seiten
\item ...
\end{itemize}
Hierdurch erlangen wir einen Überblick wie das \gls{Webinterface} von den Nutzern bedient wird und können daraus schließen welche Funtionalitäten intutiv und welche weniger intuitiv sind.
Hierdurch erlangen wir einen Überblick wie das \gls{Webinterface} von den Nutzern bedient wird und können daraus schließen welche Funtionalitäten intutiv und welche weniger intuitiv sind.
\parindent 0pt
\paragraph{Datenschutz}
Um eine datenschutzkonforme Nutzung von Google Analytics zu gewährleisten, müssen folgende Vorgaben erfüllt werden \cite{DBA}:
\begin{itemize}
\item Vertrag zur Auftragsdatenverarbeitung mit Google (§ 11 BDSG - Vertrag)
\item Anonymisierung der IP-Adressen
\item Widerspruchsrecht der Betroffenen
\item angepasster Datenschutzhinweis
\item Löschung von Altdaten (bestehende Google Analytics Profile)
\end{itemize}
Punkt eins wird in den kommenden Wochen bearbeitet. Die Anonymisierung der IP-Adressen erfolgt durch Abschneiden der letzten 8 Bit der IP-Adresse. Das Widerspruchsrecht der Nutzer wird durch Google gewährleistet. Hierzu wird ein Add-on für den Webbrowser angeboten, welches Google Analytics deaktiviert. Da bisher keine Daten gesammelt wurden, müssen von uns auch keine Altdaten gelöscht werden.\\
Der anpasste Datenschutzhinweis findet sich im Impressum durch folgende Vorlage: \\
>> Diese Website benutzt Google Analytics, einen Webanalysedienst der Google Inc. (\glqq Google\grqq). Google Analytics verwendet sog. \glqq Cookies\grqq, Textdateien, die auf Ihrem Computer gespeichert werden und die eine Analyse der Benutzung der Website durch Sie ermöglichen. Die durch den Cookie erzeugten Informationen über Ihre Benutzung dieser Website werden in der Regel an einen Server von Google in den USA übertragen und dort gespeichert. Im Falle der Aktivierung der IP-Anonymisierung auf dieser Webseite, wird Ihre IP-Adresse von Google jedoch innerhalb von Mitgliedstaaten der Europäischen Union oder in anderen Vertragsstaaten des Abkommens über den Europäischen Wirtschaftsraum zuvor gekürzt. Nur in Ausnahmefällen wird die volle IP-Adresse an einen Server von Google in den USA übertragen und dort gekürzt. Im Auftrag des Betreibers dieser Website wird Google diese Informationen benutzen, um Ihre Nutzung der Website auszuwerten, um Reports über die Websiteaktivitäten zusammenzustellen und um weitere mit der Websitenutzung und der Internetnutzung verbundene Dienstleistungen gegenüber dem Websitebetreiber zu erbringen. Die im Rahmen von Google Analytics von Ihrem Browser übermittelte IP-Adresse wird nicht mit anderen Daten von Google zusammengeführt. Sie können die Speicherung der Cookies durch eine entsprechende Einstellung Ihrer Browser-Software verhindern; wir weisen Sie jedoch darauf hin, dass Sie in diesem Fall gegebenenfalls nicht sämtliche Funktionen dieser Website vollumfänglich werden nutzen können. Sie können darüber hinaus die Erfassung der durch das Cookie erzeugten und auf Ihre Nutzung der Website bezogenen Daten (inkl. Ihrer IP-Adresse) an Google sowie die Verarbeitung dieser Daten durch Google verhindern, indem sie das unter dem folgenden Link (\href{http://tools.google.com/dlpage/gaoptout?hl=de}{http://tools.google.com/dlpage/gaoptout?hl=de}) verfügbare Browser-Plugin herunterladen und installieren. Nähere Informationen hierzu finden Sie unter \href{http://tools.google.com/dlpage/gaoptout?hl=de}{http://tools.google.com/dlpage/gaoptout?hl=de} bzw. unter
\href{http://www.google.com/intl/de/analytics/privacyoverview.html}{http://www.google.com/intl/de/analytics/privacyoverview.html} (allgemeine Informationen zu Google Analytics und Datenschutz). Wir weisen Sie darauf hin, dass auf dieser Webseite Google Analytics um den Code \glqq gat.\_anonymizeIp();\grqq erweitert wurde, um eine anonymisierte Erfassung von IP-Adressen (sog. IP-Masking) zu gewährleisten. << \cite{DBA}
\subsection{Codequalität}
\textbf{Noch nicht fertig!!} \\
maßnahmen zur sicherung der codequalität....
Maßnahmen zur Sicherung der Codequalität....
@ -292,19 +325,18 @@ Auf den folgenden Seiten findet sich die Dokumentation
\subsubsection{Funktionalität}
\newpage
\subsubsection{Benutzerstudie}
Wie in Abschnitt \ref{subsec:aktionBenutzbarkeit} beschrieben, wird die Benutzerstudie erst am Ende des Projekts durchgeführt, da das Webinterface zum jetzigen Zeitpunkt noch nicht fertiggestellt ist. Die Testdokumentation erfolgt somit im Anschluss und wird sich in der finalen Version dieses Dokuments (Abgabedatum 31.03.2012) befinden.
\newpage
\subsubsection{Logdaten Analyse}
Die Logdaten Analyse steht in Zusammenhang mit der Benutzerstudie und wird somit auch erst am Ende des Projekts durchgeführt. Die Testdokumentation erfolgt somit im Anschluss und wird sich in der finalen Version dieses Dokuments (Abgabedatum 31.03.2012) befinden.
\newpage
\subsubsection{Codequalität}
\newpage
\subsection{User-Stories}
@ -318,9 +350,10 @@ F
\begin{tabbing}
\begin{tabular}{||p{5.4cm}||p{11cm}||}
%\hline \rule[-2ex]{0pt}{5.5ex} Noch eine version & test \\
\hline \rule[-2ex]{0pt}{5.5ex} v. 0.0.9 - 14.12.2011 - MS & Benutzerstudie \\
\hline \rule[-2ex]{0pt}{5.5ex} v. 0.0.1 - 09.12.2011 - MS & Einleitung, Qualitätsziele (Codequalität, Funktionalität), Qualitätswerkzeuge\\
\hline \rule[-2ex]{0pt}{5.5ex} v. 0.0.0 - 01.12.2011 - MS & Dokument angelegt\\
\hline \rule[-2ex]{0pt}{5.5ex} v. 0.0.1 - 09.12.2011 - MS & Einleitung, Qualitätsziele (Codequalität, Funktionalität), Qualitätswerkzeuge\\
\hline \rule[-2ex]{0pt}{5.5ex} v. 0.0.9 - 14.12.2011 - MS & Benutzerstudie \\
%\hline \rule[-2ex]{0pt}{5.5ex} ... - .... & ... \\
\hline
\end{tabular}
\end{tabbing}
@ -339,6 +372,7 @@ F
\addcontentsline{toc}{section}{Literatur}
\begin{thebibliography}{------}
% \bibitem[BSS+2008]{bss+:2008} Helmut Balzert, Christian Schäfer, Marion Schröder, Uwe Kern: \emph{Wissenschaftliches Arbeiten - Wissenschaft, Quellen, Artefakte, Organisation, Präsentation}, Witten: W3L, 2008
\bibitem[DBA]{DBA} \href{http://www.datenschutzbeauftragter-info.de/fachbeitraege/google-analytics-datenschutzkonform-einsetzen/}{http://www.datenschutzbeauftragter-info.de/fachbeitraege/google-analytics-datenschutzkonform-einsetzen/}
\bibitem[ISO/IEC 9126]{ISO/IEC 9126} International Organization for Standardization \emph{ISO/IEC 9126} \\Auszug: Wikipedia, \href{http://de.wikipedia.org/wiki/ISO/IEC_9126}{http://de.wikipedia.org/wiki/ISO/IEC\_9126}

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,3 @@
*.tam
*.iml
classes

View File

@ -0,0 +1 @@
obj.tam

View File

@ -0,0 +1,17 @@
Optimierende Compiler
Aufgabe 1: Triangle
Acht-Damen-Problem
Dateien:
- AchtDamen.README
- AchtDamen.tam
- AchtDamen.tri
Autor:
Peer Rexroth
Deterministische Lösung des Acht-Damen-Problems
Eine Beschreibung des Problems befindet sich unter:
http://de.wikipedia.org/wiki/Acht-Damen-Problem

View File

@ -0,0 +1,178 @@
! Acht-Damen-Problem
! Peer Rexroth
! Deterministische Lösung des Acht-Damen-Problems
! Eine Beschreibung des Problems befindet sich unter:
! http://de.wikipedia.org/wiki/Acht-Damen-Problem
let
var position: array 8 of Integer;
var anzahl: Integer;
var topic: Boolean;
! Ausgabe des Schachfeldes. "X" stellt eine Dame dar, "-" ein leeres Feld
proc drucke() ~
let
var i: Integer;
var j: Integer
in
begin
puteol();
if (topic = true)
then
begin
put('A');
put('C');
put('H');
put('T');
put('-');
put('D');
put('A');
put('M');
put('E');
put('N');
puteol();
end
else
begin
anzahl := anzahl + 1;
put('L');
put('o');
put('e');
put('s');
put('u');
put('n');
put('g');
put(':');
put(' ');
put('N');
put('r');
put('.');
putint(anzahl);
puteol();
end;
i := 0;
while i < 8
do
begin
j := 0;
while j < position[i]
do
begin
put('-');
j := j + 1
end;
put('X');
j := position[i] + 1;
while j < 8
do
begin
put('-');
j := j + 1
end;
puteol();
i := i + 1;
end
end;
! Pruefe ob die zu setzende Dame von den bereits gesetzten Damen
! geschlagen wird
proc schlaegt(zeile: Integer, spalte: Integer, var stat: Boolean) ~
let
var i: Integer
in
begin
i := 0;
stat := false;
while ((i < zeile) /\ (stat = false))
do
begin
if ((spalte = position[i]) \/ ((spalte - zeile) = (position[i] - i)) \/ ((spalte + zeile) = (position[i] + i)))
then
begin
stat := true
end
else
begin
stat := false
end;
i := i + 1
end;
end;
! Setze die Damen
proc platziere(zeile: Integer) ~
let
var i: Integer;
var moeglich: array 8 of Boolean;
var status: Boolean
in
begin
i := 0;
while i < 8
do
begin
moeglich[i] := false;
i := i + 1
end;
i := 0;
while i < 8
do
begin
schlaegt(zeile, i, var status);
if (status = false)
then
begin
moeglich[i] := true;
end
else
begin
end;
i := i + 1
end;
i := 0;
while i < 8
do
begin
if (moeglich[i] = true)
then
begin
position[zeile] := i;
if (zeile <= 6)
then
begin
platziere(zeile + 1)
end
else
begin
drucke();
end
end
else
begin
end;
i := i + 1;
end;
end;
proc loeseDeterm() ~
let
var i: Integer
in
begin
platziere(0)
end
in
begin
topic := true;
drucke();
topic := false;
anzahl := 0;
loeseDeterm();
end

View File

@ -0,0 +1,33 @@
Autor:
Clayton Hoss
Beschreibung:
Dieses Programm implementiert den RSA-Algorithmus. Er verschlüsselt und
entschlüsselt eine Zahl mit der RSA Methode. Es werden 2 verschiendene
Exponentiationsalgorithmen verwendet. Einmal mittels schneller Exponentiation
und einer mittels einer simplen Schleife. Des weiteren werden auch 2
verschiedene gängigen Ansätze zur Entschlüsselung verwendet. Einmal den
Chinesischen Restsatz (CRT) und ein anderes mal die normale RSA Methode. Der
Entschlüsselungsexponent wird mittels Erweitertem Euclid berechnet.
Zur Änderung des Kryptoschlüssels muss man im Programm die Konstanten "p", "q"
und "e" ändern. "p" und "q" dürfen beliebige Primzahlen sein. "e" hingegen muss
teilerfremd zum Produkt von p-1 mal q-1 sein (ggt von (p-1)*(q-1) und e ist 1).
Eingaben und Ausgaben:
Nach start des Programms, kann man eine ganze Zahl eingeben. Sie sollte kleiner
als p*q sein. Als Ausgabe zeigt einem das Programm die Verschlüsselte Zahl,
sowie das Ergebnis der Entschlüsselungen, mittels der beiden implementierten
Methoden, der verschlüsselten Zahl an.
Beispieleingaben und Ausgaben:
(gilt nur für p = 13, q = 11 und e = 23)
Eingabe:
54
Ausgabe:
Encrypted Number : 98
Decrypted normally : 54
Decrypted with CRT : 54

View File

@ -0,0 +1,209 @@
! Encrypts an Integer with the RSA Algorithm. Algorithm took from
! "J. Buchmann - Einfuerung in die Kryptographie"
!
! Input: an integer Smaller than n
!
!
! Author: Clayton Hoss
! Version: very very beta
!
let
const p ~ 13; ! prime 1
const q ~ 11; ! prime 2
const e ~ 23; ! public exponent, gcd((p-1)*(q-1), e) must be 1
const n ~ p * q; ! public modulo
var d: Integer; ! private exponent: calculated with Xeuclid
! Maxint is 32k!
! n must be smaller or equal to floor(sqrt(32k)) : 181
! p times q must be smaller or equal to floor(sqrt(181)) : 13
! otherwise the fast power function (power()) will not work
proc putInput() ~
begin
put('N'); put('u'); put('m'); put('b'); put('e'); put('r');
put(' '); put('t'); put('o'); put(' '); put('e'); put('n');
put('c'); put('r'); put('y'); put('p'); put('t'); put(' ');
put('('); put(' '); put('<'); put(' '); putint(n);put(' ');
put(')'); put(' '); put(':'); put(' ');
end;
proc putEncryptMsg() ~
begin
put('E'); put('n'); put('c'); put('r'); put('y'); put('p');
put('t'); put('e'); put('d'); put(' '); put('N'); put('u');
put('m'); put('b'); put('e'); put('r'); put(' '); put(':');
put(' ');
end;
proc putDecrypt1() ~
begin
put('D'); put('e'); put('c'); put('r'); put('y'); put('p');
put('t'); put('e'); put('d'); put(' '); put('n'); put('o');
put('r'); put('m'); put('a'); put('l'); put('l'); put('y');
put(' '); put(':'); put(' ');
end;
proc putDecrypt2() ~
begin
put('D'); put('e'); put('c'); put('r'); put('y'); put('p');
put('t'); put('e'); put('d'); put(' '); put('w'); put('i');
put('t'); put('h'); put(' '); put('C'); put('R'); put('T');
put(' '); put(':'); put(' ');
end;
! base may not be bigger than 181 since base * base will produce an overflow
proc power(base: Integer, exponent: Integer, modulo: Integer, var result: Integer) ~
let
var lbase: Integer;
var lexponent: Integer;
var lresult: Integer
in begin
lbase := base // modulo;
lexponent := exponent;
lresult := 1;
while lexponent > 0 do
begin
if (1 = (lexponent // 2)) then begin
lresult := ((lresult * lbase) // modulo);
lexponent := lexponent - 1;
end
else begin
lbase := ((lbase * lbase) // modulo);
lexponent := lexponent / 2;
end
end;
result := lresult
end;
proc power2(base: Integer, exponent: Integer, modulo: Integer, var result: Integer) ~
let
var i: Integer
in begin
result := 1;
i := 0;
while i < exponent do
begin
result := (result * base) // modulo;
i:= i + 1;
end;
end;
proc Xgcd(pa: Integer, pb: Integer, var gcd: Integer, var x:Integer, var y:Integer) ~
let
var a:Integer;
var b:Integer;
var q: Integer;
var r:Integer;
var xx: Integer;
var yy: Integer;
var sign: Integer;
var xs: array 2 of Integer;
var ys: array 2 of Integer
in begin
a := pa;
b := pb;
xs[0] := 1; xs[1] := 0;
ys[0] := 0; ys[1] := 1;
sign := 1;
while b \= 0 do
begin
r := a // b;
q := a / b;
a := b;
b := r;
xx := xs[1];
yy := ys[1];
xs[1] := q * xs[1] + xs[0];
ys[1] := q * ys[1] + ys[0];
xs[0] := xx;
ys[0] := yy;
sign := sign * (0 - 1);
end;
x := sign * xs[0];
y := (0 - sign) * ys[0];
gcd := a;
end;
proc encrypt(m: Integer, var c: Integer) ~
begin
power(m, e, n, var c);
end;
proc decrypt(c: Integer, var m: Integer) ~
begin
power2(c, d, n, var m);
end;
proc decryptWithCRT(c: Integer, var m: Integer) ~
let
var mp: Integer;
var mq: Integer;
var tempd: Integer;
var gcd: Integer;
var yp: Integer;
var yq: Integer
in begin
tempd := (d // (p-1));
power2(c, d, p, var mp);
tempd := (d // (q-1));
power(c, d, q, var mq);
Xgcd(p, q, var gcd, var yp, var yq);
m := ((mp * yq * q) + (mq * yp * p)) // n;
if m < 0 then begin
m := n + m;
end
else begin end;
end;
proc setDecryptionExponentViaXEuclid() ~
let
var gcd:Integer;
var x: Integer;
var y: Integer
in begin
Xgcd((p-1)*(q-1), e, var gcd, var x, var y);
if y < 0 then begin
y := (p-1)*(q-1) + y;
end
else begin end;
d := y;
end;
var i: Integer; ! Message Text
var k: Integer ! Encrypted Text
in begin
setDecryptionExponentViaXEuclid();
putInput();
getint(var i);
encrypt(i, var k);
putEncryptMsg();
putint(k);
puteol();
decrypt(k, var i);
putDecrypt1();
putint(i);
puteol();
decryptWithCRT(k, var i);
putDecrypt2();
putint(i);
puteol();
end

View File

@ -0,0 +1,65 @@
Optimierende Compiler
Aufgabe 1: Triangle
Roboter-Programm
Dateien:
- Robot.README
- Robot.tam
- Robot.tri
- RobotRun.tam
- RobotRun.tri
Autor:
Benjamin Schiller
Es handelt sich hierbei um eine kleine Simulation eines Roboters, der sich in einer kleinen Welt, begrenzt durch Wnde / Hindernisse bewegt.
Er kann Hütchen platzieren und aufsammeln.
Die Idee bzw. das Prinzip stammt aus dem Grundstudium, wo wir einen Interpreter für KarelJRobot geschrieben haben, der die genannten Eigenschaften hatte.
Damit das ganze nicht zu komplex wurde, sind einige Dinge stark vereinfacht:
- An einer Stelle kann immer nur ein Hütchen stehen, weitere können aber darauf platziert werden.
- Der Roboter kann beliebig viele Hütchen aufstellen und auch aufsammeln.
- Die "globalen" Befehle überschreiben bereits vorhandenes, also Hütchen oder Wände
Die "Welt"
x - Wand / Hinderniss
o - Hütchen
R - Roboter
B - Roboter, der auf einem Feld mit Hütchen steht
ACHTUNG:
Damit das Programm korrekt läuft, müssen in der Datei TAM.machine folgende Änderungen vorgenommen werden:
TAM.Machine
- Zeile 59: new Instruction[1024] -> new Instruction[2048]
- Zeile 66: PB = 1024, -> PB = 2048,
- Zeile 67: PT = 1052; -> PT = 2076;
Diese Änderungen erhöhen die Anzahl der maximal möglichen Befehle in der Triangle-Datei und sollten allgemein verwendet werden können (also für alle Programm zu empfehlen).
Leider war aufgrund der vielen Status-Meldungen und Test-Läufe (in RobotRun.) eine hohe Anzahl an Befehlen nicht zu vermeiden.
In Robot.tri und Robot.tam befindet sich das eigendliche Programm. Hier kann der Benutzer einige Befehle ausführen, um die Welt zu verändern und den Roboter zu steuern.
Diese sind im folgenden erläutert:
# i beenden
# Roboter-Befehle
# w: nach Norden bewegen
# s: nach Süden bewegen
# a: nach Westen bewegen
# d: nach Osten bewegen
# q: Hütchen aufnehmen
# e: Hütchen setzen
# globale Befehle
# m: Wand / Hinernis setzen
# n: Hütchen setzen
Die Größe der Welt muss zwischen 3 und 16 liegen (inklusive).
Je nach Konsole / Betriebssystem haben sich in den Tests die Eingaben von der Konsole als problematisch erwiesen.
Daher muss man manchmal ENTER drücken, bis man "Command:" sieht, dann kann man den Befehl eingeben.
In RobotRun.tri und RobotRun.tam befindet sich eine abgeänderte Version des Programms, in der keine Eingaben des Benutzers notwendig sind.
Es werden einfach einige Beispiel-Aktionen durchgeführt, um ein selbstständig durchlaufendes Programm zu erhalten.
In der Variable session kann zwischen den Beispieln umgeschaltet werden.
Ein- und Ausgaben
Die Eingaben von Robot. wurden oben bereits beschrieben.
Bei RobotRun. sind keine Eingaben möglich / nötig. Natürlich kann in RobotRun.tri ein weiteres Beispiel eingefügt werden.
Die Ausgabe beider Programm besteht aus Status-Meldungen, welche Aktion durchgeführt wurde, evtl. Fehlermeldungen, wenn man z.B. versucht, den Roboter durch eine Wand zu steuern und der Ausgabe der Welt, die oben beschrieben wurde.

View File

@ -0,0 +1,386 @@
!Folgende Änderung sind notwendig, damit das Programm läuft
!(maximale Anzahl der Operationen)
!TAM.Machine
!Zeile 59: new Instruction[1024] -> new Instruction[2048]
!Zeile 66: PB = 1024, -> PB = 2048,
!Zeile 67: PT = 1052; -> PT = 2076;
!Roboter-Simulation
!in dem Programm wird ein Roboter simuliert, der Hütchen aufstellen und wegnehmen kann
!Wände / Hindernisse werden durch x markiert und können nicht überlaufen werden
!Ein Hütchen wird durch o markiert
!Der Roboter wird durch R markiert
!Steht der Roboter auf einem Hütchen, wird das mit B markiert
!Befehle:
!i beenden
!Roboter-Befehle
! w: nach Norden bewegen
! s: nach Süden bewegen
! a: nach Westen bewegen
! d: nach Osten bewegen
! q: Hütchen aufnehmen
! e: Hütchen setzen
!globale Befehle
! m: Wand / Hinernis setzen
! n: Hütchen setzen
!Die globalen Befehle sind überschreibend, d.h. dass man eine Wand mit einem Hütchen überschreiben kann etc.
!Die Außenbegrenzung bzw. -wand kann nicht überschrieben werden.
!Es kann immer nur ein Hütchen auf einer Stelle sein, doppeltes Belegen wird aber nicht als Fehler ausgegeben.
!Der Roboter kann unendlich viele Hütchen setzen und aufnehmen.
!Der Befehl kann eingegeben werden, wenn man Command: sieht.
!Sollte man dies nicht sehen, einfach ENTER drücken, bis es kommt
!(hängt wohl der der Konsole / Betribssystem ab)
let
!Deklaration der Variable errorOccurred
var errorOccurred : Boolean;
!Gibt den Fehler mit der Kennung x aus
proc printError (x : Integer) ~
begin
if (x = 0) !World too small
then begin
put('W'); put('o'); put('r'); put('l'); put('d'); put(' ');
put('t'); put('o'); put('o'); put(' ');
put('s'); put('m'); put('a'); put('l'); put('l');
end
else if (x = 1) !World too big
then begin
put('W'); put('o'); put('r'); put('l'); put('d'); put(' ');
put('t'); put('o'); put('o'); put(' ');
put('b'); put('i'); put('g');
end
else if (x = 2) !Koord. out of World
then begin
put('K'); put('o'); put('o'); put('r'); put('d'); put(' ');
put('o'); put('u'); put('t'); put(' ');
put('o'); put('f'); put(' ');
put('W'); put('o'); put('r'); put('l'); put('d');
end
else if (x = 3) !Koord. in Wall
then begin
put('K'); put('o'); put('o'); put('r'); put('d'); put(' ');
put('i'); put('n'); put(' ');
put('W'); put('a'); put('l'); put('l');
end
else if (x = 4) !Error(s) occurred EXITING!!
then begin
put('E'); put('r'); put('r'); put('o'); put('r'); put(' ');
put('o'); put('c'); put('c'); put('u'); put('r'); put('r'); put('e'); put('d'); put(' ');
put('E'); put('X'); put('I'); put('T'); put('I'); put('N'); put('G');
end
else if (x = 5) !Wrong Direction
then begin
put('W'); put('r'); put('o'); put('n'); put('g'); put(' ');
put('D'); put('i'); put('r'); put('e'); put('c'); put('t'); put('i'); put('o'); put('n');
end
else if (x = 6) !Unknown Command
then begin
put('U'); put('n'); put('k'); put('n'); put('o'); put('w'); put('n'); put(' ');
put('C'); put('o'); put('m'); put('m'); put('a'); put('n'); put('d');
end
else if (x = 7) !No Cone at curr. Pos.
then begin
put('N'); put('o'); put(' ');
put('C'); put('o'); put('n'); put('e'); put(' ');
put('a'); put('t'); put(' ');
put('c'); put('u'); put('r'); put('r'); put(' ');
put('P'); put('o'); put('s');
end
else
begin
end;
put('!');
puteol();
errorOccurred := true;
end;
!Deklaration des Typs World
type Row ~ record
y : array 16 of Char,
length : Integer
end;
type World ~ record
x : array 16 of Row,
length : Integer
end;
!Deklaration des Typs Robot
type Robot ~ record
cones : Integer,
x : Integer,
y : Integer
end;
!Deklaration der benötigten Variablen
var size : Integer;
var world : World;
var robot : Robot;
var befehl : Char;
var counter : Integer;
var inX : Integer;
var inY : Integer;
!Initialisierung der Welt
!Am Rand werden Mauern / Hindernisse gesetzt
proc initWorld () ~
let
var x : Integer;
var y : Integer
in begin
x := 0;
while (x < size) do
begin
y := 0;
while (y < size) do
begin
if((x = (size - 1)) \/ (x = 0) \/ (y = (size - 1)) \/ (y = 0))
then
world.x[x].y[y] := 'x'
else
world.x[x].y[y] := ' ';
y := y + 1;
end;
x := x + 1;
end;
end;
!Initialisierung des Roboters
!Die Position des Roboters wird mit 1/1 initialisiert
proc initRobot () ~
begin
robot.cones := 0;
robot.x := 1;
robot.y := 1;
end;
!Ausgabe der Welt
!Roboter: R
!Wand / Hinderniss: x
!Hütchen: o
!Roboter + Hütchen: B
proc printWorld () ~
let
var x : Integer;
var y : Integer
in begin
x := 0;
while(x < size) do
begin
y := 0;
while(y < size) do
begin
if ((robot.x = x) /\ (robot.y = y))
then
if (world.x[x].y[y] = 'o')
then
put('B')
else
put('R')
else
put(world.x[x].y[y]);
put(' ');
y := y + 1;
end;
puteol();
x := x + 1;
end;
puteol();
end;
!Setze ein Hütchen
proc putCone (x : Integer, y : Integer) ~
begin
if((x >= size) \/ (x <= 0) \/ (y >= size) \/ (y <= 0))
then
printError(2)
else
if(world.x[x].y[y] = 'x')
then
printError(3)
else
world.x[x].y[y] := 'o';
end;
!Setze Wand / Hinderniss
proc putWall (x : Integer, y : Integer) ~
begin
if((x >= (size - 1)) \/ (x <= 0) \/ (y >= (size - 1)) \/ (y <= 0))
then
printError(2)
else
world.x[x].y[y] := 'x';
end;
!Roboter setzt ein Hütchen an seiner Position
proc putConeRobot () ~
begin
world.x[robot.x].y[robot.y] := 'o';
! put('R'); put('o'); put('b'); put('o'); put('t'); put(':'); put(' ');
put('S'); put('e'); put('t'); put(' '); put('C');
put('o'); put('n'); put('e'); put(' ');
put('a');put('t');put(' ');putint(robot.x);put('/');putint(robot.y);puteol();
end;
!Roboter nimmt ein Hütchen an seiner Position auf
proc pickUpCone () ~
begin
if(world.x[robot.x].y[robot.y] = 'o')
then
begin
world.x[robot.x].y[robot.y] := ' ';
! put('R');put('o');put('b');put('o');put('t');put(':');put(' ');
put('P');put('i');put('c');put('k');put(' ');put('u');put('p');put(' ');put('C');put('o');put('n');put('e');put(' ');
put('a');put('t');put(' ');putint(robot.x);put('/');putint(robot.y);puteol();
end
else
printError(7);
end;
!Bewege Roboter
proc moveRobot (c : Char) ~
let
var newX : Integer;
var newY : Integer
in begin
newX := robot.x;
newY := robot.y;
if (c = 'w')
then
newX := newX - 1
else if (c = 's')
then
newX := newX + 1
else if (c = 'a')
then
newY := newY - 1
else if (c = 'd')
then
newY := newY + 1
else
begin
printError(5)
end;
if(world.x[newX].y[newY] = 'x')
then
printError(3)
else
begin
robot.x := newX;
robot.y := newY;
! put('R');put('o');put('b');put('o');put('t');put(':');put(' ');
put('M'); put('o'); put('v'); put('e'); put(':'); put(' '); put(c);
put(' ');put('t');put('o');put(' ');putint(robot.x);put('/'); putint(robot.y); puteol()
end;
end
in begin
errorOccurred := false;
put('W'); put('o'); put('r'); put('l'); put('d'); put('-'); put('S'); put('i'); put('z'); put('e'); put(':'); put(' ');
getint(var size);
puteol();
if(size <= 2)
then
printError(0)
else if(size > 16)
then
printError(1)
else
begin
initWorld();
initRobot();
printWorld()
end;
if(errorOccurred)
then
printError(4)
else
begin
befehl := ' ';
counter := 0;
while(befehl \= 'i') do
begin
if (counter = 1)
then begin
put('C'); put('o'); put('m'); put('m'); put('a'); put('n'); put('d'); put(':'); put(' ');
end
else begin end;
get(var befehl);
if (counter = 1)
then
begin
puteol(); puteol(); puteol();
put('B'); put('e'); put('f'); put('e'); put('h'); put('l'); put(':'); put(' '); put('"');
put(befehl); put('"');
puteol();
if ((befehl = 'w') \/ (befehl = 'a') \/ (befehl = 's') \/ (befehl = 'd')) !R: bewegen
then
begin
moveRobot(befehl);
printWorld();
end
else if (befehl = 'q') !R: aufnehmen
then
begin
pickUpCone();
printWorld();
end
else if (befehl = 'e') !R: setzen
then
begin
putConeRobot();
printWorld();
end
else if (befehl = 'n') !hütchen setzen
then
begin
put('C'); put('o'); put('n'); put('e'); put(' '); put('X'); put(':'); put(' ');
getint(var inX);
put('C'); put('o'); put('n'); put('e'); put(' '); put('Y'); put(':'); put(' ');
getint(var inY);
putCone(inX, inY);
printWorld();
end
else if (befehl = 'm') !wand setzen
then
begin
put('W'); put('a'); put('l'); put('l'); put(' '); put('X'); put(':'); put(' ');
getint(var inX);
put('W'); put('a'); put('l'); put('l'); put(' '); put('Y'); put(':'); put(' ');
getint(var inY);
putWall(inX, inY);
printWorld();
end
else if (befehl = 'i')
then
begin
put('T'); put('s'); put('c'); put('h'); put('u'); put('e'); put('s'); put('s');
put('.'); put('.'); put('.'); put('.');
puteol();
end
else
begin
printError(6);
end;
end
else
begin
end;
counter := (counter + 1) // 2;
end;
end;
end

View File

@ -0,0 +1,626 @@
!Folgende Änderung sind notwendig, damit das Programm läuft
!(maximale Anzahl der Operationen)
!TAM.Machine
!Zeile 59: new Instruction[1024] -> new Instruction[2048]
!Zeile 66: PB = 1024, -> PB = 2048,
!Zeile 67: PT = 1052; -> PT = 2076;
!Roboter-Simulation
!in dem Programm wird ein Roboter simuliert, der Hütchen aufstellen und wegnehmen kann
!Wände / Hindernisse werden durch x markiert und können nicht überlaufen werden
!Ein Hütchen wird durch o markiert
!Der Roboter wird durch R markiert
!Steht der Roboter auf einem Hütchen, wird das mit B markiert
!Dieser Teil dient nur als Beispiel, dass ohne Benutzereingaben "durchläuft".
!weiter unten kann "session" auf einen anderen Wert gestellt werden, um so ein anderes Beispiel zu betrachten.
let
!Deklaration der Variable errorOccurred
var errorOccurred : Boolean;
!Gibt den Fehler mit der Kennung x aus
proc printError (x : Integer) ~
begin
if (x = 0) !World too small
then begin
put('W'); put('o'); put('r'); put('l'); put('d'); put(' ');
put('t'); put('o'); put('o'); put(' ');
put('s'); put('m'); put('a'); put('l'); put('l');
end
else if (x = 1) !World too big
then begin
put('W'); put('o'); put('r'); put('l'); put('d'); put(' ');
put('t'); put('o'); put('o'); put(' ');
put('b'); put('i'); put('g');
end
else if (x = 2) !Koord. out of World
then begin
put('K'); put('o'); put('o'); put('r'); put('d'); put(' ');
put('o'); put('u'); put('t'); put(' ');
put('o'); put('f'); put(' ');
put('W'); put('o'); put('r'); put('l'); put('d');
end
else if (x = 3) !Koord. in Wall
then begin
put('K'); put('o'); put('o'); put('r'); put('d'); put(' ');
put('i'); put('n'); put(' ');
put('W'); put('a'); put('l'); put('l');
end
else if (x = 4) !Error(s) occurred EXITING!!
then begin
put('E'); put('r'); put('r'); put('o'); put('r'); put(' ');
put('o'); put('c'); put('c'); put('u'); put('r'); put('r'); put('e'); put('d'); put(' ');
put('E'); put('X'); put('I'); put('T'); put('I'); put('N'); put('G');
end
else if (x = 5) !Wrong Direction
then begin
put('W'); put('r'); put('o'); put('n'); put('g'); put(' ');
put('D'); put('i'); put('r'); put('e'); put('c'); put('t'); put('i'); put('o'); put('n');
end
else if (x = 6) !Unknown Command
then begin
put('U'); put('n'); put('k'); put('n'); put('o'); put('w'); put('n'); put(' ');
put('C'); put('o'); put('m'); put('m'); put('a'); put('n'); put('d');
end
else if (x = 7) !No Cone at curr. Pos.
then begin
put('N'); put('o'); put(' ');
put('C'); put('o'); put('n'); put('e'); put(' ');
put('a'); put('t'); put(' ');
put('c'); put('u'); put('r'); put('r'); put(' ');
put('P'); put('o'); put('s');
end
else
begin
end;
put('!');
puteol();
errorOccurred := true;
end;
!Deklaration des Typs World
type Row ~ record
y : array 16 of Char,
length : Integer
end;
type World ~ record
x : array 16 of Row,
length : Integer
end;
!Deklaration des Typs Robot
type Robot ~ record
cones : Integer,
x : Integer,
y : Integer
end;
!Deklaration der benötigten Variablen
var size : Integer;
var world : World;
var robot : Robot;
var befehl : Char;
var counter : Integer;
var inX : Integer;
var inY : Integer;
var session : Integer;
!Initialisierung der Welt
!Am Rand werden Mauern / Hindernisse gesetzt
proc initWorld () ~
let
var x : Integer;
var y : Integer
in begin
x := 0;
while (x < size) do
begin
y := 0;
while (y < size) do
begin
if((x = (size - 1)) \/ (x = 0) \/ (y = (size - 1)) \/ (y = 0))
then
world.x[x].y[y] := 'x'
else
world.x[x].y[y] := ' ';
y := y + 1;
end;
x := x + 1;
end;
end;
!Initialisierung des Roboters
!Die Position des Roboters wird mit 1/1 initialisiert
proc initRobot () ~
begin
robot.cones := 0;
robot.x := 1;
robot.y := 1;
end;
!Ausgabe der Welt
!Roboter: R
!Wand / Hinderniss: x
!Hütchen: o
!Roboter + Hütchen: B
proc printWorld () ~
let
var x : Integer;
var y : Integer
in begin
x := 0;
while(x < size) do
begin
y := 0;
while(y < size) do
begin
if ((robot.x = x) /\ (robot.y = y))
then
if (world.x[x].y[y] = 'o')
then
put('B')
else
put('R')
else
put(world.x[x].y[y]);
put(' ');
y := y + 1;
end;
puteol();
x := x + 1;
end;
puteol();
end;
!Setze ein Hütchen
proc putCone (x : Integer, y : Integer) ~
begin
if((x >= size) \/ (x <= 0) \/ (y >= size) \/ (y <= 0))
then
printError(2)
else
if(world.x[x].y[y] = 'x')
then
printError(3)
else
world.x[x].y[y] := 'o';
end;
!Setze Wand / Hinderniss
proc putWall (x : Integer, y : Integer) ~
begin
if((x >= (size - 1)) \/ (x <= 0) \/ (y >= (size - 1)) \/ (y <= 0))
then
printError(2)
else
world.x[x].y[y] := 'x';
end;
!Roboter setzt ein Hütchen an seiner Position
proc putConeRobot () ~
begin
world.x[robot.x].y[robot.y] := 'o';
! put('R'); put('o'); put('b'); put('o'); put('t'); put(':'); put(' ');
put('S'); put('e'); put('t'); put(' '); put('C');
put('o'); put('n'); put('e'); put(' ');
put('a');put('t');put(' ');putint(robot.x);put('/');putint(robot.y);puteol();
end;
!Roboter nimmt ein Hütchen an seiner Position auf
proc pickUpCone () ~
begin
if(world.x[robot.x].y[robot.y] = 'o')
then
begin
world.x[robot.x].y[robot.y] := ' ';
! put('R');put('o');put('b');put('o');put('t');put(':');put(' ');
put('P');put('i');put('c');put('k');put(' ');put('u');put('p');put(' ');put('C');put('o');put('n');put('e');put(' ');
put('a');put('t');put(' ');putint(robot.x);put('/');putint(robot.y);puteol();
end
else
printError(7);
end;
!Bewege Roboter
proc moveRobot (c : Char) ~
let
var newX : Integer;
var newY : Integer
in begin
newX := robot.x;
newY := robot.y;
if (c = 'w')
then
newX := newX - 1
else if (c = 's')
then
newX := newX + 1
else if (c = 'a')
then
newY := newY - 1
else if (c = 'd')
then
newY := newY + 1
else
begin
printError(5)
end;
if(world.x[newX].y[newY] = 'x')
then
printError(3)
else
begin
robot.x := newX;
robot.y := newY;
! put('R');put('o');put('b');put('o');put('t');put(':');put(' ');
put('M'); put('o'); put('v'); put('e'); put(':'); put(' '); put(c);
put(' ');put('t');put('o');put(' ');putint(robot.x);put('/'); putint(robot.y); puteol()
end;
end
in begin
session := 1; !bisher belegte Beispiel sind session = 0 und session = 1
if (session = 0)
then begin
!Beispiel-Simulation 1
put('B'); put('s'); put('p'); put('.'); put('1'); puteol(); puteol();
size := 16;
initWorld();
initRobot();
printWorld();
putWall(2,2);
printWorld();
putWall(3,3);
printWorld();
putWall(4,4);
printWorld();
putWall(5,5);
printWorld();
putWall(6,6);
printWorld();
putWall(7,7);
printWorld();
putWall(8,8);
printWorld();
putWall(9,9);
printWorld();
putWall(10,10);
printWorld();
putWall(11,11);
printWorld();
putWall(12,12);
printWorld();
putWall(13,13);
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('a');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
end
else if (session = 1)
then begin
!Beispiel-Simulation 2
put('B'); put('s'); put('p'); put('.'); put('2'); puteol(); puteol();
size := 10;
initWorld();
initRobot();
printWorld();
putWall(2,2);
printWorld();
putWall(2,3);
printWorld();
putWall(3,3);
printWorld();
putWall(4,3);
printWorld();
putWall(4,4);
printWorld();
putConeRobot();
printWorld();
moveRobot('d');
printWorld();
putConeRobot();
printWorld();
moveRobot('d');
printWorld();
putConeRobot();
printWorld();
moveRobot('d');
printWorld();
putConeRobot();
printWorld();
moveRobot('s');
printWorld();
putConeRobot();
printWorld();
moveRobot('s');
printWorld();
putConeRobot();
printWorld();
moveRobot('d');
printWorld();
putConeRobot();
printWorld();
moveRobot('s');
printWorld();
putConeRobot();
printWorld();
moveRobot('s');
printWorld();
putConeRobot();
printWorld();
moveRobot('a');
printWorld();
putConeRobot();
printWorld();
moveRobot('a');
printWorld();
putConeRobot();
printWorld();
moveRobot('a');
printWorld();
putConeRobot();
printWorld();
moveRobot('w');
printWorld();
putConeRobot();
printWorld();
moveRobot('w');
printWorld();
putConeRobot();
printWorld();
moveRobot('a');
printWorld();
putConeRobot();
printWorld();
moveRobot('w');
printWorld();
putConeRobot();
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
putConeRobot();
printWorld();
moveRobot('w');
printWorld();
moveRobot('w');
printWorld();
moveRobot('w');
printWorld();
moveRobot('a');
printWorld();
moveRobot('a');
printWorld();
moveRobot('a');
printWorld();
pickUpCone();
printWorld();
moveRobot('a');
printWorld();
pickUpCone();
printWorld();
moveRobot('a');
printWorld();
pickUpCone();
printWorld();
moveRobot('a');
printWorld();
pickUpCone();
printWorld();
moveRobot('a');
printWorld();
moveRobot('w');
printWorld();
moveRobot('w');
printWorld();
pickUpCone();
printWorld();
moveRobot('w');
printWorld();
pickUpCone();
printWorld();
moveRobot('w');
printWorld();
pickUpCone();
printWorld();
moveRobot('d');
printWorld();
pickUpCone();
printWorld();
moveRobot('d');
printWorld();
pickUpCone();
printWorld();
moveRobot('d');
printWorld();
pickUpCone();
printWorld();
moveRobot('d');
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
pickUpCone();
printWorld();
moveRobot('s');
printWorld();
pickUpCone();
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('s');
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
moveRobot('d');
printWorld();
pickUpCone();
printWorld();
end
else if(session = 2)
then begin
!Beispiel-Simulation 3
put('B'); put('s'); put('p'); put('.'); put('3'); puteol(); puteol();
size := 16;
initWorld();
initRobot();
printWorld();
end
else begin
!Beispiel-Simulation 4
put('B'); put('s'); put('p'); put('.'); put('4'); puteol(); puteol();
size := 16;
initWorld();
initRobot();
printWorld();
end;
end

View File

@ -0,0 +1,38 @@
Autor:
Benjamin Otto
Funktion:
Das Programm löst das Diskrete Logarithmus Problem g^x=a mod n
mittels Shank's Baby-Step-Giant-Step Algorithmus
Hilfsfunktion für Wurzel ziehen und erweiterten Euklid für Inversion inklusive
Bedienung:
Nach Start gibt man die Gruppenordnung n, die Basis g und das gewünschte Ergebnis a mod n ein. Das Programm berechnet nun x.
Falls es kein solches x gibt(kann passieren, wenn g keine Primitivwurzel ist) gibt das Programm -1 als Ergebnis an.
Beispiele
Gruppenordnung : 14
g : 3
a : 5
Loesung : 5
also 3^5=5 mod 14
Gruppenordnung : 181
g : 179
a : 2
Loesung : 91
also 179^91 = 2 mod 181
Gruppenordnung : 9
g : 3
a : 4
Loesung : -1
nicht lösbar (3 ist teiler von 9)

View File

@ -0,0 +1,193 @@
!
! Gruppe:
! Jan Sinschek
! Benjamin Otto
! Anselm Foehr
!
!
! Autor: Benjamin Otto
!
! Programm zur Loesung des Diskreten Logarithmus-Problems g^x = a mod n
! mittels Shanks BabyStep-Giantstep-Verfahren.
! Funktioniert für Körper bis Ordnung 181, sonst Integer-Overflow
!
! Eingabe: Gruppenordnung n, Basis g, Potenz a
!
let
! Berechnet das Inverse von g modulo n mittels Euklid und gibts in x zurück
proc invertmodulo(g : Integer, n : Integer, var x: Integer) ~
let
var a : Integer;
var b : Integer;
var x0 : Integer;
var x1 : Integer;
var y0 : Integer;
var y1 : Integer;
var xx : Integer;
var yy : Integer;
var q : Integer;
var r : Integer;
var sign : Integer
in begin
!Parameter übergeben
a := g;
b := n;
! Extended Euklid
x0 := 1; x1 := 0;
y0 := 0; y1 := 1;
sign := 1;
while b \= 0 do begin
r := a // b;
q := a / b;
a := b;
b := r;
xx := x1;
yy := y1;
x1 := q * x1 + x0;
y1 := q * y1 + y0;
x0 := xx;
y0 := yy;
sign := 0 - sign
end;
if (x0 * g) // n = 1 then
! x0 ist das gesuchte inverse
x := x0
else begin
x := n - x0;
end
end;
! Hilfsfunktion zum Wurzelziehen; zieht wurzel und rundet auf (ziemlich primitiv:))
proc sqrtroundup(n : Integer, var x : Integer) ~
begin
x := 0;
while x * x < n do x:= x + 1
end;
! Hilfsfunktion zum potenzieren in endlichen Körpern
proc potmodulo(base :Integer, exp : Integer, n : Integer, var x : Integer) ~
let
var i : Integer !countervariable
in begin
i := 1;
x := 1;
while i <= exp do begin
x := x * base;
x := x // n;
i := i + 1
end
end;
proc babystepgiantstep(n : Integer, g : Integer, a : Integer, var x : Integer) ~
let
var babysteps : array 100 of Integer; ! Speicherplatz für bis zu hundert Babysteps
var m : Integer;
var ginvert : Integer;
var atemp : Integer; !Babysteps-Dummy
var d : Integer; !Giantstep-Basis
var dtemp : Integer; !Giantsteps-Dummy
var r : Integer; !BabyStepzähler
var q : Integer; !GiantStep-Zähler
var foundtrivial : Boolean; ! flag, ob eine direkte lösung in den babysteps gefunden wurde
var found : Boolean ! flag, ob eine Lösung in den Giantsteps gefunden wurde
in begin
! m berechnen
sqrtroundup(n, var m);
! g^-1 mod n berechnen
invertmodulo(g, n, var ginvert);
!Zunächst die Babysteps berechnen
r := 0;
atemp := a;
foundtrivial := false;
while (r < m) /\ \foundtrivial /\ \found do begin
!r-ten babystep speichern
babysteps [r] := atemp;
!sonderfall babystep == 1 checken
if atemp = 1 then begin
foundtrivial := true; !flag setzen
x := r; ! lösung ist in diesem Fall r
end
else begin end;
!naechsten BS berechnen
atemp := (atemp * ginvert) // n;
!weiterzaehlen
r := r + 1
end;
!Jetzt die GiantSteps durchgehen falls noch nicht gefunden
q := 1;
potmodulo(g, m, n, var d);
dtemp := d;
if \foundtrivial then begin
while \ found do begin
! die Babysteps nach einem Match mit aktuellem d durchsuchen
r := 0;
found := false;
while r < m /\ \found do begin
if dtemp = babysteps[r] then begin
found := true;
x := q * m + r;
end
else begin end;
r := r + 1
end;
dtemp:= (dtemp * d) // n;
!Test ob keine Lösung da
if q > (2 * m) then begin
found := true;
x := 0 - 1;
end
else begin end;
q := q + 1
end
end
else begin end;
end;
var n : Integer;
var g : Integer;
var a : Integer;
var solution : Integer
in begin ! Hauptprogramm
put('G');put('r');put('u');put('p');put('p');put('e');put('n');put('o');put('r');
put('d');put('n');put('u');put('n');put('g');put(' ');put(':');put(' ');
getint(var n);
put('g');put(' ');put(':');put(' ');
getint(var g);
put('a');put(' ');put(':');put(' ');
getint(var a);
!BSGS ausführen
babystepgiantstep(n, g, a, var solution);
!Ausgabe des Ergebnisses
put('L');put('o');put('e');put('s');put('u');put('n');put('g');put(' ');put(':');put(' ');
putint(solution)
end

View File

@ -0,0 +1,442 @@
Optimierende Compiler
Aufgabe 1: Triangle
Backtracking-L<>ung eines Solitaire-Spieles
Dateien:
- backtracking_solitaire.README
- backtracking_solitaire.tam
- backtracking_solitaire.tri
Autor:
Joachim Fritschi
Funktion:
In diesem Programm wird ein Solit舐-Spiel mittels eines Backtracking-Algorithmus gel<65>t und die L<>ung f<> den Benutzer grafisch ausgegeben.
N臧eres zum Spiel selber gibt es z.B. auf der Seite: http://de.wikipedia.org/wiki/Solit%C3%A4r_%28Brettspiel%29
Bedienung:
Einfach ohne Parameter aufrufen.
Ausgabe:
********** TAM Interpreter (Java Version 2.1) **********
XXXXXXXXXXX
XXXXXXXXXXX
XXXXOOOXXXX
XXXXOOOXXXX
XXOOOOOOOXX
XXOOO OOOXX
XXOOOOOOOXX
XXXXOOOXXXX
XXXXOOOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
1 [3,5] EAST
XXXXXXXXXXX
XXXXXXXXXXX
XXXXOOOXXXX
XXXXOOOXXXX
XXOOOOOOOXX
XXO OOOOXX
XXOOOOOOOXX
XXXXOOOXXXX
XXXXOOOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
2 [4,3] NORTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXXOOOXXXX
XXXXOOOXXXX
XXOOOOOOOXX
XXO OOOOOXX
XXOO OOOOXX
XXXX OOXXXX
XXXXOOOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
3 [2,4] EAST
XXXXXXXXXXX
XXXXXXXXXXX
XXXXOOOXXXX
XXXXOOOXXXX
XXOOOOOOOXX
XXO OOOOOXX
XX OOOOOXX
XXXX OOXXXX
XXXXOOOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
4 [2,6] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXXOOOXXXX
XXXXOOOXXXX
XX OOOOOOXX
XX OOOOOXX
XXO OOOOOXX
XXXX OOXXXX
XXXXOOOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
5 [4,5] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXXOOOXXXX
XXXXOOOXXXX
XX OOOOOOXX
XX OOOOXX
XXO OOOOXX
XXXXOOOXXXX
XXXXOOOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
6 [4,2] NORTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXXOOOXXXX
XXXXOOOXXXX
XX OOOOOOXX
XX OOOOXX
XXO OOOOOXX
XXXX OOXXXX
XXXX OOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
7 [4,6] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXXOOOXXXX
XXXXOOOXXXX
XXO OOOOXX
XX OOOOXX
XXO OOOOOXX
XXXX OOXXXX
XXXX OOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
8 [4,8] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OOXXXX
XXXX OOXXXX
XXO OOOOOXX
XX OOOOXX
XXO OOOOOXX
XXXX OOXXXX
XXXX OOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
9 [5,4] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OOXXXX
XXXX OOXXXX
XXO OOOOOXX
XX OOOOXX
XXOO OOOXX
XXXX OOXXXX
XXXX OOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
10 [2,4] EAST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OOXXXX
XXXX OOXXXX
XXO OOOOOXX
XX OOOOXX
XX O OOOXX
XXXX OOXXXX
XXXX OOXXXX
XXXXXXXXXXX
XXXXXXXXXXX
11 [5,2] NORTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OOXXXX
XXXX OOXXXX
XXO OOOOOXX
XX OOOOXX
XX OOOOOXX
XXXX OXXXX
XXXX OXXXX
XXXXXXXXXXX
XXXXXXXXXXX
12 [5,4] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OOXXXX
XXXX OOXXXX
XXO OOOOOXX
XX OOOOXX
XX O OOOXX
XXXX OXXXX
XXXX OXXXX
XXXXXXXXXXX
XXXXXXXXXXX
13 [5,6] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OOXXXX
XXXX OOXXXX
XXO O OOOXX
XX OOOXX
XX O OOOOXX
XXXX OXXXX
XXXX OXXXX
XXXXXXXXXXX
XXXXXXXXXXX
14 [5,8] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OXXXX
XXXX OXXXX
XXO OOOOOXX
XX OOOXX
XX O OOOOXX
XXXX OXXXX
XXXX OXXXX
XXXXXXXXXXX
XXXXXXXXXXX
15 [5,6] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OXXXX
XXXX OXXXX
XXOO OOOXX
XX OOOXX
XX O OOOOXX
XXXX OXXXX
XXXX OXXXX
XXXXXXXXXXX
XXXXXXXXXXX
16 [2,6] EAST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OXXXX
XXXX OXXXX
XX O OOOXX
XX OOOXX
XX O OOOOXX
XXXX OXXXX
XXXX OXXXX
XXXXXXXXXXX
XXXXXXXXXXX
17 [6,4] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OXXXX
XXXX OXXXX
XX O OOOXX
XX OOOXX
XX OO OOXX
XXXX OXXXX
XXXX OXXXX
XXXXXXXXXXX
XXXXXXXXXXX
18 [3,4] EAST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OXXXX
XXXX OXXXX
XX O OOOXX
XX OOOXX
XX O OOXX
XXXX OXXXX
XXXX OXXXX
XXXXXXXXXXX
XXXXXXXXXXX
19 [6,2] NORTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OXXXX
XXXX OXXXX
XX O OOOXX
XX OOOXX
XX OOOOXX
XXXX XXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
20 [6,5] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OXXXX
XXXX OXXXX
XX O OOOXX
XX OOXX
XX O OOXX
XXXX OXXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
21 [7,6] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX OXXXX
XXXX OXXXX
XX OO OXX
XX OOXX
XX O OOXX
XXXX OXXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
22 [6,8] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX XXXX
XX OOO OXX
XX OOXX
XX O OOXX
XXXX OXXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
23 [8,4] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX XXXX
XX OOO OXX
XX OOXX
XX OO XX
XXXX OXXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
24 [5,4] EAST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX XXXX
XX OOO OXX
XX OOXX
XX O XX
XXXX OXXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
25 [8,6] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX XXXX
XX OOO XX
XX O XX
XX OOXX
XXXX OXXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
26 [8,4] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX XXXX
XX OOO XX
XX O XX
XX O XX
XXXX OXXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
27 [6,3] NORTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX XXXX
XX OOO XX
XX OO XX
XX XX
XXXX XXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
28 [6,5] NORTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX OXXXX
XX OO XX
XX O XX
XX XX
XXXX XXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
29 [4,6] EAST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX OXXXX
XX O XX
XX O XX
XX XX
XXXX XXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
30 [6,7] SOUTH
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX XXXX
XX XX
XX OO XX
XX XX
XXXX XXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
31 [7,5] WEST
XXXXXXXXXXX
XXXXXXXXXXX
XXXX XXXX
XXXX XXXX
XX XX
XX O XX
XX XX
XXXX XXXX
XXXX XXXX
XXXXXXXXXXX
XXXXXXXXXXX
Program has halted normally.

View File

@ -0,0 +1,371 @@
! Backtracking Algorithm for solving a Solitaire game
! Author Joachim Fritschi
let
!game table constants
const INVALID ~ 2;
const OCCUPIED ~ 1;
const FREE ~ 0;
const free ~ ' ';
const occupied ~ 'O';
const invalid ~ 'X';
!solution constants
const NORTH ~ 0;
const EAST ~ 1;
const SOUTH ~ 2;
const WEST ~ 3;
!Array representation of the game table
type row ~ record
column: array 11 of Integer,
length: Integer
end;
var table: array 11 of row;
var foundSolution: Boolean;
!Array representation of the game solution
!The Records a steps containing the position x,y of the stone to move and the direction
type step ~ record
column: array 3 of Integer,
length: Integer
end;
var solution: array 32 of row;
proc initTable() ~
let
var x: Integer;
var y: Integer
in begin
x := 0;
while( x < 11) do
begin
! putint(x);
y := 0;
while( y < 11) do
begin
! putint(y);
table[y].column[x] := INVALID;
y := y + 1
end;
x := x + 1;
end;
x := 2;
while(x < 9) do
begin
table[4].column[x] := OCCUPIED;
table[5].column[x] := OCCUPIED;
table[6].column[x] := OCCUPIED;
table[x].column[4] := OCCUPIED;
table[x].column[5] := OCCUPIED;
table[x].column[6] := OCCUPIED;
x := x + 1;
end;
table[5].column[5] := FREE;
end;
! Intitalize the solution Array
proc initSolution() ~
let
var x: Integer;
var y: Integer
in begin
x := 0;
y := 0;
while( x < 32) do
begin
y := 0;
while( y < 3) do
begin
solution[x].column[y] := 0;
y := y + 1
end;
x := x + 1;
end;
end;
! Print the game table
proc printTable() ~
let
var x: Integer;
var y: Integer
in begin
y := 10;
while( y >= 0) do
begin
x := 0;
while( x < 11) do
begin
if table[y].column[x] = INVALID then
put(invalid)
else
if table[y].column[x] = FREE then
put(free)
else
put(occupied);
x := x + 1;
end;
puteol();
y := y - 1;
end;
puteol();
end;
! execute a Move on the game table
proc makeMove(x: Integer,y : Integer,dir : Integer) ~
begin
if dir = NORTH then
begin
table[y].column[x] := FREE;
table[y + 1].column[x] := FREE;
table[y + 2].column[x] := OCCUPIED;
end
else
begin
if dir = EAST then
begin
table[y].column[x] := FREE;
table[y].column[x+1] := FREE;
table[y].column[x+2] := OCCUPIED;
end
else
begin
if dir = SOUTH then
begin
table[y].column[x] := FREE;
table[y - 1].column[x] := FREE;
table[y - 2].column[x] := OCCUPIED;
end
else
begin
if dir = WEST then
begin
table[y].column[x] := FREE;
table[y].column[x-1] := FREE;
table[y].column[x-2] := OCCUPIED;
end
else
begin
end
end
end
end;
end;
! undo a move on the game table
proc undoMove(x: Integer,y : Integer,dir : Integer) ~
begin
if dir = NORTH then
begin
table[y].column[x] := OCCUPIED;
table[y + 1].column[x] := OCCUPIED;
table[y + 2].column[x] := FREE;
end
else
begin
if dir = EAST then
begin
table[y].column[x] := OCCUPIED;
table[y].column[x+1] := OCCUPIED;
table[y].column[x+2] := FREE;
end
else
begin
if dir = SOUTH then
begin
table[y].column[x] := OCCUPIED;
table[y - 1].column[x] := OCCUPIED;
table[y - 2].column[x] := FREE;
end
else
begin
if dir = WEST then
begin
table[y].column[x] := OCCUPIED;
table[y].column[x-1] := OCCUPIED;
table[y].column[x-2] := FREE;
end
else
begin
end
end
end
end
end;
!save a move in the solution array
proc saveSolution(stepNr: Integer,x : Integer,y : Integer, dir : Integer) ~
begin
solution[stepNr].column[0] := x;
solution[stepNr].column[1] := y;
solution[stepNr].column[2] := dir;
end;
!rekursive solution of the game with a backtracking algorithm
proc calcSolution(stepNr: Integer,var status: Boolean)~
begin
if (stepNr = 31) /\ (table[5].column[5] = OCCUPIED) then
status := true
else
let
var x: Integer;
var y: Integer
in begin
x := 2;
while ( x < 9) do
begin
y := 2;
while ( y < 9) do
begin
if(table[y].column[x] = OCCUPIED) /\ (table[y+1].column[x] = OCCUPIED ) /\ (table[y + 2].column[x] = FREE ) /\ \status then
begin
makeMove(x,y,NORTH);
calcSolution(stepNr + 1, var status);
if status = true then
begin
saveSolution(stepNr,x,y,NORTH);
end
else
begin
undoMove(x,y,NORTH);
end
end
else
begin
end;
if(table[y].column[x] = OCCUPIED) /\ (table[y-1].column[x] = OCCUPIED ) /\ (table[y - 2].column[x] = FREE ) /\ \status then
begin
makeMove(x,y,SOUTH);
calcSolution(stepNr + 1, var status);
if status = true then
begin
saveSolution(stepNr,x,y,SOUTH);
end
else
begin
undoMove(x,y,SOUTH);
end
end
else
begin
end;
if(table[y].column[x] = OCCUPIED) /\ (table[y].column[x+1] = OCCUPIED ) /\ (table[y].column[x + 2] = FREE ) /\ \status then
begin
makeMove(x,y,EAST);
calcSolution(stepNr + 1, var status);
if status = true then
begin
saveSolution(stepNr,x,y,EAST);
end
else
begin
undoMove(x,y,EAST);
end
end
else
begin
end;
if(table[y].column[x] = OCCUPIED) /\ (table[y].column[x-1] = OCCUPIED ) /\ (table[y].column[x - 2] = FREE ) /\ \status then
begin
makeMove(x,y,WEST);
calcSolution(stepNr + 1, var status);
if status = true then
begin
saveSolution(stepNr,x,y,WEST);
end
else
begin
undoMove(x,y,WEST);
end
end
else
begin
end;
y := y + 1
end;
x := x + 1
end;
end;
end;
!little helper funktion to write the directions human readable
proc writeDirection(dir: Integer) ~
begin
if dir = NORTH then
begin
put('N');
put('O');
put('R');
put('T');
put('H');
end
else
if dir = EAST then
begin
put('E');
put('A');
put('S');
put('T');
end
else
if dir = SOUTH then
begin
put('S');
put('O');
put('U');
put('T');
put('H');
end
else
if dir = WEST then
begin
put('W');
put('E');
put('S');
put('T');
end
else
end;
!print the solution on the stout
proc printSolution() ~
let
var count: Integer
in begin
initTable();
puteol();
printTable();
count := 0;
while count < 31 do
begin
putint(count + 1);
put(' ');
put('[');
putint(solution[count].column[0]);
put(',');
putint(solution[count].column[1]);
put(']');
put(' ');
writeDirection(solution[count].column[2]);
puteol();
makeMove(solution[count].column[0],solution[count].column[1],solution[count].column[2]);
printTable();
count := count + 1
end
end
in begin
foundSolution := false;
initTable();
initSolution();
calcSolution(0,var foundSolution);
printSolution();
end

View File

@ -0,0 +1,6 @@
let
var x : Integer;
const n ~ 42;
const m ~ n + 1
in
x := x + n * m;

View File

@ -0,0 +1,26 @@
!
! Implementation of a simple calculator in Triangle by
! - Alexander Constantin constant@rbg.informatik.tu-darmstadt.de
! - Nico Rottstädt rottstae@rbg.informatik.tu-darmstadt.de
!
! This is an excercise from A. Koch's Lecture "Optimierende Compiler",
! summer term 2006 at TU Darmstadt / Germany, course homepage (German):
! http://www.esa.informatik.tu-darmstadt.de/twiki/bin/view/Lectures/OptimierendeCompilerDe.html
!
Erlaubte 1-stellige Operationen: - (Negation)
Erlaubte 2-stellige Operationen: + (Addition)
- (Subtraktion)
* (Multiplikation)
/ (Division)
Jede 2-stellige Operation muss mit Klammern umschlossen sein.
Ein vernüftiger Fehlerzustand wurde noch nicht implementiert.
Zum Beispiel wird bei einer unbekannten Operation 0 zurückgegeben.
Beispiel:
---------
Term: ((1+2)*(-1+3))
((1+2)*(-1+3)) = 6

View File

@ -0,0 +1,210 @@
!
! Implementation of a simple calculator in Triangle by
! - Alexander Constantin constant@rbg.informatik.tu-darmstadt.de
! - Nico Rottstädt rottstae@rbg.informatik.tu-darmstadt.de
!
! This is an excercise from A. Koch's Lecture "Optimierende Compiler",
! summer term 2006 at TU Darmstadt / Germany, course homepage (German):
! http://www.esa.informatik.tu-darmstadt.de/twiki/bin/view/Lectures/OptimierendeCompilerDe.html
!
let
! --------------
! String support
! --------------
type String ~ record
Str: array 80 of Char
end;
! Fill a string
proc readstring(var strg: String) ~
let
var chint: Char;
var length: Integer;
var testeol : Boolean;
var testeof : Boolean
in begin
length := 0;
eol(var testeol);
eof(var testeof);
while \ testeol /\ \ testeof do begin
get(var chint);
strg.Str[length] := chint;
length := length + 1;
eol(var testeol);
eof(var testeof);
end;
strg.Str[length-2] := '\';
end;
! Print a string
proc putstring(var strg: String) ~
let
var i: Integer
in begin
i := 0;
while \ (strg.Str[i] = '\') do begin
put(strg.Str[i]);
i := i + 1;
end;
end;
! Eliminate spaces in a string
proc removeSpacesFromString(var strg: String) ~
let
var counter : Integer;
var tmpArray : array 80 of Char;
var tmpCounter : Integer
in begin
counter := 0;
tmpCounter := 0;
while (strg.Str[counter] \= '\') do begin
if (strg.Str[counter] \= ' ') then
begin
tmpArray[tmpCounter] := strg.Str[counter];
tmpCounter := tmpCounter + 1;
end
else;
counter := counter + 1;
end;
tmpArray[tmpCounter] := strg.Str[counter]; ! copy \
strg.Str := tmpArray
end;
! ---------------
! Integer support
! ---------------
func isDigit(c:Char) : Boolean ~
(c = '0') \/ (c = '1') \/ (c = '2') \/ (c = '3') \/ (c = '4') \/
(c = '5') \/ (c = '6') \/ (c = '7') \/ (c = '8') \/ (c = '9');
! ord('0') = 48
! ...
! ord('9') = 57
func convertCharToInt(c:Char) : Integer ~
ord(c) - 48;
! maxInt = 32767
! bei char arrays die einen geoesseren Wert darstellen kommt es zum overflow
proc readInteger(term: array 80 of Char, var i: Integer, var result: Integer) ~
let
var isNegative : Boolean
in begin
result := 0;
isNegative := false;
if (term[i] = '-') then
begin
isNegative := true;
i := i + 1;
end
else;
while (isDigit(term[i])) do begin
result := result * 10;
result := result + convertCharToInt(term[i]);
i := i + 1;
end;
if (isNegative) then
result := 0 - result
else
end;
! ----------------
! Calculator stuff
! ----------------
! allowed two digit operations: +, -, *, /
func doOperation(op1 : Integer, op2 : Integer, operator : Char) : Integer ~
if operator = '+' then
op1 + op2
else if operator = '-' then
op1 - op2
else if operator = '*' then
op1 * op2
else if operator = '/' then
op1 / op2
else
0;
! rekursives Parsen
proc parse(term: array 80 of Char, var i: Integer, var result: Integer) ~
let
var operand1: Integer;
var operand2: Integer;
var operator: Char
in begin
if (term[i] = '(') then
begin
i := i + 1;
parse(term, var i, var operand1);
operator := term[i];
i := i + 1;
parse(term, var i, var operand2);
if (term[i] \= ')') then
begin
put('E');
put('R');
put('R');
put('O');
put('R');
puteol()
end
else
! do operation here
i := i + 1;
result := doOperation(operand1, operand2, operator);
end
else
begin
readInteger(term, var i, var result)
end;
end;
! Main Program - "Calculator"
! ---------------------------
var term : String;
var result : Integer;
var i : Integer
in begin
i := 0;
! Prompt ausgeben
put('T');
put('e');
put('r');
put('m');
put(':');
put(' ');
! Einlesen des Terms
readstring(var term);
removeSpacesFromString(var term);
! start parsing
parse(term.Str, var i, var result);
! output result
puteol();
putstring(var term);
put(' ');
put('=');
put(' ');
putint(result);
puteol()
end

View File

@ -0,0 +1,22 @@
! [file: case-digit.tri, started: 22-Apr-2004]
! Testing new case statement.
! Print character representation of a digit.
let
var n: Integer
in begin
getint(var n);
case n of
7: begin put('z'); put('e'); put('v'); put('e'); put('n'); end;
9: begin put('n'); put('e'); put('g'); put('e'); put('n'); end;
2: begin put('t'); put('w'); put('e'); put('e'); end;
3: begin put('d'); put('r'); put('i'); put('e'); end;
4: begin put('v'); put('i'); put('e'); put('r'); end;
5: begin put('v'); put('i'); put('j'); put('f'); end;
8: begin put('a'); put('c'); put('h'); put('t'); end;
6: begin put('z'); put('e'); put('s'); end;
0: begin put('n'); put('u'); put('l'); end;
1: begin put('e'); put('e'); put('n'); end;
else: begin put('f'); put('o'); put('u'); put('t'); end;
puteol();
end;

View File

@ -0,0 +1,14 @@
! [file: case-digit.tri, started: 23-Apr-2004]
! Testing new case-statement.
! error: expression is not a boolean
let
var n: Integer
in begin
getint(var n);
case n>0 of
0: put('0');
1: put('1');
else: put('?');
puteol();
end;

View File

@ -0,0 +1,15 @@
! [file: case-digit.tri, started: 23-Apr-2004]
! Testing new case-statement.
! error: integer constants should be different
let
var n: Integer
in begin
getint(var n);
case n of
0: put('0');
1: put('1');
0: put('0');
else: put('?');
puteol();
end;

View File

@ -0,0 +1,57 @@
Author: Simon Kulessa
Version: 1.0
Reads a nondirected graph from the command line and colors the graph
with the minimum number of colors.
<Input Format>
Number of Nodes: - A number between 0 and 14
Complete? - Whether the graph is complete or not
Another Edge? - 'y' or 'Y' for another edge,
anything else to continue
Node 1: - A existing node id
Node 2: - A different existing node id
A node id is a number between 0 and the number of nodes - 1.
<Output Format>
Minimum number of colors
NodeId ColorId Number of Neighbours List of Neighbours
<Example 1>
Number of nodes: 5
Complete? y
Graph succesfull colored with 5 color(s).
0 1 4 [1, 2, 3, 4]
1 4 4 [0, 2, 3, 4]
2 3 4 [0, 1, 3, 4]
3 5 4 [0, 1, 2, 4]
4 2 4 [0, 1, 2, 3]
<Example 2>
Number of nodes: 5
Complete? n
Another edge? y
Node 1: 0
Node 2: 1
Another edge? y
Node 1: 0
Node 2: 2
Another edge? y
Node 1: 1
Node 2: 2
Another edge? y
Node 1: 2
Node 2: 3
Another edge? y
Node 1: 2
Node 2: 4
Another edge? n
Graph succesfull colored with 3 color(s).
0 1 2 [1, 2]
1 3 2 [0, 2]
2 2 4 [0, 1, 3, 4]
3 1 1 [2]
4 1 1 [2]

View File

@ -0,0 +1,434 @@
! Reads a nondirected graph from the command line and colors the graph
! with the minimum number of colors.
!
! <Input Format>
! Number of Nodes: - A number between 0 and 14
! Complete? - Whether the graph is complete or not
! Another Edge? - 'y' or 'Y' for another edge,
! anything else to continue
! Node 1: - A existing node id
! Node 2: - A different existing node id
!
! A node id is a number between 0 and the number of nodes - 1.
!
! <Output Format>
! Minimum number of colors
! NodeId ColorId Number of Neighbours List of Neighbours
!
! <Example 1>
! Number of nodes: 5
! Complete? y
!
! Graph succesfull colored with 5 color(s).
! 0 1 4 [1, 2, 3, 4]
! 1 4 4 [0, 2, 3, 4]
! 2 3 4 [0, 1, 3, 4]
! 3 5 4 [0, 1, 2, 4]
! 4 2 4 [0, 1, 2, 3]
!
! <Example 2>
! Number of nodes: 5
! Complete? n
! Another edge? y
! Node 1: 0
! Node 2: 1
! Another edge? y
! Node 1: 0
! Node 2: 2
! Another edge? y
! Node 1: 1
! Node 2: 2
! Another edge? y
! Node 1: 2
! Node 2: 3
! Another edge? y
! Node 1: 2
! Node 2: 4
! Another edge? n
!
! Graph succesfull colored with 3 color(s).
! 0 1 2 [1, 2]
! 1 3 2 [0, 2]
! 2 2 4 [0, 1, 3, 4]
! 3 1 1 [2]
! 4 1 1 [2]
!
!
! Author: Simon Kulessa
! Version: 1.0
let
! node type
type Node ~ record
tag: Integer,
color: Integer,
size: Integer,
neighbours: array 13 of Integer
end;
! graph type
type Graph ~ record
size: Integer,
nodes: array 14 of Node
end;
! reads a single number from the command line
proc readNumber(var number: Integer) ~
let
var c: Char;
var testeol : Boolean;
var testeof : Boolean
in begin
getint(var number);
eol(var testeol);
eof(var testeof);
while \ testeol /\ \ testeof do begin
get(var c);
eol(var testeol);
eof(var testeof);
end;
end;
! reads a single char from the command line
proc readChar(var c: Char) ~
let
var x: Char;
var testeol : Boolean;
var testeof : Boolean
in begin
get(var c);
eol(var testeol);
eof(var testeof);
while \ testeol /\ \ testeof do begin
get(var x);
eol(var testeol);
eof(var testeof);
end;
end;
! prints a error message
proc printError() ~
begin
put('i'); put('l'); put('l'); put('e'); put('g'); put('a'); put('l');
put(' '); put('i'); put('n'); put('p'); put('u'); put('t'); puteol();
end;
! prints the output message
proc printOutput(result: Integer) ~
begin
puteol();
put('G'); put('r'); put('a'); put('p'); put('h'); put(' '); put('s');
put('u'); put('c'); put('c'); put('e'); put('s'); put('f'); put('u');
put('l'); put('l'); put(' '); put('c'); put('o'); put('l'); put('o');
put('r'); put('e'); put('d'); put(' '); put('w'); put('i'); put('t');
put('h'); put(' '); putint(result); put(' '); put('c'); put('o');
put('l'); put('o'); put('r'); put('('); put('s'); put(')'); put('.');
puteol();
end;
! prints the first input information
proc printInputInfo1() ~
begin
put('N'); put('u'); put('m'); put('b'); put('e'); put('r'); put(' ');
put('o'); put('f'); put(' '); put('n'); put('o'); put('d'); put('e');
put('s'); put(':'); put(' ');
end;
! prints the second input information
proc printInputInfo2() ~
begin
put('A'); put('n'); put('o'); put('t'); put('h'); put('e'); put('r');
put(' '); put('e'); put('d'); put('g'); put('e'); put('?'); put(' ');
end;
! prints the third input information
proc printInputInfo3() ~
begin
put('N'); put('o'); put('d'); put('e'); put(' '); put('1'); put(':');
put(' ');
end;
! prints the fourth input information
proc printInputInfo4() ~
begin
put('N'); put('o'); put('d'); put('e'); put(' '); put('2'); put(':');
put(' ');
end;
! prints the fifth input information
proc printInputInfo5() ~
begin
put('C'); put('o'); put('m'); put('p'); put('l'); put('e'); put('t');
put('e'); put('?'); put(' ');
end;
! prints the graphdata
proc printGraph(g: Graph) ~
let
var i: Integer;
var j: Integer
in begin
i := 0;
while(i < g.size) do begin
putint(g.nodes[i].tag);
put(' ');
putint(g.nodes[i].color);
put(' ');
putint(g.nodes[i].size);
put(' ');
put('[');
j := 0;
while(j < g.nodes[i].size) do begin
putint(g.nodes[i].neighbours[j]);
j := j + 1;
if (j < g.nodes[i].size) then begin
put(',');
put(' ');
end else
end;
put(']');
puteol();
i := i + 1;
end;
end;
! creates a node
proc createNode(var g: Graph, id: Integer) ~
let
var n: Node
in begin
n.tag := id;
n.size := 0;
n.color := 0;
g.nodes[id] := n;
end;
! creates a connection
proc createConnection(var g: Graph, s: Node, t: Node) ~
let
var i: Integer;
var f: Integer
in begin
if ((\(s.tag = t.tag)) /\ (s.size < 13) /\ (t.size < 13)) then begin
i := 0;
f := 0;
while ((i < s.size) /\ (f = 0)) do begin
if (s.neighbours[i] = t.tag) then begin
f := 1;
end else begin
i := i + 1;
end;
end;
if (f = 1) then begin
printError();
end else begin
g.nodes[s.tag].neighbours[s.size] := t.tag;
g.nodes[s.tag].size := s.size + 1;
g.nodes[t.tag].neighbours[t.size] := s.tag;
g.nodes[t.tag].size := t.size + 1;
end;
end else begin
printError();
end;
end;
! reads a graph from the commando line
proc createGraph(var g: Graph) ~
let
var i: Integer;
var j: Integer;
var s: Node;
var t: Node;
var c: Char
in begin
! Read graphsize
printInputInfo1();
readNumber(var i);
g.size := i;
if ((i < 0) \/ (i > 14)) then begin
g.size := 0;
printError();
end else begin
while i > 0 do begin
i := i-1;
createNode(var g, i);
end;
! Generate complete graph?
printInputInfo5();
readChar(var c);
if ((c = 'y') \/ (c = 'Y')) then begin
i := 0;
while (i < g.size) do begin
j := i + 1;
while (j < g.size) do begin
s := g.nodes[i];
t := g.nodes[j];
createConnection(var g, s, t);
j := j + 1;
end;
i := i + 1;
end;
end else begin
! Read another edge?
printInputInfo2();
readChar(var c);
while ((c = 'y') \/ (c = 'Y')) do begin
! Read start node
printInputInfo3();
readNumber(var i);
if ((i < 0) \/ (i >= g.size)) then begin
printError();
end else begin
s := g.nodes[i];
! Read target node
printInputInfo4();
readNumber(var i);
if ((i < 0) \/ (i >= g.size)) then begin
printError();
end else begin
t := g.nodes[i];
! Create the edge
createConnection(var g, s, t);
end;
end;
! Read another edge?
printInputInfo2();
readChar(var c);
end;
end;
end;
end;
! checks the color recursivly
proc checkColor(var g: Graph, n: Node, lastColor: Integer, maxColor: Integer, var found: Integer) ~
let
var color: Integer;
var m: Node;
var i: Integer;
var b: Integer;
var e: Integer
in begin
if (n.color = lastColor) then begin
found := 0;
end else begin
if (\(n.color = 0)) then begin
found := 1;
end else begin
color := 1;
b := 0;
while ((b = 0) /\ (color <= maxColor)) do begin
if (\(lastColor = color)) then begin
g.nodes[n.tag].color := color;
b := 1;
i := n.size;
while((i > 0) /\ (b = 1)) do begin
i := i - 1;
m := g.nodes[n.neighbours[i]];
checkColor(var g, m, color, maxColor, var b);
end;
if (b = 0) then begin
g.nodes[n.tag].color := 0;
color := color + 1;
end else
end else begin
color := color + 1;
end;
end;
found := b;
end;
end;
end;
! trys to color the graph with the given number of colors
proc tryColoring(var g: Graph, maxColor: Integer, var found: Integer) ~
let
var i: Integer;
var n: Node
in begin
! Init color labels
i := g.size;
while (i > 0) do begin
i := i -1;
g.nodes[i].color := 0;
end;
! Start coloring
n := g.nodes[i];
checkColor(var g, n, 0 - 1, maxColor, var found);
if (found = 1) then begin
i := 0;
while((i < g.size) /\ (found = 1)) do begin
n := g.nodes[i];
if (n.color = 0) then begin
checkColor(var g, n, 0 - 1, maxColor, var found);
end else
i := i + 1;
end;
end else
end;
! global values
var g: Graph;
var i: Integer;
var b: Integer
in begin
! reads a graph from the command line
createGraph(var g);
! solve the coloring problem
i := 0;
b := 0;
while((b = 0) /\ (i < g.size)) do begin
i := i + 1;
tryColoring(var g, i, var b);
end;
! print results
printOutput(i);
printGraph(g);
end

View File

@ -0,0 +1,53 @@
!
! Simple File I/O example
! Copies from file `infile' to file `outfile'
!
let
const INNAME ~
[ 'i', 'n', 'f', 'i', 'l', 'e', chr(0), chr(0), chr(0), chr(0),
chr(0), chr(0), chr(0), chr(0), chr(0), chr(0), chr(0), chr(0), chr(0), chr(0)];
const OUTNAME ~
[ 'o', 'u', 't', 'f', 'i', 'l', 'e', chr(0), chr(0), chr(0),
chr(0), chr(0), chr(0), chr(0), chr(0), chr(0), chr(0), chr(0), chr(0), chr(0)];
var infile : Integer;
var outfile : Integer;
var c : Char;
var eof : Boolean
in begin
fopen(var infile, INNAME, false);
if (infile < 0) then begin
! error opening input file, message 'I!'
put('I');
put('!');
puteol()
end else begin
fopen(var outfile, OUTNAME, true);
if (outfile < 0) then begin
! error opening output file, message 'O!'
put('O');
put('!');
puteol()
end else begin
! both files open, begin copying
feof(infile, var eof);
while (\ eof) do begin
fget(infile, var c);
fput(outfile, c);
feof(infile, var eof)
end;
fclose(outfile)
end;
fclose(infile)
end
end

View File

@ -0,0 +1,12 @@
let
const MAX ~ 10;
var n: Integer
in begin
getint(var n);
if (n>0) /\ (n<=MAX) then
while n > 0 do begin
putint(n); puteol();
n := n - 1;
end
else
end

View File

@ -0,0 +1,46 @@
CRC-Berechnung auf Basis von CRC-12
===================================
Autor: Tomislav Greguric
weitere Gruppenmitglieder: Elif Tekes, Nabil Sayegh
Programmbeschreibung:
---------------------
Das vorliegende Programm "crc.tri" bzw. "crc.tam" berechnet zu
gegebenen Eingabedaten auf STDIN eine Checksumme.
Dazu werden jeweils nacheinander drei Bytes eingelesen und über
diese eine Checksumme nach dem CRC-12-Verfahren berechnet. Bei
weniger als drei Bytes werden die restlichen Bits mit Nullen
aufgefüllt. Als Ausgabe liefert das Programm eine kummulierte
Checksumme und (in Anlehnung an sum(1) und cksum(1)) die nach oben
gerundete Anzahl der 1k-Blöcke.
Derzeit werden die einzelnen CRC-12-Summen geXORt, so daß schnell
die größtmögliche Checksumme von 2^12-1=4095 entsteht. Eine Addition
würde auch nicht viel bringen, da dann Triangles "maxint" die
nächsthöhere Hürde wäre.
Da auch keine Bitoperationen möglich sind, wurden intern die Bits
als Array von Integer realisiert, natürlich mit der
stillschweigenden Bedingung, daß dabei nur Nullen und Einsen benutzt
werden dürfen.
Beispiele:
----------
tg@penguin1:~/crc-4/Triangle$ echo He | java TAM.Interpreter crc.tam
********** TAM Interpreter (Java Version 2.1) **********
2032 1
Program has halted normally.
tg@penguin1:~/crc-4/Triangle$ echo Hello | java TAM.Interpreter crc.tam
********** TAM Interpreter (Java Version 2.1) **********
4095 1
Program has halted normally.
tg@penguin1:~/crc-4/Triangle$

View File

@ -0,0 +1,291 @@
! CRC-12 Pruefsummenberechnung
!
! Verwendetes Generatorpolynom: G(x)=x^12+x^11+x^3+x^2+x+1 (== 1100000001111)
let
! Diverse Register
var r24 : array 24 of Integer; ! 3 zu checkende bytes
var r36 : array 36 of Integer; ! r24 mit angehaengten Nullen
var r13 : array 13 of Integer; ! Generatorpolynom
var rcs : array 13 of Integer; ! Gesamtchecksumme
! Generator in Bitschreibweise und als Integersumme
const G ~ [1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1];
var g : Integer;
! Potenzen schlagen wir nach
const pot8 ~ [128, 64, 32, 16, 8, 4, 2, 1];
const pot13 ~ [4096, 2048, 1024, 512, 256, 128, 64, 32, 16, 8, 4, 2, 1];
! Drei einzulesende Bytes -> r24
var chr1 : Char;
var chr2 : Char;
var chr3 : Char;
! Triangle ist gut im "hinter der Datei lesen", also doch selber machen
var readbehindeof : Boolean;
! "counter" zaehlt die 1024-Byte-Blocks in "blocks"
var counter : Integer;
var blocks : Integer;
! "i" wie Integer-Hilfsvariable
var i : Integer;
! Gesamtchecksumme als Int
var checksum : Integer;
! Debug
proc showr13() ~
begin
i := 0;
while (i<13) do
begin
putint(r13[i]);
i := i+1;
end;
puteol();
end;
! Debug
proc showr24() ~
begin
i := 0;
while (i<24) do
begin
putint(r24[i]);
i := i+1;
end;
puteol();
end;
! Debug
proc showr36() ~
begin
i := 0;
while (i<36) do
begin
putint(r36[i]);
i := i+1;
end;
puteol();
end;
! XOR zweier Bits
func xor(val1: Integer, val2: Integer) : Integer ~
if (val1 \= val2) then
1
else
0
;
! CRC-12 auf 3 Bytes berechnen
proc crc() ~
let
var i : Integer;
var j : Integer;
var k : Integer
in
begin
! r36 von links auffüllen, Rest nullen
i := 0;
while (i < 24) do
begin
r36[i] := r24[i];
i := i + 1;
end;
while (i < 36) do
begin
r36[i] := 0;
i := i + 1;
end;
! Division Modulo 2 (eigentlich XOR)
j := 0;
while (j < 22) do
begin
i := 0;
k := 0;
while (i < 13) do
begin
k := r36[i+j] * pot13[i] + k;
i := i + 1;
end;
if (k >= g) then
begin
i := 0;
while (i < 13) do
begin
r36[i+j] := xor(r36[i+j], r13[i]);
i := i + 1;
end;
end
else
begin
i := 0;
while (i < 13) do
begin
r36[i+j] := xor(r36[i+j], 0); ! sprich: einfach weitergehen und nix machen
i := i + 1;
end;
end;
j := j + 1;
end;
! Leider noch unbefriedigend...
! Gesamtchecksumme erreicht schnell 2^12-1,
! evtl. faellt mir noch was besseres ein
! (Triangle gibt bei Zahlen > maxint einfach 0 aus, hmmm....)
i := 0;
while (i < 13) do
begin
! r13[i] := r36[i+24];
rcs[i] := xor(r13[i], rcs[i]);
i := i + 1;
end;
end;
! Lese Wert nach r24, wobei place=1=linkesByte=MSB, place=2=mittleresByte, und place=3=rechtesByte=LSB
proc load(place: Integer, val: Integer) ~
let
var i : Integer;
var j : Integer;
var v : Integer;
! Ist Bit mit Wertigkeit div gesetzt?
func bitset(val: Integer, div: Integer) : Integer ~
if (div = 0) then
0
else
if ((val / div) > 0) then
1
else
0
in
begin
v := val;
i := (place-1)*8;
j := 0;
! ganzes Byte in r24 einsetzen
while (j < 8) do
begin
r24[i] := bitset(v, pot8[j]);
if (r24[i] = 1) then
v := v - pot8[j]
else
;
i := i + 1;
j := j + 1;
end;
end;
! 24 bits einlesen, falls möglich
proc readin() ~
let
var n1 : Integer;
var n2 : Integer;
var n3 : Integer;
var i : Integer;
var testeof : Boolean
in
begin
counter := 0;
blocks := 1;
readbehindeof := false;
eof(var testeof);
while \testeof do
begin
chr1 := ' ';
chr2 := ' ';
chr3 := ' ';
get(var chr1);
get(var chr2);
get(var chr3);
n1 := ord(chr1);
n2 := ord(chr2);
n3 := ord(chr3);
! Falls wir ueber das Dateiende hinausgelesen haben,
! dann von hinten den "Muell" wegmachen und fuer uns
! in "readbehindoef" klarstellen, dass wir definitiv
! fertig sind
if (n3 < 0) then
begin
counter := counter-1;
n3 := 0;
if (n2 < 0) then
begin
counter := counter-1;
n2 := 0;
if (n1 < 0) then
begin
readbehindeof := true;
counter := counter-1;
n1 := 0;
end
else
;
end
else
;
end
else
;
! nun die Bytes ins Register r24 schieben und die CRC darueber berechnen
if (\ readbehindeof) then
begin
load(1, n1);
load(2, n2);
load(3, n3);
crc();
end
else
;
! und als Bonus die Anzahl der 1k-Bloecke bestimmen
counter := counter+3;
if (counter >= 1024) then
begin
counter := 0;
blocks := blocks + 1;
end
else
;
eof(var testeof);
end;
end
in
begin
! Initalisierungen, Generatorpolynom -> r13 und als Integer
i := 0;
g := 0;
checksum := 0;
while (i < 13) do
begin
rcs[i] := 1;
r13[i] := G[i];
g := (r13[i] * pot13[i]) + g;
i := i + 1;
end;
! von STDIN lesen und CRC-12 berechnen
readin();
! Checksumme aus der Bitschreibweise errechnen
i := 0;
while (i < 12) do
begin
checksum := rcs[i+1] * pot13[i+1] + checksum;
i := i + 1;
end;
! Checksumme und Blocks ausgeben
putint(checksum);
put(' ');
putint(blocks);
puteol();
end;

View File

@ -0,0 +1,67 @@
!
! Implementation of several data types in Triangle by Boris Nickel, boris-nickel@web.de
!
! This is an excercise from A. Koch's Lecture "Optimierende Compiler",
! summer term 2006 at TU Darmstadt / Germany, course homepage (German):
! http://www.esa.informatik.tu-darmstadt.de/twiki/bin/view/Lectures/OptimierendeCompilerDe.html
While for adding a for...next-loop a compiler modification is necessary, I thought
adding some abstract datatypes and a few operations might me usefull for later use.
The file datatypes.tri includes all the methods/functions/datatypes described below
as well as a short main programm, representing a little test suite.
For design I choosed mostly to use proc, because func allows to return expressions only.
Here is a list of what I added so far:
--------------------------------------
- Datatype String very basic string implementation: Triangle doesn't support variabe arrays,
so this a simple fixed array of 80 chars, directly accessible with String.Str
Note: Each string must be terminated with a backslash \ by definition
- Method proc readstring(var strg: String) reads a String from the keyboard into strg and terminates it correctly
- Method proc strcat(var str1: String, var str2: String) Concatenate two strings: Add content of str2 to str1 -> str1 = str1str2
- Method proc putstring(var strg: String) prints a string without the terminating \ to the std output
- Method proc strlen(strg: String, var length: Integer) determines the length of a string and gives an integer output of the length
- Method proc strrev(var strg: String) Reverses a string, strg = gtrs
- Datatype Date Represents a date. It's a record including Integers day, month and year,
format ddmmyyyy is used
- Datatype Time Represents a time. It's a record including Integers hours, minutes and seconds,
24hr format hh:mm:ss is used
- Constructor func createDate (day: Integer, month: Integer, year: Integer) : Date - use this constructor to ensure a date has the corect format,
is a real date (and not 53th of May 2006 i.e.). If a wrong date is given, the date
1.1.1000 is created instead. In later versions an error throwing and handling
system should replace this behavior
- Constructor func createTime (hours: Integer, minutes: Integer, seconds: Integer) : Time - uns this constructor to ensure a time has the correct
format, is a real time (and not 54:26:99 i.e.). If a wrong time is given, the time
00:00:00 is created instead. See note at createDate.
- Method proc putdate (inDate: Date) Prints a formatted date to std out in format dd/mm/yyyy and adds leading zeros if
day or month has just one digit
- Method proc puttime (inTime: Time, outtype: Integer) Prints a formatted time to std out. Outtype specifies the format:
If outtype = 1, an output in 24hr format is generated (hh:mm:ss), including leading
zeroes if any of the values has just one digit.
If outtype is != 1, an output in am/pm format is generated (hh:mm:ss am/pm), adding
leading zeros to minute and second only if necessary
- Method proc diffdays(date1: Date, date2: Date, var output: Integer) - counts the number of days between to given dates. Output is
|date1 - date2| = output, so output will always be a positive number of days,
regardless if date1 or date2 is the bigger one. This function does not take care
of leapyears (maybe added in the future)
[EOF]

View File

@ -0,0 +1,264 @@
!
! Implementation of several data types in Triangle by Boris Nickel, boris-nickel@web.de
!
! This is an excercise from A. Koch's Lecture "Optimierende Compiler",
! summer term 2006 at TU Darmstadt / Germany, course homepage (German):
! http://www.esa.informatik.tu-darmstadt.de/twiki/bin/view/Lectures/OptimierendeCompilerDe.html
!
let
! Strings
!--------
! The easy way - Triangle knows constant sized arrays only, so I add a fixed string type,
! the string terminator is always a backslash \
type String ~ record
Str: array 80 of Char
end;
! Fill a string
proc readstring(var strg: String) ~
let
var chint: Char;
var length: Integer;
var testeof : Boolean;
var testeol : Boolean
in begin
length := 0;
eof(var testeof);
eol(var testeol);
while \ testeol /\ \ testeof do begin
get(var chint);
strg.Str[length] := chint;
length := length + 1;
eof(var testeof);
eol(var testeol);
end;
strg.Str[length-2] := '\';
end;
! Concatenate two strings: Add content of str2 to str1
proc strcat(var str1: String, var str2: String) ~
let
var ix: Integer;
var jx: Integer
in begin
! search for terminator in first string...
ix := 0;
while str1.Str[ix] \= '\' do begin
ix := ix + 1;
end;
! now start copying....
jx := 0;
while str2.Str[jx] \= '\' do begin
str1.Str[ix+jx] := str2.Str[jx];
jx := jx + 1;
end;
str1.Str[ix+jx] := '\';
end;
! Print a string
proc putstring(var strg: String) ~
let
var i: Integer
in begin
i := 0;
while \ (strg.Str[i] = '\') do begin
put(strg.Str[i]);
i := i + 1;
end;
end;
! length of a string
proc strlen(strg: String, var length: Integer) ~
begin
length := 0;
while \ (strg.Str[length] = '\') do begin
length := length + 1;
end;
end;
! Reverse a string
proc strrev(var strg: String) ~
let
var i: Integer;
var j: Integer;
var tempstr: String
in begin
strlen(strg, var i);
i:= i - 1; j := 0;
while i >= 0 do begin
tempstr.Str[j] := strg.Str[i];
i := i - 1;
j := j + 1;
end;
tempstr.Str[j] := '\';
strg := tempstr;
end;
! Date / Time types and operations
!---------------------------------
! Standard date in ddmmyyyy format
type Date ~ record
day: Integer,
month: Integer,
year: Integer
end;
! Standard time in hh:mm:ss format
type Time ~ record
hours: Integer,
minutes: Integer,
seconds: Integer
end;
! Date Constructor to ensure correct format on creation (dd/mm/yyyy)
func createDate (day: Integer, month: Integer, year: Integer) : Date ~
let
var datum: Date
in
if ( (day > 0) /\ (day <= 31) /\ (month > 0) /\ (month <=12) /\ (year <= 9999) ) then
{day ~ day, month ~ month, year ~ year}
else
{day ~ 1, month ~ 1, year ~ 1000 };
! Time Constructor to ensure correct format on creation (hh:mm:ss)
func createTime (hours: Integer, minutes: Integer, seconds: Integer) : Time ~
let
var zeit: Time
in
if ( (hours > 0) /\ (hours <= 23) /\ (minutes > 0) /\ (minutes <=59) /\ (seconds > 0) /\ (seconds <= 59) ) then
{hours ~ hours, minutes ~ minutes, seconds ~ seconds}
else
{hours ~ 0, minutes ~ 0, seconds ~ 0};
! ToString methods:
proc putdate (inDate: Date) ~
begin
if (inDate.day <= 9) then put('0') else; putint(inDate.day); put('/');
if (inDate.month <= 9) then put('0') else; putint(inDate.month); put('/');
if (inDate.year <= 999) then
begin
put('1'); put('0'); put('0'); put('0');
end
else putint(inDate.year);
end;
! type = 1 means 24hr format hh:mm:ss, type = 2 am / pm format
proc puttime (inTime: Time, outtype: Integer) ~
begin
if outtype = 1 then
begin
if (inTime.hours <= 9) then put('0') else; putint(inTime.hours); put(':');
if (inTime.minutes <= 9) then put('0') else; putint(inTime.minutes); put(':');
if (inTime.seconds <= 9) then put('0') else; putint(inTime.seconds);
end
else
begin
if inTime.hours > 12 then
putint(inTime.hours - 12)
else
putint(inTime.hours); put(':');
if (inTime.minutes <= 9) then put('0') else; putint(inTime.minutes); put(':');
if (inTime.seconds <= 9) then put('0') else; putint(inTime.seconds);
if inTime.hours <12 then
begin put(' '); put('a'); put('m') end
else
begin put(' '); put('p'); put('m'); end
end
end;
! how many days are between two dates ? I'm not taking care of leapyears.
proc diffdays(date1: Date, date2: Date, var output: Integer) ~
let
var diffd: Integer;
var total: Integer;
var months: array 13 of Integer;
var tmpdate: Date;
var tmpdate1: Date;
var tmpdate2: Date
in begin
diffd := 0; total:= 0; output := 0;
months := [0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31];
!check if date1 is > than date2:
if (date1.year < date2.year) \/ ((date1.year = date2.year) /\ (date1.month < date2.month)) \/ ((date1.year = date2.year) /\ (date1.month = date2.month) /\ (date1.day < date2.day)) then
begin
tmpdate1 := date2;
tmpdate2 := date1;
end
else
begin
tmpdate1 := date1;
tmpdate2 := date2;
end;
!now count all the remaining days:
tmpdate := tmpdate2;
while \ ( (tmpdate1.day = tmpdate.day) /\ (tmpdate1.month = tmpdate.month) /\ (tmpdate1.year = tmpdate.year) ) do begin
output := output + 1;
if tmpdate.day < months[tmpdate.month] then
tmpdate.day := tmpdate.day + 1
else
begin
tmpdate.day := 1;
if tmpdate.month < 12 then
tmpdate.month := tmpdate.month + 1
else
begin
tmpdate.month := 1;
tmpdate.year := tmpdate.year + 1
end
end
end;
end;
! Main Program - Test "class"
! ---------------------------
var str1: String;
var str2: String;
var x: Integer;
var datum : Date;
var datum2 : Date;
var zeit: Time
in begin
! Test Date creator
datum := createDate(14, 5, 1977);
putdate(datum); puteol();
! Test Time creator
zeit := createTime(4, 8, 33);
puttime(zeit, 1); puteol();
puttime(zeit, 2); puteol();
! String tests
readstring(var str2);
!str2.Str[0] := 'y'; str2.Str[1] := 'y'; str2.Str[2] := 'y'; str2.Str[3] := '\';
str1.Str[0] := 'x'; str1.Str[1] := 'x'; str1.Str[2] := 'x'; str1.Str[3] := '\';
strcat(var str2, var str1);
putstring(var str2); puteol();
strlen(str2, var x);
putint(x); puteol();
strrev(var str2);
putstring(var str2); puteol();
datum2 := createDate(14, 5, 2006);
diffdays(datum, datum2, var x);
putint(x);
end

View File

@ -0,0 +1,12 @@
Autor:
Matthäus Martynus
Funktion des Programms:
Mehrfache Anwendung des Djikstra-Algorithmus um alle kürzesten Wege zwischen
jeweils zwei Knoten zu berechnen.
Bedienung des Programms:
Eingabe des Graphen wie in den drei Beispiel-Files (testgraph[1-3].txt). Die
Anzahl der Knoten ist auf 40 beschränkt. Von jedem Knoten dürfen maximal 10
Kanten ausgehen. Als Ausgabe kommt eine Tabelle wie sie in den drei Ausgabe-
Files (Result[1-3].txt) zu sehen ist.

View File

@ -0,0 +1,167 @@
let
! record for storing a directed edge
type Edge ~ record
endNodeID: Integer,
distance: Integer
end;
! record for storing all outgoing edges of a node
type EdgeArray ~ record
content: array 10 of Edge,
length: Integer
end;
! record for storing a node with his current state and his edges
type Node ~ record
label: Integer,
permanent: Boolean,
edges: EdgeArray
end;
! record for storing all nodes
type NodeArray ~ record
content: array 40 of Node,
length: Integer
end;
! procedure for initiating the nodes for Djikstra-phase
proc iniNodes(var nodes: NodeArray) ~
let
var i: Integer
in begin
i := 0;
while i < nodes.length do begin
nodes.content[i].label := maxint;
nodes.content[i].permanent := false;
i := i + 1;
end;
end;
! procedure for reading the graph from the standard input
proc readGraph(var nodes: NodeArray) ~
let
! procedure for adding an edge to the array
proc addEdge(var edges: EdgeArray, e: Edge) ~
begin
edges.content[edges.length].endNodeID := e.endNodeID;
edges.content[edges.length].distance := e.distance;
edges.length := edges.length + 1;
end;
var i: Integer;
var startID: Integer;
var endID: Integer;
var distance: Integer;
var edge: Edge;
var testeof : Boolean
in begin
! reading nodecount
getint(var nodes.length);
! initiating edge-arrays
i := 0;
while i < nodes.length do begin
nodes.content[i].edges.length := 0;
i := i + 1;
end;
! reading edges
eof(var testeof);
while \ testeof do begin
! reading an edge
getint(var startID);
getint(var endID);
getint(var distance);
edge.endNodeID := endID;
edge.distance := distance;
! adding the Edge to the array
addEdge(var nodes.content[startID].edges, edge);
eof(var testeof);
end;
end;
! procedure for writing the results of a Djikstra-phase to the standard output
proc outputResults(var nodes: NodeArray, startID: Integer) ~
let
var i: Integer
in begin
i := 0;
putint(startID);
while i < nodes.length do begin
put(chr(9));
! write only the value if the node has been reached
if nodes.content[i].label < maxint then
putint(nodes.content[i].label)
else;
i := i + 1;
end;
puteol();
end;
var nodes: NodeArray;
var actID: Integer;
var destID: Integer;
var newLabel: Integer;
var n: Integer;
var i: Integer
in begin
readGraph(var nodes);
! output of the headline with the node-IDs
n := 0;
while n < nodes.length do begin
put(chr(9));
putint(n);
n := n + 1
end;
puteol();
! selection and initiation of the startNode
n := 0;
while n < nodes.length do begin
iniNodes(var nodes);
nodes.content[n].label := 0;
actID := n;
! one Djikstra-phase
while (\ nodes.content[actID].permanent) do begin
! setting node-label as permanent
nodes.content[actID].permanent := true;
i := 0;
! actualizing the labels of all neighbours
while i < nodes.content[actID].edges.length do begin
newLabel := nodes.content[actID].label + nodes.content[actID].edges.content[i].distance;
destID := nodes.content[actID].edges.content[i].endNodeID;
! path about current row is shorter, then actualize label
if nodes.content[destID].label > newLabel then
nodes.content[destID].label := newLabel
else;
i := i + 1;
end;
i := 0;
! selecting the next node
while i < nodes.length do begin
! select only nodes that are not labeled permanently
if \ nodes.content[i].permanent then
! select only nodes that already has been reached
if nodes.content[i].label < maxint then
! select the first node, that is not labeled permanently
if nodes.content[actID].permanent then
actID := i
else
! select the node with the minimal label
if nodes.content[actID].label > nodes.content[i].label then
actID := i
else
else
else;
i := i + 1;
end;
end;
outputResults(var nodes, n);
n := n + 1
end
end

View File

@ -0,0 +1,101 @@
40
0 19 10
1 33 48
1 38 57
1 6 52
2 27 48
2 4 52
2 30 61
3 31 81
3 16 62
3 37 31
4 10 14
4 8 57
4 38 55
5 36 61
5 2 84
6 28 37
7 31 26
8 38 71
8 22 37
8 3 95
8 12 30
8 36 47
10 13 94
10 11 39
11 6 83
12 33 53
12 9 50
12 0 15
13 10 94
13 19 45
13 28 58
13 34 82
14 11 36
14 20 33
14 29 73
14 3 37
14 1 70
14 17 22
15 9 8
15 5 48
15 19 48
16 5 61
16 13 62
17 23 35
17 4 48
19 27 41
19 36 30
20 32 58
20 33 54
20 6 35
21 9 75
21 32 94
22 13 37
22 5 57
22 33 65
22 18 71
23 32 67
23 4 69
23 38 23
24 4 61
24 17 17
24 36 58
25 9 85
25 38 71
25 39 79
26 34 34
26 11 59
26 6 37
26 23 51
27 23 33
27 12 44
28 36 18
29 25 65
29 30 85
29 33 91
30 25 35
31 18 49
31 38 66
32 28 59
32 2 38
33 15 74
33 26 51
33 11 18
33 23 61
33 35 62
34 23 85
35 8 37
35 10 42
36 2 42
36 21 24
36 30 21
36 38 47
37 39 89
38 27 52
38 7 71
38 11 30
38 37 43
38 23 23
39 11 85
39 1 72

View File

@ -0,0 +1,101 @@
40
0 28 50
0 11 97
0 30 73
0 19 79
0 16 73
2 18 73
2 9 26
4 27 88
4 36 86
4 23 55
4 26 39
5 20 72
6 24 69
7 9 15
7 22 65
7 16 50
8 13 87
8 22 78
9 6 15
9 25 67
9 35 38
10 35 14
10 23 19
10 8 66
10 7 52
10 9 50
10 19 37
11 29 61
11 23 41
12 5 16
12 33 59
12 11 32
12 14 55
12 32 28
12 25 37
12 30 36
13 7 73
13 5 40
13 32 59
14 24 68
14 27 62
15 19 84
16 18 85
16 37 31
16 33 53
17 25 94
18 38 97
18 1 30
18 31 99
18 2 73
19 38 56
19 10 37
20 30 88
20 36 34
20 26 55
21 25 29
22 2 81
22 36 106
22 31 61
22 1 76
22 10 22
23 17 57
24 17 55
24 31 79
25 7 73
25 27 20
26 3 69
26 18 77
26 10 34
26 0 72
26 19 70
26 33 29
27 38 27
27 34 28
27 4 88
27 15 91
28 38 78
29 14 43
29 22 51
30 7 77
30 29 65
30 35 47
30 5 21
30 19 8
30 32 32
31 1 73
31 33 13
32 28 67
32 29 40
32 34 31
32 31 85
32 38 55
34 10 10
36 6 82
36 16 86
37 3 29
37 1 31
37 2 69
38 21 37
39 13 64

View File

@ -0,0 +1,101 @@
40
0 15 62
0 18 65
0 9 70
0 30 32
0 14 75
1 30 50
1 36 97
2 30 76
2 6 91
2 27 8
2 0 84
3 7 76
3 37 33
3 20 75
5 25 32
5 8 63
5 31 37
5 13 29
5 35 47
6 7 39
6 17 42
6 11 78
7 22 5
8 0 85
8 12 68
8 5 63
10 16 87
11 21 19
12 19 44
12 6 17
12 17 52
12 20 46
13 25 60
13 24 85
13 16 70
14 8 35
14 33 41
14 39 43
14 28 54
15 13 22
15 14 95
16 10 87
16 12 62
16 21 42
17 37 100
18 15 81
18 30 59
18 38 51
19 4 37
19 2 43
19 11 37
19 28 9
20 33 36
20 1 12
21 13 91
21 14 11
22 10 6
22 20 12
22 30 53
22 0 84
23 30 45
23 33 19
23 34 25
23 39 16
24 26 52
24 37 37
24 34 72
24 3 69
25 35 35
26 23 30
26 19 43
26 12 31
28 21 48
28 38 60
28 14 54
28 31 63
29 26 5
30 3 22
30 22 53
31 35 28
32 10 60
34 19 27
35 28 45
35 39 28
35 18 5
35 38 47
35 24 51
35 34 22
36 14 60
36 8 87
36 37 39
36 30 72
37 0 11
37 16 35
37 26 26
37 22 87
38 24 49
38 15 53
39 7 56
39 19 26

View File

@ -0,0 +1,8 @@
Autor: Nicolas Weber
Implementiert den Bresenham-Linien-Zeichnen-Algorithmus. Trickst ein bisschen,
um mit Triangles kleinem Speicher zurechtzukommen. Gibt ein Bild im .pgm-Format
auf stdin aus.
Das Programm erzeugt immer die selbe Ausgabe, die in der Datei out.pgm
beiliegt.

View File

@ -0,0 +1,323 @@
! Creates a simple 54x50 image and writes to stdout (it pgm format).
! usage:
! java TAM.Interpreter obj.tam | grep -v "\*" > out.pgm
! xv out.pgm
let
type PackedPixel ~ Integer; !three pixels packed into an int
type Byte ~ Integer; !one pixel
! The Triangle code emitter is a bit strange: A single record
! may not be larger than 255 words. Thus, if we would define
! an Image record consisting of an Integer for width and
! height and a data array, the data array could contain 254 elements
! at most -- barely enough for a 15x15 image.
! Because of this, the following records are needed to support
! images with somewhat larger dimensions.
! [For even larget images, some more records could be used (a Tile
! is an array of Scanlines, an Image is an array of Tiles), but
! the stupid Triangle interpreter has a maximal data store size of
! 1024 words (!!) anyways and segfaults if our image data is larger
! than that.]
! To leave room for 32 local variables, the image data
! size is maximal 4*225 = 900 bytes -- 30x30 pixels, not *that* much better...
! (this has at least the benefit that we don't have to fear overflow
! in expressions like y*width + x :-P )
! A Triangle integer is 16 bit - because they are signed, using only
! the lower 15 bits is easier (this way, they are always non-negative).
! To increase the maximal image size a bit more, we store three 5bit pixels
! in one Integer (this gives us only 32 gray levels, but that's worth it).
! This way we get 900*3 = 2700 pixels - a 54x50 image.
const BUFFERSIZE ~ 225;
const PIXSIZE ~ 3*BUFFERSIZE; !3 values in one "pixel"
type Buffer ~ record
! size should match BUFFERSIZE (Triangle needs an integer literal,
! I can't use BUFFERSIZE here :-( )
data : array 225 of PackedPixel
end;
type Image ~ record
! grayscale image
buffer : array 4 of Buffer,
width : Integer,
height: Integer
end;
proc createImage(var image : Image, w : Integer, h : Integer) ~
begin
!check if it fits into mem, halt program if not
if w*h > (4*PIXSIZE) then
let
var bla : Integer
in begin
put('x'); puteol();
bla := 30000;
bla := 30000*bla; !integer overflow will halt program
end else ;
image.width := w;
image.height := h;
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! bit fiddling stuff
func pow2(v : Integer) : Integer ~
if v = 0 then 1 else 2*pow2(v - 1);
! g is 0, 1 or 2 to select one of the three pixels
func getGroup(p : PackedPixel, g : Integer) : Byte ~
(p / pow2(g*5)) // 32;
! v has to be < 32
!func setGroup(p : Pixel, v : Byte, g : Integer) : Pixel ~
! ! don't factor pow2(g*5) to prevent negative numbers
! (p - getGroup(p, g)*pow2(g*5)) + v*pow2(g*5);
!for whatever reasons the above code gives an overflow all the time.
!it works with a local variable, though. Triangle rocks.
proc setGroup(var p : PackedPixel, v : Byte, g : Integer) ~
let
! required to work around some Triangle bug...
var tmp : Integer
in begin
! clear old bits
tmp := getGroup(p, g)*pow2(g*5);
p := p - tmp;
! set new bits
if v < 31 then tmp := v else tmp := 31;
tmp := tmp*pow2(g*5);
p := p + tmp
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! set/get a single pixel
! proc setPixel(var image : Image, x : Integer, y : Integer, value : Integer) ~
! let
! var address : Integer
! in begin
! address := y*image.width + x;
! image.buffer[address / BUFFERSIZE].data[address // BUFFERSIZE] := value;
! end;
!
! func getPixel(image : Image, x : Integer, y : Integer) : Pixel ~
! image.buffer[ (y*image.width + x) / BUFFERSIZE ].
! data[ (y*image.width + x) // BUFFERSIZE ];
! MIST: das da oben geht nicht, weil Triangle nicht will, das einzelne
! Argumente groesser als 255 Woerter sind. Also so:
proc setPixel(x : Integer, y : Integer, w : Integer,
var buff0 : Buffer, var buff1 : Buffer,
var buff2 : Buffer, var buff3 : Buffer, value : Byte) ~
let
var address : Integer
in begin
address := y*w + x;
if address / PIXSIZE = 0 then
setGroup(var buff0.data[(address // PIXSIZE) / 3], value,
(address // PIXSIZE) // 3)
else if address / PIXSIZE = 1 then
setGroup(var buff1.data[(address // PIXSIZE) / 3], value,
(address // PIXSIZE) // 3)
else if address / PIXSIZE = 2 then
setGroup(var buff2.data[(address // PIXSIZE) / 3], value,
(address // PIXSIZE) // 3)
else if address / PIXSIZE = 3 then
setGroup(var buff3.data[(address // PIXSIZE) / 3], value,
(address // PIXSIZE) // 3)
else
end;
! the buffn's aren't changed, but if we don't pass them by reference,
! Triangle tries to copy them before passing them to the function.
! This overflows the data store, so we pass by reference to avoid
! the copy
func getPixel(x : Integer, y : Integer, w : Integer,
var buff0 : Buffer, var buff1 : Buffer,
var buff2 : Buffer, var buff3 : Buffer) : Byte ~
if (y*w + x) / PIXSIZE = 0 then
getGroup(buff0.data[((y*w + x) // PIXSIZE) / 3],
((y*w + x) // PIXSIZE) // 3)
else if (y*w + x) / PIXSIZE = 1 then
getGroup(buff1.data[((y*w + x) // PIXSIZE) / 3],
((y*w + x) // PIXSIZE) // 3)
else if (y*w + x) / PIXSIZE = 2 then
getGroup(buff2.data[((y*w + x) // PIXSIZE) / 3],
((y*w + x) // PIXSIZE) // 3)
else if (y*w + x) / PIXSIZE = 3 then
getGroup(buff3.data[((y*w + x) // PIXSIZE) / 3],
((y*w + x) // PIXSIZE) // 3)
else
0;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! save image
proc writePbmAscii(w : Integer, h : Integer,
var buff0 : Buffer, var buff1 : Buffer,
var buff2 : Buffer, var buff3 : Buffer) ~
let
var x : Integer;
var y : Integer
in begin
!write header
put('P'); put('2'); puteol(); !format id
putint(w); put(' '); putint(h); puteol(); !size
putint(31); puteol(); !maximum gray value
!write data
y := 0;
while y < h do begin
x := 0;
while x < w do begin
putint(getPixel(x, y, w, var buff0, var buff1, var buff2, var buff3));
put(' ');
x := x + 1
end;
puteol();
y := y + 1
end;
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! line drawing
proc incPixel(x : Integer, y : Integer, w : Integer,
var buff0 : Buffer, var buff1 : Buffer,
var buff2 : Buffer, var buff3 : Buffer) ~
setPixel(x, y, w, var buff0, var buff1, var buff2, var buff3,
getPixel(x, y, w, var buff0, var buff1, var buff2, var buff3) + 9);
! draws a line with the bresenham algorithm. increments pixels drawn.
! doesn't clip the line, so pass only valid coords!
! start and end points are both inclusive.
proc drawLine(x1 : Integer, y1 : Integer, x2 : Integer, y2 : Integer,
w : Integer, var buff0 : Buffer, var buff1 : Buffer,
var buff2 : Buffer, var buff3 : Buffer) ~
let
var xLength : Integer;
var yLength : Integer;
var dx : Integer;
var dy : Integer;
var error : Integer;
var i : Integer;
var xCoord : Integer;
var yCoord : Integer
in begin
xCoord := x1;
yCoord := y1;
error := 0;
xLength := x2 - x1;
if xLength < 0 then
begin
xLength := 0 - xLength;
dx := 0 - 1;
end
else
dx := 1;
yLength := y2 - y1;
if yLength < 0 then
begin
yLength := 0 - yLength;
dy := 0 - 1;
end
else
dy := 1;
if xLength < yLength then !m > 1
begin
i := 0;
while i <= yLength do
begin
incPixel(xCoord, yCoord, w, var buff0, var buff1, var buff2, var buff3);
yCoord := yCoord + dy;
error := error + xLength;
if error >= yLength then
begin
xCoord := xCoord + dx;
error := error - yLength;
end else;
i := i + 1
end;
end
else !m <= 1
begin
i := 0;
while i <= xLength do
begin
incPixel(xCoord, yCoord, w, var buff0, var buff1, var buff2, var buff3);
xCoord := xCoord + dx;
error := error + yLength;
if error >= xLength then
begin
yCoord := yCoord + dy;
error := error - xLength;
end else;
i := i + 1
end;
end;
end;
const STEPS ~ 10;
var image : Image;
var i : Integer;
var j : Integer
in begin
! draw a fancy image
createImage(var image, 54, 50);
i := 0;
while i < STEPS do begin
drawLine((i*image.width)/STEPS, 0,
0, image.height - 1 - ((i*image.height)/STEPS),
image.width,
var image.buffer[0], var image.buffer[1],
var image.buffer[2], var image.buffer[3]);
drawLine((i*image.width)/STEPS, 0,
image.width - 1, (i*image.height)/STEPS,
image.width,
var image.buffer[0], var image.buffer[1],
var image.buffer[2], var image.buffer[3]);
drawLine((i*image.width)/STEPS, image.height - 1,
image.width - 1, image.height - 1 - ((i*image.height)/STEPS),
image.width,
var image.buffer[0], var image.buffer[1],
var image.buffer[2], var image.buffer[3]);
drawLine((i*image.width)/STEPS, image.height - 1,
0, (i*image.height)/STEPS,
image.width,
var image.buffer[0], var image.buffer[1],
var image.buffer[2], var image.buffer[3]);
i := i + 1
end;
writePbmAscii(image.width, image.height,
var image.buffer[0], var image.buffer[1],
var image.buffer[2], var image.buffer[3])
! testing code:
!setPixel(50, 48, image.width, var image.buffer[0], var image.buffer[1], var image.buffer[2], var image.buffer[3], 15);
!putint(getPixel(50, 48, image.width, var image.buffer[0], var image.buffer[1], var image.buffer[2], var image.buffer[3]));
! i := 30000;
! setGroup(var i, 31, 2);
! putint(getGroup(i, 2));
end

View File

@ -0,0 +1,191 @@
let
var code : array 16 of Integer;
var bits : array 8 of Boolean;
var bitP : Integer;
var iseof : Boolean;
var i : Integer;
var tmpbool : Boolean;
var tmpchar : Char;
var tmpcode : array 16 of Integer;
! Realisiert das bitweise Einlesen von der Eingabe.
! Hierzu wird immer ein Char gelesen, dieses als Integer dargestellt
! und schließlich in die Bitdarstellung übeführt und im Boolean-Array Bits abgelegt.
! Nacheinander wird nun ein Bit gelesen, bis der Pointer nicht mehr im Bits-Array steht.
! Nun wird das nächste Char von der Eingabe gelesen.
! Wird das Dateinde erreicht wird das mittels iseof markiert.
proc getBit(var b : Boolean) ~
let
var tmpchar : Char;
var tmpint : Integer;
var j : Integer
in begin
!put('g');
if bitP = 8 then
begin
get(var tmpchar);
tmpint := ord(tmpchar);
if tmpint = (0 - 1) then iseof := true
else begin
j := 0;
while j < 8
do begin
if tmpint // 2 = 1 then
begin
bits[7 - j] := true;
tmpint := tmpint - 1;
end else
bits[7 - j] := false;
tmpint := tmpint / 8;
j := j + 1;
end;
end;
bitP := 0;
end
else ;
b := bits[bitP];
bitP := bitP + 1
end;
! Realisiert das Schreiben von 4-Bit-Wörtern in die Ausgabe.
! Wurden 2 4-Bit-Wörter geschrieben, wird beides als 8-Bit-Char ausgegeben.
var writeHigh : Boolean;
var writeByte : Integer;
proc write(x : Integer) ~
begin
!put('w');
if writeHigh = true then
begin
writeByte := x * 16;
writeHigh := false;
end
else begin
writeByte := writeByte + x;
put(chr(writeByte));
writeByte := 0;
writeHigh := true;
end;
end
in begin
! Initalisierungen
bitP := 8;
writeHigh := true;
writeByte := 0;
! Zunächst die Codierung einlesen
i := 0;
while i < 16
do begin
get(var tmpchar);
tmpcode[i] := ord(tmpchar);
!putint(tmpcode[i]);
!put(',');
i := i + 1;
end;
! Nun Code richtig rum sortieren
i := 0;
while i < 16
do begin
code[tmpcode[i]] := i;
i := i + 1
end;
getBit(var tmpbool);
while \iseof
do begin
!put('a');
! Fallunterscheidungen für Codierung
if tmpbool = true then !1
begin
getBit(var tmpbool);
if tmpbool = true then !11
begin
getBit(var tmpbool);
if tmpbool = true then !111
begin
getBit(var tmpbool);
if tmpbool = true then !1111
begin
getBit(var tmpbool);
if tmpbool = true then !11111
begin
getBit(var tmpbool);
if tmpbool = true then !111111
begin
getBit(var tmpbool);
if tmpbool = true then !1111111
i := 0
else !1111110
i := 1
end else !111110
i := 2
end else !11110
i := 7
end else !1110
i := 12
end else !110
begin
getBit(var tmpbool);
if tmpbool = true then !1101
i := 10
else !1100
i := 11
end
end else !10
begin
getBit(var tmpbool);
if tmpbool = true then !101
begin
getBit(var tmpbool);
if tmpbool = true then !1011
begin
getBit(var tmpbool);
if tmpbool = true then !10111
i := 5
else !10110
i := 6
end else !1010
i := 9
end else !100
i := 14
end
end else !0
begin
getBit(var tmpbool);
if tmpbool = true then !01
begin
getBit(var tmpbool);
if tmpbool = true then !010
i := 13
else !011
begin
getBit(var tmpbool);
if tmpbool = true then !0110
i := 8
else !0111
begin
getBit(var tmpbool);
if tmpbool = true then !01110
i := 4
else !01111
i := 3
end
end
end else !00
i := 15
end;
write(code[i]);
getBit(var tmpbool);
end
end

View File

@ -0,0 +1,22 @@
; [file: eqtest.tasm, started: 13-Apr-2003, version: 16-Apr-2004]
; TAM Assembler program which reads two numbers and prints 'Y' if
; the two numbers are equal and prints 'N' if the numbers are not equal.
PUSH 2 ; reserve space for the 2 numbers
LOADA 0[SB] ; address of n0: 0[SB]
CALL getint ; read number into n0
LOADA 1[SB] ; address of n1: 1[SB]
CALL getint ; read number into n1
LOAD(1) 0[SB] ; load number n0
LOAD(1) 1[SB] ; load number n1
LOADL 1 ; size of the arguments is 1
CALL eq ; n0 == n1 ?
JUMPIF(0) L1[CB] ; if !(n0 == n1) then goto L1
LOADL 89 ; load 'Y' on the stack
CALL put ; print 'Y'
JUMP L2[CB] ; jump over 'N' part.
L1: LOADL 78 ; load 'N' on the stack
CALL put ; print 'N'
L2: POP(0) 2 ; pops the 2 numbers
HALT

View File

@ -0,0 +1,21 @@
Titel: Das Sieb von Eratosthenes
Autor: Stefan Kropp
Funktion:
Dieses Triangle Programm implementiert eine Variante des Siebs von Eratosthenes
zum Finden von Primzahlen bis zu einer oberen Schranke n.
Es wurde eine Variante verwendet, die immmer nur einen Zahlenabschnitt der Größe
UPPERBOUND (die Größe des Boolschen Arrays) bearbeitet. Dies war nötig, um die
Restriktionen der Parametergröße zu umgehen. (übergebene Parameter dürfen nicht
größer als 255 words groß sein) Jeder bearbeitete Abschnitt wird dann in die
Datei geschrieben. Dies wird solange wiederholt, bis die obere Schranke n
schließlich erreicht wurde.
Bedienung:
Es sind keine Eingaben nötig. Das Programm läuft selbstständig ab und schreibt
alle gefundenen Primzahlen bis zur oberen Schranke MAXPRIM in die Datei prim.txt.
Alle Parameter sind im Programm als Konstanten hardcodiert und können dort nach
Belieben verändert werden. Es wird die Triangle Version mit File Support benötigt.

View File

@ -0,0 +1,113 @@
! @author: Stefan Kropp
let
const MAXPRIM ~ 32750; ! Obere Grenze der Primzahlsuche
const UPPERBOUND ~ 250; ! Größe des BoolArrays
type BoolArray ~ array 250 of Boolean;
var numbers : BoolArray;
! Setzt das Element mit dem Index index des Arrays Array auf den Wert bool
proc setArrayElement(var Array : BoolArray, index : Integer, bool : Boolean) ~
begin
if (index >= 0) \/ (index < UPPERBOUND)
then
Array[index] := bool
else
end;
! Setzt alle Werte des Arrays auf true
proc initArray(var Array : BoolArray) ~
let
var count : Integer
in begin
count := 0;
while count < UPPERBOUND
do begin
setArrayElement(var Array, count, true);
count := count + 1
end
end;
! Streicht Vielfache der Zahl number aus dem Array, indem der jeweilige
! Index auf false gesetzt wird. Dabei wird erst beim start-Wert angefangen
! zu streichen, um auch größere Werte als 255 zu bearbeiten.
proc eraseMultiples(var Array : BoolArray, number : Integer, start : Integer) ~
let
var multiples : Integer
in begin
! Mit number^2 anfangen, kleinere Werte sind bereits gestrichen worden
multiples := number * number;
while multiples < (start + UPPERBOUND)
do begin
! Erst einmal die Vielfachen erhöhen, bis sie überhaupt den start-Wert erreicht haben
if multiples > (start - 1)
then
setArrayElement(var Array, multiples - start, false)
else ;
multiples := multiples + number
end
end;
type String ~ array 20 of Char;
var filename : String;
! Initialisiert den Dateinamen für die Ausgabedatei auf 'prim.txt'
proc initFilename(var file : String) ~
begin
file[0] := 'p'; file[1] := 'r'; file[2] := 'i';
file[3] := 'm'; file[4] := '.'; file[5] := 't';
file[6] := 'x'; file[7] := 't'; file[8] := chr(0);
end;
! Schreibt das übergebene Array in die Datei mit dem übergebenen Filehandle.
! Dabei wird der start-Wert auf den Array-Index aufaddiert
proc printPrimToFile(numbers : BoolArray, filehandle : Integer, start : Integer) ~
let
var count : Integer
in begin
count := 0;
if filehandle > (0 - 1)
then
while count < UPPERBOUND
do begin
if (numbers[count] = true)
then
begin
fputint(filehandle, count + start);
fputeol(filehandle)
end
else ;
count := count + 1
end
else ;
end;
var filehandle : Integer;
var maxNumber : Integer;
var actualNumber : Integer
in begin
initFilename(var filename);
fopen(var filehandle, filename, true);
maxNumber := UPPERBOUND;
while maxNumber < MAXPRIM
do begin
! Mit 2 anfangen, Vielfache von 1 sind nicht interessant
actualNumber := 2;
initArray(var numbers);
! Nur so lange streichen, wie actualNumber^2 kleiner als die maxNumber ist
while (actualNumber * actualNumber) < maxNumber
do begin
eraseMultiples(var numbers, actualNumber, maxNumber - UPPERBOUND + 1);
actualNumber := actualNumber + 1
end;
printPrimToFile(numbers, filehandle, maxNumber - UPPERBOUND + 1);
maxNumber := maxNumber + UPPERBOUND
end;
fclose(filehandle)
end

View File

@ -0,0 +1,9 @@
let
const MAX ~ 10;
var n: Integer
in begin
putint(4*5+2);
puteol();
putint(2+4*5);
puteol();
end

View File

@ -0,0 +1,167 @@
Beschreibung des Programmes "Faktorisierung"
Autor: Alexander Stolfik
Funktion des Programmes:
Das Programm zerlegt eine natürliche Zahl n, die zwischen 0 und 10^16 liegt,
in Faktoren mit der folgenden Eigenschaft:
1. Besitzt die Zahl n Primfaktoren, die kleiner als 200 sind, werden diese Primfaktoren
mit Ihren entsprechenden Exponenten in der Struktur Fz gespeichert.
2. Falls diese Zahl noch Primfaktoren besitzt die größer zweihundert sind, werden
diese nicht mehr gepeichert, sondern nur der sogenannte Restfaktor.
Der Restfakor ist der Faktor der übrigbleibt, wenn mann alle Primfaktoren,
die kleiner 200 sind, von n dividiert.
Anmerkung: Der Algorithmus der die Faktoriesierung berechnet ist ein sehr primitiver
Algorithmus, aber ich denke für die Zwecke dieser Vorlesung ist er
gut geeignet.
Dies wird mit einer neuen Datenstruktur BigInt realsiert, auf der ich folgende Operationen
implementiert habe:
proc convertBI(a: Integer, var biga: BigInt)~
Eingabe: a: Integer, biga:BigInt
Der Integer a wird in den BigInt biga geschrieben
proc convertBI2(a: Integer, b: Integer, c: Integer, d: Integer, var biga: BigInt)~
Eingabe: a,b,c,d: Integer, biga:BigInt
Die Integer a,b,c,d werden in einen BigInt nach folgender Vorschrift
convertiert:
biga=(a mod 10000)*10^12 + (b mod 10000)*10^8 + (c mod 10000)*10^4 + (d mod 10000)
proc zeigeBI(a: BigInt)~
Ausgabe des BigInts a auf dem Bildschirm
proc addBI(a: BigInt, b: BigInt,var erg: BigInt)~
erg:=a+b;
proc copyBI(a: BigInt, var erg: BigInt)~
erg:=a;
proc modBI(a: BigInt, mod: Integer, var erg: Integer)~
erg:=a // mod;
proc divBI(a: BigInt, div: Integer, var erg: BigInt)~
erg:=a / div;
Bedienung des Programmes:
Nach Start des Programmes, werden von dem Programm vier Zahlen gefragt, die zwischen
0 und 9999 liegen können. Diese Vier Zahlen werden dann konkateniert und in einen BigInt
konvertiert.
Falls grösser Zahlen eingegeben werden, werden sie trotzdem Modulo 10000 gerechent, d.h.
solange man nicht den Wertebreich eines Integers überschreitet wird es keine Fehlermeldung
geben.
Als Ausgabe erhält man dann die Faktorzerlegung der Primzahlen unter 200, den Restfaktor
und die Eingabe angezeigt.
Beispieleingaben und erwartete Ausgaben:
1. Beipspiel
Eingabe:
1. :0
2. :7
3. :5891
4. :2000
Ausgabe:
Faktorisierung:
p e
2 10
5 3
7 2
11 2
Restfaktor:
1
Eingabe:
7.5891.2000
2. Beipspiel
Eingabe:
1. :0
2. :0
3. :2398
4. :37895642
Ausgabe:
Faktorisierung:
p e
2 1
3 1
23 1
179 1
Restfaktor:
971
Eingabe:
2398.5642
3. Beipspiel
Eingabe:
1. :0
2. :1
3. :0
4. :0
Ausgabe:
Faktorisierung:
p e
2 8
5 8
Restfaktor:
1
Eingabe:
1.0000.0000

View File

@ -0,0 +1,498 @@
let
type BigInt ~ record
length: Integer,
zahl: array 30 of Integer
end;
! Realisierung einer Primzahlzerlegung
! length = Länge des Array
! prim: Array der die Primzahlen speichert
! exp: Der Exponent der Primzahlen
! Beispiel für 14625=3^2 * 5^3 * 13
! length = 3
! Index 0 1 2
! prim 3 5 13
! exp 2 3 1
type Fz ~ record
length: Integer,
zahl: BigInt,
rest: BigInt,
prim: array 80 of Integer,
exp: array 80 of Integer
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! max
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! max(a: Integer,b: Integer): Integer gibt das Maximum von a oder b zurück
func max(a: Integer,b: Integer): Integer ~
if a>b
then a
else b;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! min
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! min(a: Integer,b: Integer): Integer gibt das Minimum von a oder b zurück
func min(a: Integer,b: Integer): Integer ~
if a>b
then b
else a;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! convertBI
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! convertBI(a: Integer, var biga: BigInt)
proc convertBI(a: Integer, var biga: BigInt)~
let
var i: Integer;
var acopy: Integer
in begin
acopy:=a;
i:=0;
while acopy > 0 do begin
biga.zahl[i]:=acopy//100;
acopy:=acopy/100;
i:=i+1;
end;
biga.length:=i;
while i<30 do begin
biga.zahl[i]:=0;
i:=i+1;
end
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! convertBI
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! convertBI(a: Integer, var biga: BigInt)
proc convertBI2(a: Integer, b: Integer, c: Integer, d: Integer, var biga: BigInt)~
let
var i: Integer;
var lange: Integer;
var copy: Integer
in begin
lange:=0;
copy:=d;
convertBI(0,var biga);
biga.zahl[0]:=copy//100;
biga.zahl[1]:=(copy/100)//100;
copy:=c;
biga.zahl[2]:=copy//100;
biga.zahl[3]:=(copy/100)//100;
copy:=b;
biga.zahl[4]:=copy//100;
biga.zahl[5]:=(copy/100)//100;
copy:=a;
biga.zahl[6]:=copy//100;
biga.zahl[7]:=(copy/100)//100;
i:=7;
while i>0 do begin
if biga.zahl[i-1]>0
then begin
biga.length:=i;
i:=0
end
else i:=i-1
end
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! zeigeBI
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! zeigeBI(a: BigInt)
proc zeigeBI(a: BigInt)~
let
var i: Integer;
var kleiner: Integer
in begin
i:=a.length;
if i=0
then putint(0)
else;
kleiner:=0;
while i>0 do begin
if (i//2)=0 /\ (i < a.length)
then put('.')
else;
if (a.zahl[i-1]<10) /\ (i < a.length)
then putint(0)
else;
putint(a.zahl[i-1]);
i:=i-1
end;
puteol()
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! addBI
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! addBI(a: BigInt, b: BigInt, erg: BigInt)
proc addBI(a: BigInt, b: BigInt,var erg: BigInt)~
let
var length: Integer;
var i: Integer
in begin
length:=max(a.length,b.length);
i:=0;
convertBI(0,var erg);
while i<length do begin
erg.zahl[i]:=((a.zahl[i]+b.zahl[i])//100)+erg.zahl[i];
if i<29 then
erg.zahl[i+1]:=(a.zahl[i]+b.zahl[i])/100
else;
i:=i+1
end;
if erg.zahl[i]>0
then erg.length:=i+1
else erg.length:=i;
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! minBI
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! minBI(a: BigInt, b: BigInt, erg: BigInt)
proc minBI(a: BigInt, b: BigInt,var erg: BigInt)~
let
var length: Integer;
var i: Integer;
var uber: Integer
in begin
convertBI(0,var erg);
uber:=0;
i:=0;
if a.length < b.length
then
else begin
while i<a.length do begin
if a.zahl[i] < (b.zahl[i]+uber)
then begin
erg.zahl[i]:=100-b.zahl[i]-uber+a.zahl[i];
uber:=1;
end
else begin
erg.zahl[i]:=a.zahl[i]-uber-b.zahl[i];
uber:=0;
end;
i:=i+1
end;
if uber=1
then convertBI(0, var erg)
else;
i:=a.length;
while i>0 do begin
if erg.zahl[i-1]>0
then begin
erg.length:=i;
i:=0
end
else i:=i-1
end
end
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! copyBI
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! copyBI(a: BigInt, b: BigInt, erg: BigInt)
proc copyBI(a: BigInt, var erg: BigInt)~
let
var i:Integer
in begin
i:=0;
erg.length:=a.length;
while i<a.length do begin
erg.zahl[i]:=a.zahl[i];
i:=i+1
end;
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! modBI
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! modBI(a: BigInt, mod: Integer, var erg: Integer) berechnet aus einem
proc modBI(a: BigInt, mod: Integer, var erg: Integer)~
let
var i: Integer;
var faktor: Integer;
var wert: Integer;
var j: Integer
in begin
i:=0;
erg:=0;
faktor:=1;
while i<a.length do begin
j:=0;
faktor:=1;
while j<i do begin
faktor:=(faktor*100)//mod;
j:=j+1;
end;
wert:=(a.zahl[i]*faktor)//mod;
erg:=(wert + erg)//mod;
i:=i+1
end
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! divBI
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! divBI(a: BigInt, div: Integer, var erg: BigInt) berechnet aus einem
proc divBI(a: BigInt, div: Integer, var erg: BigInt)~
let
var i: Integer;
var divisor: Integer;
var rest: Integer;
var wert: Integer;
var j: Integer
in begin
i:=a.length;
convertBI(0,var erg);
divisor:=0;
while i>0 do begin
divisor:=(divisor*100)+a.zahl[i-1];
erg.zahl[i-1]:=divisor/div;
divisor:=divisor//div;
i:=i-1
end;
i:=a.length;
while i>0 do begin
if erg.zahl[i-1]>0
then begin
erg.length:=i;
i:=0
end
else i:=i-1
end
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! istPrim
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!nach istprim(p:int,prim:int) prim=1 , falls p eine Primzahl ist
!nach istPrim(p:int,prim:int) prim=0 , falls p keine Primzahl ist
proc istPrim(x: Integer, var prim: Integer) ~
let
var i: Integer
in begin
i:=2;
prim:=1;
while (i<x) /\ (prim=1) do begin
if x//i = 0
then prim:=0
else i:=i+1
end
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! gibFZ
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! gibFZ(p:BigInt,faktor:Fz) zerlegt den Integer p in seine Primfaktoren und
! speichert diese Zerlegung in Fz ab
proc gibFZ(p: BigInt,var faktor:Fz)~
let
var zahl: Integer;
var prim: Integer;
var index: Integer;
var pcopy: BigInt;
var temp: BigInt;
var rest: Integer
in begin
zahl:=2;
index:=0;
copyBI(p,var pcopy);
convertBI(0,var temp);
copyBI(p,var faktor.zahl);
while ((pcopy.zahl[0] > 1) \/ (pcopy.length > 1)) /\ (zahl < 200) do begin
istPrim(zahl,var prim);
if prim=1
then begin
modBI(pcopy,zahl,var rest);
if rest = 0
then begin
faktor.prim[index]:=zahl;
faktor.exp[index]:=0;
while rest = 0 do begin
faktor.exp[index]:=faktor.exp[index]+1;
divBI(pcopy,zahl,var temp);
copyBI(temp,var pcopy);
modBI(pcopy,zahl,var rest);
end;
index:=index+1
end
else zahl:=zahl+1
end
else zahl:=zahl+1
end;
faktor.length:=index;
if zahl=200
then copyBI(pcopy,var faktor.rest)
else convertBI(0,var faktor.rest)
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! zeigeFZ
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! zeigeFZ(faktor:Fz) zeigt die Faktorzelegung an prim*10000+exp
proc zeigeFZ(faktor: Fz) ~
let
var i: Integer;
var j: Integer;
var t: Integer;
var leer: Char
in begin
i:=0;
t:=faktor.length;
leer:=' ';
put('F');
put('a');
put('k');
put('t');
put('o');
put('r');
put('i');
put('s');
put('i');
put('e');
put('r');
put('u');
put('n');
put('g');
put(':');
puteol();
put('p');
put(leer);
put(leer);
put(leer);
put('e');
puteol();
while i<t do begin
putint(faktor.prim[i]);
put(leer);
put(leer);
put(leer);
putint(faktor.exp[i]);
puteol();
i:=i+1
end;
puteol();
puteol();
put('R');
put('e');
put('s');
put('t');
put('f');
put('a');
put('k');
put('t');
put('o');
put('r');
put(':');
puteol();
zeigeBI(faktor.rest);
puteol();
put('E');
put('i');
put('n');
put('g');
put('a');
put('b');
put('e');
put(':');
puteol();
zeigeBI(faktor.zahl);
puteol();
puteol();
end;
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Variablen
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
var i: Integer; !Hilfsvariable
var prim: Integer; !Hilfsvariable
var go: BigInt;
var biga: BigInt;
var a: Integer;
var b: Integer;
var c: Integer;
var d: Integer;
var faktor: Fz
in begin
putint(1);
put('.');
put(':');
put(' ');
getint(var a);
putint(2);
put('.');
put(':');
put(' ');
getint(var b);
putint(3);
put('.');
put(':');
put(' ');
getint(var c);
putint(4);
put('.');
put(':');
put(' ');
getint(var d);
puteol();
puteol();
convertBI2(a,b,c,d,var biga);
gibFZ(biga,var faktor);
zeigeFZ(faktor);
end

View File

@ -0,0 +1,12 @@
let
var n : Integer;
func mfib(n : Integer) : Integer ~
if n <= 2 then n + 1
else
mfib(n-1) + mfib(n-2)
in begin
getint(var n);
putint(mfib(n));
end

View File

@ -0,0 +1,22 @@
let
var x : Integer;
proc bar (n : Integer ) ~
let
var o : Integer
in begin
! XXX
o := n * x;
putint(o)
end;
proc foo ( k : Integer, l : Integer) ~
let
const m ~ k + l
in
bar(m)
in begin
x := 42;
foo(x, x+1)
end

View File

@ -0,0 +1,191 @@
Christian Sinschek
fordfulk.tri berechnet den maximalen Fluss in einem gerichteten Flussgraphen
Eingabeformat:
Input -> Knotenzahl Kantenzahl Kanten
Kanten-> Startpunkt Flussmenge Endpunkt
{alle nicht-Terminale nur auf rechten Seiten} -> int
z.B. gut lesbar so zu schreiben, da Triangle auf Zeilenumbrüche "wartet"
4 3
0 3 1
1 2 2
1 2 3
Arrays in Triangle- auch der neuen Version- können leider mit allen Verschachtelungen nur eine Größe von 225 Feldern haben, daher sind die Netzwerke auf 15 Knoten, also eine 15x15- Flussmatrix beschränkt.
Ausgabe ist einfach der Maxflow.
Hier der C-Quellcode von
http://www.aduni.org/courses/algorithms/courseware/handouts/Reciation_09.html
(unten weiter)
// The Ford-Fulkerson Algorithm in C
#include <stdio.h>
Basic Definitions
#define WHITE 0
#define GRAY 1
#define BLACK 2
#define MAX_NODES 1000
#define oo 1000000000
// Declarations
int n; // number of nodes
int e; // number of edges
int capacity[MAX_NODES][MAX_NODES]; // capacity matrix
int flow[MAX_NODES][MAX_NODES]; // flow matrix
int color[MAX_NODES]; // needed for breadth-first search
int pred[MAX_NODES]; // array to store augmenting path
int min (int x, int y) {
return x<y ? x : y; // returns minimum of x and y
}
// A Queue for Breadth-First Search
int head,tail;
int q[MAX_NODES+2];
void enqueue (int x) {
q[tail] = x;
tail++;
color[x] = GRAY;
}
int dequeue () {
int x = q[head];
head++;
color[x] = BLACK;
return x;
}
// Breadth-First Search for an augmenting path
int bfs (int start, int target) {
int u,v;
for (u=0; u<n; u++) {
color[u] = WHITE;
}
head = tail = 0;
enqueue(start);
pred[start] = -1;
while (head!=tail) {
u = dequeue();
// Search all adjacent white nodes v. If the capacity
// from u to v in the residual network is positive,
// enqueue v.
for (v=0; v<n; v++) {
if (color[v]==WHITE && capacity[u][v]-flow[u][v]>0) {
enqueue(v);
pred[v] = u;
}
}
}
// If the color of the target node is black now,
// it means that we reached it.
return color[target]==BLACK;
}
// Ford-Fulkerson Algorithm
int max_flow (int source, int sink) {
int i,j,u;
// Initialize empty flow.
int max_flow = 0;
for (i=0; i<n; i++) {
for (j=0; j<n; j++) {
flow[i][j] = 0;
}
}
// While there exists an augmenting path,
// increment the flow along this path.
while (bfs(source,sink)) {
// Determine the amount by which we can increment the flow.
int increment = oo;
for (u=n-1; pred[u]>=0; u=pred[u]) {
increment = min(increment,capacity[pred[u]][u]-flow[pred[u]][u]);
}
// Now increment the flow.
for (u=n-1; pred[u]>=0; u=pred[u]) {
flow[pred[u]][u] += increment;
flow[u][pred[u]] -= increment;
}
max_flow += increment;
}
// No augmenting path anymore. We are done.
return max_flow;
}
// Reading the input file and the main program
void read_input_file() {
int a,b,c,i,j;
FILE* input = fopen("mf.in","r");
// read number of nodes and edges
fscanf(input,"%d %d",&n,&e);
// initialize empty capacity matrix
for (i=0; i<n; i++) {
for (j=0; j<n; j++) {
capacity[i][j] = 0;
}
}
// read edge capacities
for (i=0; i<e; i++) {
fscanf(input,"%d %d %d",&a,&b,&c);
capacity[a][b] = c;
}
fclose(input);
}
int main () {
read_input_file();
printf("%d\n",max_flow(0,n-1));
return 0;
}
Beim Programmieren war mir nicht bewusst, dass Triangle ein Konzept lokaler Sichbarkeit globaler Variablen haben könnte, deshalb werden alle Variablen z. T. redundant übergeben. Ob Compiler-Optimierungen da sinnvoll eingreifen weis ich erstn, wenn ich weiss wie wir den Compiler optimieren (der Fall ist doch recht dämlich), aber ich habe es dennoch mal so gelassen.
Größtes "Problem" des Algorithmus ist seine geringe Laufzeit, zumindest funktionale Äquivalenz der Compiler sollte sollte ich zeigen lassen.
Beispieleingaben, zu machen auch durch einfaches c+p
6 9
0 5 1
0 7 2
1 7 2
1 4 3
2 3 4
2 3 3
3 4 4
3 5 5
4 6 5
9 15
0 8 1
1 3 3
2 3 4
4 2 6
5 2 7
7 5 8
3 2 6
6 4 8
1 4 4
4 4 7
0 7 2
2 2 5
2 2 7
4 8 8
1 5 6
Die Beispiele entsprechen der GDI3 vom WS 04/05, Skript 3, Folie 29/30 links oben und Übung/Musterlösung 5

View File

@ -0,0 +1,200 @@
let
const BLACK ~ 0;
const GRAY ~ 1;
const WHITE ~ 2;
proc enqueue(node: Integer, var queue: array 15 of Integer, var color: array 15 of Integer, var queueLength: Integer) ~
begin
queueLength := queueLength + 1;
queue[queueLength - 1] := node;
color[node] := GRAY;
end;
proc dequeue (var queue: array 15 of Integer, var color: array 15 of Integer, var length: Integer, var x: Integer) ~
let
var i : Integer
in
begin
x := queue[0];
i := 0;
length := length - 1;
while i < length do begin
queue[i] := queue[i+1];
i := i + 1
end;
! as 0 is black
color[x] := BLACK;
end;
proc bfs (start: Integer, target: Integer, actualNodes: Integer, capacity: array 15 of array 15 of Integer,
var flow: array 15 of array 15 of Integer, var color: array 15 of Integer, var pred: array 15 of Integer,
var bfsReturn: Boolean) ~
let
var u: Integer;
var v: Integer;
var queueLength: Integer;
var queue: array 15 of Integer
in begin
queueLength := 0;
u := 0;
while (u < actualNodes) do begin
color[u] := WHITE;
u := u + 1
end;
enqueue(start, var queue, var color, var queueLength);
pred[start] := 0 - 1;
while queueLength > 0 do begin
dequeue(var queue, var color, var queueLength, var u);
v := 0;
while (v < actualNodes) do begin
if color[v]= WHITE /\ (capacity[u][v] - flow[u][v] > 0) then begin
enqueue(v, var queue, var color, var queueLength);
pred[v] := u
end
else; !?
v := v + 1 ;
end;
end;
bfsReturn := color[target]= BLACK;
end;
proc maxFlow (actualNodes: Integer, capacity: array 15 of array 15 of Integer, var maxFlow: Integer) ~
let
var flow: array 15 of array 15 of Integer;
var color: array 15 of Integer;
var pred: array 15 of Integer;
var i: Integer;
var j: Integer;
var u: Integer;
var increased: Integer;
var increment: Integer;
var bfsReturn: Boolean
in begin
!initialization
maxFlow := 0;
i := 0;
while i < actualNodes do begin
color[i] := BLACK;
pred[i] := 0;
j := 0;
while j < actualNodes do begin
flow[i][j] := 0;
j := j + 1
end;
i := i + 1;
end;
bfs(0, actualNodes - 1, actualNodes, capacity, var flow, var color, var pred, var bfsReturn);
while bfsReturn do begin
!very big value
increment := 31500;
u := actualNodes - 1;
while pred[u] >= 0 do begin
if capacity[pred[u]][u] - flow[pred[u]][u] < increment
then
increment := capacity[pred[u]][u] - flow[pred[u]][u]
else;
u := pred[u]
end;
u := actualNodes - 1;
while pred[u] >= 0 do begin
flow[pred[u]][u] := flow[pred[u]][u] + increment;
flow[u][pred[u]] := flow[u][pred[u]] - increment;
u := pred[u]
end;
maxFlow := maxFlow + increment;
bfs(0, actualNodes - 1, actualNodes, capacity, var flow, var color, var pred, var bfsReturn);
end;
end;
proc readInput(var actualNodes: Integer, var capacity: array 15 of array 15 of Integer) ~
let
var counter: Integer;
var subcounter: Integer;
var edgecount: Integer;
var from: Integer;
var with: Integer;
var to: Integer
in
begin
counter := 0;
while counter < 15 do begin
subcounter := 0;
while subcounter < 15 do begin
capacity[counter][subcounter] := 0;
subcounter := subcounter +1
end;
capacity[counter][counter] := 0;
counter := counter +1
end;
getint(var actualNodes);
getint(var edgecount);
counter := 0;
while counter < edgecount do begin
getint(var from);
getint(var with);
getint(var to);
capacity[from][to] := with;
counter := counter + 1
end;
! for debugging purposes, print matrix
counter := 0;
while counter < actualNodes do begin
subcounter := 0;
while subcounter < actualNodes do begin
putint(capacity[counter][subcounter]);
subcounter := subcounter +1
end;
puteol();
counter := counter +1;
end;
end;
!
!
!
!
!
!
! MAIN PROGRAM
!
!
!
!
!
!
!
var actualNodes: Integer;
var capacity: array 15 of array 15 of Integer;
var source: Integer;
var sink: Integer;
var max: Integer
in begin
readInput(var actualNodes, var capacity);
maxFlow(actualNodes, capacity, var max);
putint(max);
end;

View File

@ -0,0 +1,14 @@
Autor: Adrian Krion
gauss.tri implementiert die Gauss-Elimination mit Spaltenpivotsuche
für nicht-singuläre quadratische rationale Matrizen A der Größe n x n
und löst ein Gleichungs- system der Form Ax=b. Eingabe von A und b
spaltenweise durch einzelne Eingabe von jeweils Zähler und Nenner.
Ausgabe von als Zeilenvektor. n ist im Programm als Konstante
definiert, in der vorkompilierten .tam-Datei ist n auf 4 gesetzt.
Deshalb geht mit dieser auch nur Beispiel axb3.txt.
Beispieldateien:
axb1.txt : A 3x3-Einheitsmatrix, b Einsvektor
axb2.txt : 3x3-Beispiel
axb3.txt : 4x4-Beispiel

View File

@ -0,0 +1,288 @@
! gauss.tri implementiert die Gauss-Elimination
! für nicht-singuläre quadratische rationale
! Matrizen A der Größe n x n und löst ein Gleichungs-
! system der Form Ax=b.
let
const n ~ 4;
!Record zur Behandlung rationaler Zahlen
type Rational ~ record
p: Integer,
q: Integer
end;
!bei Änderung von n sollte hier die Dimension
!mit verändert werden
type Column ~ record
r: array 4 of Rational
end;
type Matrix ~ record
c: array 4 of Column
end;
!Methode zur GGT-Bestimmung
func ggt(a: Integer, b: Integer) : Integer ~
if b = 0 then a
else ggt(b, a // b);
!Kürzt einen Rational
proc reduce(var x: Rational) ~
let
var i : Integer
in begin
i := ggt(x.p,x.q);
if i = 0 then begin i := 1; end else ;
x.p := x.p / i;
x.q := x.q / i;
end;
!Methode zur Addition zweier Rationals
proc add(x: Rational, y: Rational, var temp: Rational) ~
let
var b: Integer
in begin
temp.q := x.q*y.q;
temp.p := (x.p*y.q) + (y.p*x.q);
reduce(var temp);
end;
!Methode zur Subtraktion zweier Rationals
proc sub(x: Rational, y: Rational, var temp: Rational) ~
let
var b: Integer
in begin
temp.q := y.q;
temp.p := 0 - y.p;
add(x, temp, var temp);
end;
!Multiplikation zweier Rationals
proc mul(x: Rational, y: Rational, var temp: Rational) ~
let
var b: Integer
in begin
temp.p := x.p*y.p;
temp.q := x.q*y.q;
reduce(var temp);
end;
!Teilt x durch y
proc div(x: Rational, y: Rational, var temp: Rational) ~
let
var b: Integer
in begin
temp.q := y.p;
temp.p := y.q;
mul(x,temp,var temp)
end;
!Löst Ax=b für eine nxn-Dreiecksmatrix
proc solve(a: Matrix, b: Column, var x: Column) ~
let
var i: Integer;
var j: Integer;
var temp : Rational
in begin
i := n-1;
while i >= 0 do begin
j := n-1;
x.r[i] := b.r[i];
while j > i do begin
mul(a.c[j].r[i],x.r[j],var temp);
sub(x.r[i],temp,var x.r[i]);
j := j - 1;
end;
div(x.r[i],a.c[i].r[i],var x.r[i]);
i := i - 1;
end;
end;
!Invertiert ein Rational
proc inv(var x: Rational) ~
let
var temp: Rational
in begin
temp.q := x.p;
temp.p := x.q;
x := temp;
end;
!Vertauscht die Zeilen i und j von A und b
proc switch(var a:Matrix, var b: Column, i: Integer, j: Integer) ~
let
var temp: Rational;
var k: Integer
in begin
k := 0;
!Vertausche die Zeilen der Matrix
while k < n do begin
temp := a.c[k].r[i];
a.c[k].r[i] := a.c[k].r[j];
a.c[k].r[j] := temp;
k := k + 1;
end;
!Vertausche die Zeilen des Vektors
temp := b.r[i];
b.r[i] := b.r[j];
b.r[j] := temp;
end;
!Vergleicht zwei Rationals a und b
func greater(a: Rational, b: Rational): Boolean ~
if (a.p*b.q) > (a.q*b.p) then true else false;
!Implementiert Spaltenpivotwahl für Gauss. Liefert das Inverse des Pivot-Elements sowie
!die Matrix nach Vertauschung
proc getPivot(line: Integer, var a: Matrix, var b: Column, var pivot: Rational) ~
let
var i: Integer;
var max: Rational;
var temp: Integer
in begin
i := line + 1;
max := a.c[line].r[line];
temp := line;
while i < n do begin
if greater(a.c[line].r[i],max) then begin
max := a.c[line].r[i];
temp := i;
end else ;
i := i + 1;
end;
if \ (temp = line) then begin
switch(var a, var b,temp,line);
end
else ;
pivot := max;
inv(var pivot);
end;
!Subtrahiert von der j-ten Zeile die i-te mal z
proc linesub(var a: Matrix, var b: Column, i: Integer, j: Integer, z: Rational) ~
let
var k: Integer;
var temp: Rational
in begin
k := 0;
while k < n do begin
mul(a.c[k].r[i],z,var temp);
sub(a.c[k].r[j],temp,var a.c[k].r[j]);
k := k + 1;
end;
mul(b.r[i],z,var temp);
sub(b.r[j],temp,var b.r[j]);
end;
!Berechnet aus einer nxn-Matrix eine nxn-obere Dreiecksmatrix mit Spaltenpivotwahl
proc gauss(var a:Matrix, var b: Column) ~
let
var pivot: Rational;
var temp: Rational;
var i: Integer;
var j: Integer
in begin
i := 0;
while i < n do begin
getPivot(i,var a, var b, var pivot);
j := (i+1);
!subtrahiere von den restlichen Zeilen Vielfache der Pivot-Zeile
while j < n do begin
temp := a.c[i].r[j];
if \(temp.p = 0) then begin
mul(temp,pivot,var temp);
linesub(var a, var b, i, j, temp);
end else ;
j := j + 1;
end;
i := i + 1;
end;
end;
!Liest eine Matrix ein
proc readMatrix(var a: Matrix) ~
let
var i: Integer;
var j: Integer;
var col: Column;
var rat: Rational
in begin
i := 0;
while i < n do begin
j := 0;
while j < n do begin
getint(var rat.p);
getint(var rat.q);
col.r[j] := rat;
j := j + 1;
end;
a.c[i] := col;
i := i + 1;
end
end;
!Liest den Vektor b ein
proc readVector(var b: Column) ~
let
var i: Integer;
var rat: Rational
in begin
i := 0;
while i < n do begin
getint(var rat.p);
getint(var rat.q);
b.r[i] := rat;
i := i + 1;
end;
end;
var i: Integer;
var a: Matrix;
var b: Column;
var x: Column;
var temp: Rational;
var j: Integer
in begin
readMatrix(var a);
readVector(var b);
gauss(var a, var b);
!Ausgabe von A und b nach Ausführung der
!Gauss-Elimination
! i := 0;
! while i < n do begin
! j := 0;
! while j < n do begin
! putint(a.c[i].r[j].p);
! put(chr(47));
! putint(a.c[i].r[j].q);
! put(chr(9));
! j := j + 1;
! end;
! i := i + 1;
! end;
! i := 0;
! while i < 3 do begin
! putint(b.r[i].p);
! put(chr(47));
! putint(b.r[i].q);
! put(chr(9));
! i := i + 1;
! end;
!Ausgabe von x
solve(a,b,var x);
i := 0;
while i < n do begin
putint(x.r[i].p);
put(chr(47));
putint(x.r[i].q);
put(chr(9));
i := i + 1;
end;
end

View File

@ -0,0 +1,24 @@
1
1
0
1
0
1
0
1
1
1
0
1
0
1
0
1
1
1
1
1
1
1
1
1

View File

@ -0,0 +1,24 @@
3
1
0
1
2
1
1
1
1
1
2
1
0
1
1
1
1
1
3
1
3
1
4
1

View File

@ -0,0 +1,41 @@
0
1
2
1
4
1
6
1
2
1
2
1
-3
1
1
1
0
1
3
1
0
1
-6
1
1
1
2
1
1
1
-5
1
0
1
-2
1
-7
1
6
1

View File

@ -0,0 +1,46 @@
let
var a : Integer;
var b : Integer;
var c : Integer;
var ringzahl : Integer;
proc tausche(var x : Integer, var y : Integer) ~
let
var tmp : Integer
in begin
tmp := x;
x := y;
y:= tmp;
end;
proc setze1() ~
begin
putint(a);
put(' ');
put('-');
put('>');
put(' ');
putint(b);
puteol();
end;
proc setzen(n : Integer) ~
if n = 1 then
setze1()
else begin
tausche(var b, var c);
setzen(n - 1);
tausche(var b, var c);
setze1();
tausche(var a, var c);
setzen(n - 1);
tausche(var a, var c)
end
in begin
a := 1;
b := 2;
c := 3;
getint(var ringzahl);
setzen(ringzahl);
end

View File

@ -0,0 +1,49 @@
Autor:
Patrick Sona
Dieses Programm implementiert einen Heapsort-Algorithmus.
Dieser wird auch einem Array ausgeführt, welches wegen
mangelnder Ressourcen nur 16 breit sein kann.
Diese Implementierung des sortieralgorithmus ist so geschrieben,
dass diese mit minimalen Änderungen jegliche "Objekte" sortieren
kann (Im beispiel wird ein String Nach dem ersten Buchstaben
sortiert).
Es müssen folgende Felder und Methoden angepaßt werden:
Arrayfeld des SortObj-type: Anstatt String den gewünschten Typ
einsetzen
Funktion getCompValue: muß einen Integer-Wert zurückgeben, anhand
verglichen werden kann
Prozedur exchange: Temp-Varible "t" muß den entsprechenden
Typ bekommen
Der Sortiert-Algorithmus wird über die Methode sort() angestoßen.
Ihr muss eine Variable vom Typ SortObj übergeben werden, in welcher
die zu sortierenden Elemente abgelegt sind.
Das beispielprogramm Arbeitet mit Strings.
Zu beginn werden bis zu 16 Strings abgefragt, welche anschliessend
Sortiert und ausgegeben werden. Die Eingabe kann durch wiederholtes
"Eingabe" drücken abgebrochen werden.
Beispiel Eingabe:
koch
huss
buchmann
eckert
may
ostermann
steinmetz
weihe
Ausgabe:
Sortierte Strings:
buchmann
eckert
huss
koch
may
ostermann
steinmetz

View File

@ -0,0 +1,263 @@
! Dieses Programm implementiert einen Heapsort-Algorithmus.
! Dieser wird auch einem Array ausgeführt, welches wegen
! mangelnder Ressourcen nur 16 breit sein kann.
! Diese Implementierung des sortieralgorithmus ist so geschrieben,
! dass diese mit minimalen Änderungen jegliche "Objekte" sortieren
! kann (Im beispiel wird ein String Nach dem ersten Buchstaben
! sortiert).
! Es müssen folgende Felder und Methoden angepaßt werden:
!
! Arrayfeld des SortObj-type: Anstatt String den gewünschten Typ
! einsetzen
! Funktion getCompValue: muß einen Integer-Wert zurückgeben, anhand
! verglichen werden kann
! Prozedur exchange: Temp-Varible "t" muß den entsprechenden
! Typ bekommen
!
! Der Sortiert-Algorithmus wird über die Methode sort() angestoßen.
! Ihr muss eine Variable vom Typ SortObj übergeben werden, in welcher
! die zu sortierenden Elemente abgelegt sind.
!
!
! Das beispielprogramm Arbeitet mit Strings.
! Zu beginn werden bis zu 16 Strings abgefragt, welche anschliessend
! Sortiert und ausgegeben werden. Die Eingabe kann durch wiederholtes
! "Eingabe" drücken abgebrochen werden.
let
! Zu Sortierender Typ
type String ~ record
c: array 12 of Char,
length: Integer
end;
! Zu Sortierendes Array
! (enthält zu sortierende Typen)
type SortObj ~ record
c: array 16 of String,
length: Integer
end;
! Gobale Variable, auf der Sortiert wird
var sortObj: SortObj;
! Gibt einen Vergleichswert zurück, anhand sortiert wird
!
! i: Position der zu Vergleichenden Objektes
! return Vergleichswert
func getCompValue(i: Integer): Integer~
ord(sortObj.c[i].c[0]);
! Tauscht zwei Werte innerhalb des zu Sortierenden Arrays
!
! i: erster Wert
! j: zweiter Wert-> wird mit erstem wert getauscht
proc exchange(i: Integer, j: Integer) ~
let
var t: String
in begin
t := sortObj.c[i];
sortObj.c[i] := sortObj.c[j];
sortObj.c[j] := t;
end;
! Korrigiert die Groesse des zu sortierenden Arrays.
! Damit der Heap-Algorithmus richtig funktioniert,
! muss die Größe einem vollständigem Baum entsprechen:
! Groesse: 2^n+1
!
! sO: zu korrigierendes Sortier-Array
proc setCorrectSize(var sO: SortObj) ~
if sO.length <= 2 then
sO.length := 2
else
if sO.length <= 4 then
sO.length := 4
else
if sO.length <= 8 then
sO.length := 8
else
if sO.length <= 16 then
sO.length := 16
else
sO.length := 32;
proc nop() ~
begin
end;
! Stellt die Heap-Eigenschaft des Teilbaumes her
!
! v: Semi-Heap mit Wurzel v
proc downheap(v: Integer) ~
let
var w: Integer;
var x: Integer;
var break: Boolean
in begin
break := false;
x := v;
w := 2 * x + 1;
while w < sortObj.length /\ \ break do begin
if w + 1 < sortObj.length then
if getCompValue(w+1) > getCompValue(w) then
w := w + 1
else
nop()
else
nop();
if getCompValue(x) >= getCompValue(w) then
break := true
else begin
exchange(x, w);
x := w;
w := 2 * x + 1;
end;
end;
end;
! stellt mittels downHeap im Bottom-up-verfahren Heaps her
proc buildheap() ~
let
var v: Integer
in begin
v := (sortObj.length/2)-1;
while v >= 0 do begin
downheap(v);
v := v - 1;
end;
end;
! Der eingentliche Heap-Sortier-Algorithmus
proc heapsort() ~
let
var length: Integer
in begin
buildheap();
length := sortObj.length;
while sortObj.length > 1 do begin
sortObj.length := sortObj.length - 1;
exchange(0, sortObj.length);
downheap(0);
end;
sortObj.length := length - 1;
end;
! Startert den Sortier-Algorithmus
!
! sO: Zu sortierendes Array
proc sort(var sO: SortObj) ~
begin
sortObj := sO;
putint(sortObj.length);
setCorrectSize(var sortObj);
putint(sortObj.length);
heapsort();
sO := sortObj;
end;
!----------------------------------------------------------
! Ab Hier ist das Beispiel-programm implementiert, welches den
! Heapsort nutzt.
proc printInText() ~
begin
put('B'); put('i'); put('t'); put('t'); put('e'); put(' '); put('z');
put('u'); put(' '); put('s'); put('o'); put('r'); put('t'); put('i');
put('e'); put('r'); put('e'); put('n'); put('d'); put('e'); put(' ');
put('S'); put('t'); put('r'); put('i'); put('n'); put('g'); put('s');
put(' '); put('e'); put('i'); put('n'); put('g'); put('e'); put('b');
put('e'); put('n'); put(' '); put('('); put('E'); put('n'); put('d');
put('e'); put(' '); put('m'); put('i'); put('t'); put(' ');
put('e'); put('i'); put('n'); put('g'); put('a'); put('b'); put('e');
put('!'); put(')'); puteol();
end;
proc printOutText() ~
begin
puteol();
put('S'); put('o'); put('r'); put('t'); put('i'); put('e'); put('r');
put('t'); put('e'); put(' '); put('S'); put('t'); put('r'); put('i');
put('n'); put('g'); put('s'); put(':'); puteol();
end;
! message: "stored!"
proc printInputInfo() ~
begin
put('s'); put('t'); put('o'); put('r'); put('e'); put('d'); put('!'); puteol();
end;
! Gibt einen Übergebenen String auf die konsole aus
!
! s: Auszugebender String
proc print(s: String) ~
let
var i: Integer
in begin
i := 0;
while i < s.length do begin
put(s.c[i]);
i := i + 1;
end;
end;
! Liesst die Strings von der Konsole ein und speichert
! sie in dem übergebenen Feld data
!
! data: Feld, in welchem die eingelesenen Strings abgelegt werden
proc getData(var data: SortObj) ~
let
var ch: Char;
var i: Integer;
var line: String;
var testeof : Boolean;
var testeol : Boolean
in begin
printInText();
i := 0;
line.length := 2;
while line.length > 1 do begin
line.length := 0;
get(var ch);
eol(var testeol);
eof(var testeof);
while \ testeol /\ \ testeof do begin
line.c[line.length] := ch;
line.length := line.length + 1;
get(var ch);
eol(var testeol);
eof(var testeof);
end;
printInputInfo();
data.c[i] := line;
i := i + 1;
end;
data.length := i;
end;
! Gibt die Strings aus dem Sortier-Objekt auf die Konsole aus
!
! data: auszugebende Daten
proc printData(data: SortObj)~
let
var i: Integer
in begin
printOutText();
i := 0;
while i < data.length do begin
print(data.c[i]);
i := i + 1;
end;
end;
var data: SortObj
! Programm liesst Strings ein, sortiert diese und gibt sie wieder aus
in begin
getData(var data);
sort(var data);
printData(data);
end;

View File

@ -0,0 +1 @@
CBEDAGHFJILK

View File

@ -0,0 +1,13 @@
Titel: Karp-Rabin Algorithmus
Autor: Sven Mitlehner
Funktion:
Dieses Triangle Programm führt den Karp-Rabin Algorithmus aus. Karp-Rabin ist ein Algorithmus zum String-Matching. Die Aufgabe besteht darin, in einem längeren Text einen bestimmten Suchtext zu finden. Der Karp-Rabin spielt seine Performancevorteile vor allem bei der Suche nach mehreren verschiedenen Suchtexten aus. Daher kann im Programmcode die Anzahl der zu suchenden Fragmente variiert werden. In dieser Version ist der Karp-Rabin Algorithmus zum Finden von DNA-Sequenzen implementiert worden. Daher kommen im Suchtext nur die Zeichen A, C, G und T (stehen für die 4 Basen der DNA) vor.
Das Programm erzeugt zuerst eine Datei (Base.txt) mit einer zufälligen Basenfolge der Länge 1.000.000. Danach liest es diese Datei wieder ein und sucht nach Übereinstimmungen zwischen Fragmenten und Text. Für jede gefundene Übereinstimmung wird eine Zeile der Art "Found Pattern #1 (AGAATG) at 1 666" auf der Kommandozeile ausgegeben
Bedienung:
Eingaben sind nicht nötig, der zufällige Textfile wird automatisch erzeugt. Alle Parameter sind im Programm hardcodiert und können dort geändert werden. Zum Kompilieren und Ausführen wird die Triangle-Version mit File-Support benötigt.

View File

@ -0,0 +1,260 @@
let
! Länge des zu suchenden Patterns. Bei Änderung der Länge müssen
! ausschließlich die nächsten beiden Zeilen editiert werden
const searchPatLen ~ 6;
! Pattern als array of Char
type Pattern ~ array 6 of Char;
! Anzahl der zu suchenden Patterns. Der Karp-Rabin Algorithmus spielt seine
! Performance besonders beim Suchen mehrerer verschiedener Patterns aus
const numPatterns ~ 4;
! Anzahl Zeilen und Spalten in der Datei
const numRows ~ 1000;
const numCols ~ 1000;
! Zwischenvariablen für den Randomizer. Je nach Startwert dieser beiden
! Variablen entstehen verschiedene Zufallsfolgen
var randomSeed1 : Integer;
var randomSeed2 : Integer;
! Liefert eine zufällige Base (A, C, G oder T)
proc getRandomBase(var result : Char) ~
let
var i : Integer
in begin
randomSeed1 := (randomSeed1 * 7 + 167) // 1847;
randomSeed2 := (randomSeed2 * 9 + 521) // 1451;
i := (randomSeed1 + randomSeed2) // 4;
if i = 0 then begin
result := 'A';
end else;
if i = 1 then begin
result := 'C';
end else;
if i = 2 then begin
result := 'G';
end else;
if i = 3 then begin
result := 'T';
end else;
end;
! Konvertiert die Base aus dem Parameter base in eine Integer
! Repräsentation. Dies könnte zwar auch mit ord(base) erledigt werden
! dabei kommen allerdings zu große Zahlen als Ergebnis heraus, so dass
! bei den folgenden Berechnungen Overflows auftreten
proc baseToInt(base : Char, var result : Integer) ~
begin
if base = 'A' then begin
result := 0;
end else;
if base = 'C' then begin
result := 1;
end else;
if base = 'G' then begin
result := 2;
end else;
if base = 'T' then begin
result := 3;
end else;
end;
! Berechnet den initialen Hashwert eines Patterns Nach der Formel
! Pattern[0] * 4^n-1 + Pattern[1] * 4^n-2 + ... + Pattern[n-1] * 4^0
proc makeHash(pattern : Pattern, var result : Integer) ~
let
var i : Integer;
var exp : Integer;
var baseInt : Integer
in begin
result := 0;
exp := 1;
i := searchPatLen - 1;
while i >= 0 do begin
baseToInt(pattern[i], var baseInt);
result := result + (baseInt * exp);
exp := exp * 4;
i := i - 1;
end;
end;
! Berechnet den neuen Hashwert für das nächste Pattern. Dieses nächste
! Pattern entsteht aus dem alten Pattern, durch Entfernen des ersten
! Zeichens, Shiftens der restlichen Zeichen um eine Stelle nach links und
! anschließendem Einfügen des nächsten Zeichens an der Stelle ganz rechts.
! Damit ist das rehashen mit konstantem Aufwand verbunden, nicht mit
! linearem Aufwand wie bei komplett neuem Hashing.Die Formel dafür lautet:
! 4 * (hash - (linkesZeichen * 4^n-1) + neuesZeichen
proc rehash(oldHash : Integer, removeChar : Char, addChar : Char, var newHash : Integer) ~
let
var multi : Integer;
var i : Integer;
var remInt : Integer;
var addInt : Integer
in begin
baseToInt(removeChar, var remInt);
baseToInt(addChar, var addInt);
i := 0;
multi := 1;
while i < (searchPatLen - 1) do begin
multi := multi * 4;
i := i + 1;
end;
newHash := (4 * (oldHash - (remInt * multi))) + addInt;
end;
var filehandle : Integer;
var filename : array 20 of Char;
var i : Integer;
var j : Integer;
var k : Integer;
var l : Integer;
var searchPats : array 5 of Pattern;
var patternHashes : array 5 of Integer;
var actualPattern : Pattern;
var oldPattern : Pattern;
var actualHash : Integer;
var row : Integer;
var col : Integer;
var base : Char
in begin
randomSeed1 := 254;
randomSeed2 := 982;
! Zu suchende Pattern
searchPats[0][0] := 'G'; searchPats[0][1] := 'C'; searchPats[0][2] := 'C';
searchPats[0][3] := 'A'; searchPats[0][4] := 'T'; searchPats[0][5] := 'A';
searchPats[1][0] := 'A'; searchPats[1][1] := 'G'; searchPats[1][2] := 'A';
searchPats[1][3] := 'A'; searchPats[1][4] := 'T'; searchPats[1][5] := 'G';
searchPats[2][0] := 'T'; searchPats[2][1] := 'T'; searchPats[2][2] := 'A';
searchPats[2][3] := 'T'; searchPats[2][4] := 'T'; searchPats[2][5] := 'A';
searchPats[3][0] := 'C'; searchPats[3][1] := 'C'; searchPats[3][2] := 'T';
searchPats[3][3] := 'G'; searchPats[3][4] := 'A'; searchPats[3][5] := 'G';
! Name der Datei, in der die zufällige DNA Sequenz abgespeichert wird
filename[0] := 'B';
filename[1] := 'a';
filename[2] := 's';
filename[3] := 'e';
filename[4] := '.';
filename[5] := 't';
filename[6] := 'x';
filename[7] := 't';
filename[8] := chr(0);
! Datei mit Schreibzugriff öffnen
fopen(var filehandle, filename, true);
! Da in Triangle Integer nur bis ~16000 gehen, werden zwei geschachtelte
! Schleifen verwendet um 1 Mio. Zeichen in die Datei zu schreiben
i := 0;
j := 0;
while i < numRows do begin
while j < numCols do begin
! Zufällige Base erzeugen und in die Datei schreiben
getRandomBase(var base);
fput(filehandle, base);
j := j + 1;
end;
! Nach jeweils 1000 Zeichen wird ein Zeilenumbruch ausgegeben
fputeol(filehandle);
i := i + 1;
j := 0;
end;
fclose(filehandle);
! Einmaliges Berechnen der Hashwerte der zu suchenden Basenfolgen
i := 0;
while i < numPatterns do begin
makeHash(searchPats[i], var patternHashes[i]);
i := i + 1;
end;
! Datei mit Lesezugriff öffnen
fopen(var filehandle, filename, false);
! ActualPattern erstellen, indem die ersten n Zeichen aus der Datei
! gelesen werden
i := 0;
while i < searchPatLen do begin
fget(filehandle, var actualPattern[i]);
i := i + 1;
end;
! Hashwert von ActualPattern berechnen
makeHash(actualPattern, var actualHash);
i := 0;
j := searchPatLen;
while i < numRows do begin
while j < numCols do begin
! Prüfen ob der Hashwert eines der zu suchenden Patterns mit
! demjenigen des aktuellen Patterns übereinstimmt
k := 0;
while k < numPatterns do begin
if actualHash = patternHashes[k] then begin
! Nur wenn dies tatsächlich der Fall ist, wird geprüft,
! ob die beiden Zeichenketten auch tatsächlich identisch
! sind
if searchPats[k] = actualPattern then begin
! Berechnen der aktuellen Zeilen- und Spaltennummer
row := i;
col := j - searchPatLen;
if col < 0 then begin
col := col + 1000;
row := row - 1;
end else;
! Ausgabe Fundstelle
put('F'); put('o'); put('u'); put('n'); put('d');
put(' '); put('P'); put('a'); put('t'); put('t');
put('e'); put('r'); put('n'); put(' '); put('#');
putint(k); put(' '); put('(');
l := 0;
while l < searchPatLen do begin
put(searchPats[k][l]);
l := l + 1;
end;
put(')'); put(' '); put('a'); put('t'); put(' ');
putint(row + 1); put(' '); putint(col + 1); puteol();
end else;
end else;
k := k + 1;
end;
oldPattern := actualPattern;
k := 0;
! Das vorherige Pattern wird um eine Position nach links
! verschoben. Dabei fällt das linke Zeichen weg und an die
! Position ganz rechts rückt das nächste gelesene Zeichen
while k < (searchPatLen - 1) do begin
actualPattern[k] := oldPattern[k + 1];
k := k + 1;
end;
fget(filehandle, var actualPattern[searchPatLen - 1]);
! Berechnen des neuen Hashwertes
rehash(actualHash, oldPattern[0], actualPattern[searchPatLen - 1], var actualHash);
j := j + 1;
end;
! Nächste Zeile
fgeteol(filehandle);
i := i + 1;
j := 0;
end;
fclose(filehandle);
end;

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,69 @@
###############################################################################
########################## README Datei zu kdtree.tri ############################
###############################################################################
Inhalt
======
1. Autor des Programmes
2. Funktion des Programmes
3. Bedienung und Ablauf des Programmes
4. Beispieleingaben und erwartete Ausgaben
###############################################################################
1. Autor: Stephan Unkels
###############################################################################
2. Funktion des Programmes
Das Programm erwartet eine Menge von 3D Punktdaten und erzeugt daraus eine
räumliche Datenstruktur, nämlich einen KD-Baum. Da die Daten als Float vorliegen,
werden sie mit 10000 multipliziert und der Rest einfach abgeschnitten. Da bei Triangle
der maximale Integer Wert bei 32767 liegt, war es nötig, eine "Klasse" Long zu
implementieren, die auch von Karsten Bamber (Gruppenmitglied) verwendet wird.
Allerdings in etwas abgewandelter Form.
Die Punktdaten werden dann je nach SplitAxis in zwei gleichgroße Teile unterteilt.
Dabei werden zuerst alle Punkte an der X-Achse geteilt, danach werden in jedem der
zwei neuen Teile alle Punkte an der Y-Achse geteilt usw..
Das Programm ist beendet, wenn die Punktmengen soweit unterteilt sind, dass in jedem Knoten
nur noch 5 Punkte liegen. Dies sind dann also die Blätter des Baumes.
Da das Programm mehr als 1024 Instructions und mehr als 1024Bytes auf dem
Stack benötigt, muss der Compiler an folgenden Stellen geändert werden:
TAM.Interpreter:
Zeile 31: static int[] data = new int[262144];
Zeile 39: HB = 262144; // = upper bound of data array + 1
TAM.Machine:
Zeile 59: public static Instruction[] code = new Instruction[32768];
Zeile 66: PB = 32768, // = upper bound of code array + 1
Zeile 67: PT = 32796; // = PB + 28
###############################################################################
3. Bedienung und Ablauf des Programmes
Das Programm wird mit "java blafasel < bunny.off" gestartet, damit die Punkte aus der
Datei eingelesen werden können. Weitere Eingaben vom Benutzer sind dann nicht
mehr nötig.
Im geschickten Archiv befindet sich schon eine geänderte Compiler version.
Starten mit: run.bat kdtree.tri < bunny.off
###############################################################################
4. Beispieleingaben und erwartete Ausgaben
Eingabe aus der angegebenen Textdatei.
Ausgabe ist die sortierte Punktmenge.

View File

@ -0,0 +1,538 @@
let
const maxLeaveSize ~ 5;
type Float ~ record
vorKomma : Integer,
nachKomma : Integer
end;
type Long ~ record
hi : Integer,
lo : Integer
end;
type Vertex ~ record
position : array 3 of Long
end;
type KDTree ~ record
start : Integer,
stop : Integer,
splitAxis : Integer,
index : Integer
end;
var vertices : array 1000 of Vertex;
var anzVert : Integer;
var kdtree : array 511 of KDTree;
proc inkrement(var counter : Integer) ~
begin
counter := counter + 1
end;
!negiert eine Long Zahl
proc negLong(var l1 : Long) ~
begin
l1.hi := (0 - 1) * l1.hi;
l1.lo := (0 - 1) * l1.lo
end; !netLong
func isNeg(l1 : Long) : Boolean ~
if l1.hi < 0 then
true
else
if l1.lo < 0 then
true
else
false;
func lt(l1 : Long, l2 : Long) : Boolean ~
if (l1.hi > l2.hi) then
false
else
if (l1.hi < l2.hi) then
true
else
if (l1.lo < l2.lo) then
true
else
false;
func eq(l1 : Long, l2 : Long) : Boolean ~
if (l1.hi = l2.hi) /\ (l1.lo = l2.lo) then
true
else
false;
proc magnitude(l1 : Long, var result : Long) ~
begin
result := l1;
if isNeg(l1) then
negLong(var result)
else;
end;
proc addLong(l1 : Long, l2 : Long, var result : Long) ~
let
var tmp : Integer;
var sign : Boolean
in begin
if (isNeg(l2) /\ \ isNeg(l1)) \/ ( \ isNeg(l2) /\ isNeg(l1)) then begin
!sign wechsel
result.lo := l1.lo + l2.lo;
result.hi := l1.hi + l2.hi;
if (result.hi > 0) /\ (result.lo < 0) then
begin
result.lo := maxint + result.lo;
result.hi := result.hi - 1
end
else;
if (result.hi < 0) /\ (result.lo > 0) then
begin
result.lo := (maxint * (0 - 1)) + result.lo;
result.hi := result.hi + 1
end
else;
end
else;
if (isNeg(l1) /\ isNeg(l2)) then
if (((0 - 1) * maxint) - l1.lo) > l2.lo then
!ueberlauf
begin
result.hi := l2.hi + l1.hi;
result.hi := result.hi - 1;
result.lo := maxint + l1.lo + l2.lo + 1
end
else
begin
result.hi := l2.hi + l1.hi;
result.lo := l2.lo + l1.lo
end
else;
if ( \ isNeg(l1) /\ \ isNeg(l2)) then
if ( maxint - l1.lo) < l2.lo then
!ueberlauf
begin
result.hi := l2.hi + l1.hi;
result.hi := result.hi + 1;
result.lo := 0 - maxint + l1.lo + l2.lo - 1
end
else
begin
result.hi := l2.hi + l1.hi;
result.lo := l2.lo + l1.lo
end
else;
end; !addLong
proc subLong(l1 : Long, l2 : Long, var result : Long) ~
let
var negierung : Long
in begin
negierung := l2;
!l2 negieren
negLong(var negierung);
addLong(l1, negierung, var result)
end; !subLong
proc addLongInt(long : Long, int : Integer, var result : Long) ~
let
var tmp : Long
in begin
tmp.lo := int;
tmp.hi := 0;
addLong(long, tmp ,var result);
end; !addLongInt
proc mulLong(l1 : Long, l2 : Long, var result : Long) ~
let
var neg1 : Long;
var neg2 : Long;
var betrag : Long;
var count : Long;
var tmp3 : Long
in begin
neg1 := l1;
neg2 := l2;
result.lo := 0;
result.hi := 0;
negLong(var neg1);
negLong(var neg2);
if (isNeg(l1) /\ isNeg(l2)) then
mulLong(neg1, neg2, var result)
else;
if ( \ isNeg(l1) /\ \ isNeg(l2)) then
begin
if lt(l1, l2) then
begin
count := l1;
while ((count.hi > 0) \/ (count.lo > 0)) do begin
addLongInt(count, 0 - 1, var count);
addLong(result, l2, var result)
end
end
else
begin
count := l2;
while ((count.hi > 0) \/ (count.lo > 0)) do begin
addLongInt(count, 0 - 1, var count);
addLong(result, l1, var result)
end
end;
end
else;
if (isNeg(l2) /\ \ isNeg(l1)) \/ ( \ isNeg(l2) /\ isNeg(l1)) then
begin
if isNeg(l1) then
begin
magnitude(l1, var betrag);
if lt(betrag, l2) then
begin
count := neg1;
while ((count.hi > 0) \/ (count.lo > 0)) do begin
addLongInt(count, 0 - 1, var count);
addLong(result, neg2, var result)
end
end
else
begin
count := l2;
while ((count.hi > 0) \/ (count.lo > 0)) do begin
addLongInt(count, 0 - 1, var count);
addLong(result, l1, var result)
end
end
end
else
begin
magnitude(l2, var betrag);
if lt(betrag, l1) then
begin
count := neg2;
while ((count.hi > 0) \/ (count.lo > 0)) do begin
addLongInt(count, 0 - 1, var count);
addLong(result, neg1, var result)
end
end
else
begin
count := l1;
while ((count.hi > 0) \/ (count.lo > 0)) do begin
addLongInt(count, 0 - 1, var count);
addLong(result, l2, var result)
end
end
end
end
else;
end; !mulLong
proc mulLongInt(long : Long, int : Integer, var result : Long) ~
let
var tmp : Long
in begin
tmp.lo := int;
tmp.hi := 0;
mulLong(long, tmp ,var result);
end; !mulLongInt
!Teilt ein Long durch ein Integer und liefert ein Long als Ergebnis
!proc divLong(d1: Long, d2: Integer, var result: Long) ~
!begin
! result.neg := false;
! result.hi := d1.hi / d2;
! result.lo := d1.lo / d2;
! if ((d1.neg) /\ (d2 > 0)) \/ ((\d1.neg) /\ (d2 < 0)) then
! result.neg := true
! else;
!end; !divLong
proc showLong(zahl : Long) ~
begin
putint(zahl.hi);
put(chr(27));
putint(zahl.lo)
end; !showLong
proc pow(bias : Integer, exp : Integer, var result : Integer)~
let
var count : Integer
in begin
count := exp;
result := 1;
while count > 0 do begin
result := result * bias;
count := count - 1
end
end;
proc getIntFromChar(ch : Char, var result : Integer) ~
begin
if (ord(ch) > 47) /\ (ord(ch) < 58) then
result := ord(ch) - 48
else
result := 0 - 1;
end;
proc floatToLong(float : Float, var result : Long) ~
begin
result.lo := float.vorKomma;
result.hi := 0;
mulLongInt(result, 10000, var result);
if float.vorKomma < 0 then
addLongInt(result, 0 - float.nachKomma, var result)
else
addLongInt(result, float.nachKomma, var result);
end; !floatToLong
proc readFloat(var result : Float) ~
let
var ch : Char;
var foo : Integer;
var tmp : Integer;
var exp : Integer;
var count : Integer
in begin
count := 4;
foo := 0;
tmp := 0;
getint(var result.vorKomma);
if result.vorKomma < maxint then
begin
while (foo >= 0) /\ (count > 0) do begin
count := count - 1;
get(var ch);
getIntFromChar(ch, var foo);
if foo >= 0 then begin
pow(10, count, var exp);
tmp := tmp + (foo * exp)
end
else;
end
end
else;
result.nachKomma := tmp;
!float fertig lesen
while (foo >= 0) do begin
get(var ch);
getIntFromChar(ch, var foo)
end
end; !readFloat
proc readVertex(var vert : Vertex) ~
let
var f1 : Float;
var count : Integer;
var long : Long
in begin
count := 0;
while count < 3 do begin
readFloat(var f1);
floatToLong(f1, var long);
vert.position[count] := long;
inkrement(var count)
end
end;
proc showVertices() ~
let
var count : Integer
in begin
count := 0;
while count < anzVert do begin
showLong(vertices[count].position[0]);
put(' ');
put(' ');
put(' ');
put(' ');
put(' ');
showLong(vertices[count].position[1]);
put(' ');
put(' ');
put(' ');
put(' ');
put(' ');
showLong(vertices[count].position[2]);
puteol();
inkrement(var count)
end;
end;
proc readOffFile() ~
let
var vert : Vertex;
var count : Integer;
var long: Long
in begin
getint(var anzVert);
while count < anzVert do begin
readVertex(var vert);
vertices[count] := vert;
inkrement(var count)
end;
end; !readOffFile
proc tauscheVertices(pos1 : Integer, pos2 : Integer) ~
let
var tmp : Vertex
in begin
tmp := vertices[pos1];
vertices[pos1] := vertices[pos2];
vertices[pos2] := tmp
end; !TAUSCHEVERTICES()
proc findMedian(startPos : Integer, stopPos : Integer, rang : Integer, splitAxis : Integer) ~
let
var tmp : Long;
var pMiddle : Integer;
var pBig : Integer;
var pNotyet : Integer;
var median : Long
in begin
pMiddle := startPos;
pBig := startPos;
pNotyet := startPos;
median := vertices[startPos].position[splitAxis];
while pNotyet <= stopPos do begin
if lt(vertices[pNotyet].position[splitAxis], median) then
begin
tauscheVertices(pMiddle, pNotyet);
tauscheVertices(pBig, pNotyet);
inkrement(var pMiddle);
inkrement(var pBig)
end
else
if eq(median, vertices[pNotyet].position[splitAxis]) then
begin
tauscheVertices(pBig, pNotyet);
inkrement(var pBig)
end
else;
pNotyet := pNotyet + 1;
end;
if (pBig - 1) < rang then begin
findMedian(pBig, stopPos, rang, splitAxis);
end
else
if pMiddle > rang then
begin
findMedian(startPos, pMiddle - 1, rang, splitAxis)
end
else;
end; !FINDMEDIAN()
proc buildTree(start : Integer, stop : Integer, index : Integer, splitAxis : Integer) ~
let
var median : Integer;
var tree : KDTree
in begin
tree.start := start;
tree.stop := stop;
tree.splitAxis := splitAxis // 3;
median := ((stop - start) / 2 ) + start;
if (stop - start) > maxLeaveSize then
!SPLITTEN
begin
findMedian(start, stop, median , tree.splitAxis);
!LINKES KIND
buildTree(start, median, 2 * index + 1, tree.splitAxis + 1);
!RECHTES KIND
buildTree(median+1, stop, 2 * index + 2, tree.splitAxis + 1);
end
else
tree.splitAxis := 0-1;
!BAUM IN ARRAY SPEICHERN
kdtree[index] := tree;
end
in begin
readOffFile();
!showVertices();
buildTree(0, anzVert - 1, 0, 0);
showVertices();
end;

View File

@ -0,0 +1,15 @@
let
const MAX ~ 10;
const MIN ~ 4;
var n, m: Integer
in begin
n := 2 * MAX;
let
var q: Integer;
const MIN ~ MIN - 1
in
q := 3 * n;
putint(n);
putint(MAX);
putint(MIN);
end

View File

@ -0,0 +1,83 @@
Floating Point Library For Triangle
===================================
Author: Matthias Georgi
Mail: matti.georgi@gmail.com
This library provides routines for floating point calculation.
For that purpose a Float record type is defined, which stores the mantisse
and the exponent of a floating point number as integers. The sign of
the number is recognized by the sign of the mantisse.
type Float ~
record
mnt: Integer,
exp: Integer
end;
As integers are represented by JAVA shorts, we have to store the mantisse
in 15 bits. The exponent is calculated on the base of 2. So the value
of a floating point number may be expressed like
mantisse * 2 ^ exponent
We define 4 public procedures for Floats, which do fundamental
aritmetics:
proc float(var x: Float, mnt: Integer, exp: Integer)
proc add(x: Float, y: Float, var result: Float)
proc sub(x: Float, y: Float, var result: Float)
proc mul(x: Float, y: Float, var result: Float)
proc div(x: Float, y: Float, var result: Float)
These procedures perform normalization before and after processing.
There is still some inaccuracy in the division algorithm.
This can be fixed by rightshifting while testing
the last bit for zero. I tried to satisfy the parser with no success
(no language spec, just source code here).
Mandelbrot Printer
==================
The program prints out a graphical representation of the mandelbrot set.
The calculation is somewhat limited as we
may overflow the Integer variables for large iterations.
The parameters may be changed in source code.
The algorithm was adopted from Wikipedia:
For each pixel on the screen do:
{
x = x0 = x co-ordinate of pixel
y = y0 = y co-ordinate of pixel
x2 = x*x
y2 = y*y
iteration = 0
maxiteration = 1000
while ( x2 + y2 < (2*2) AND iteration < maxiteration ) {
y = 2*x*y + y0
x = x2 - y2 + x0
x2 = x*x
y2 = y*y
iteration = iteration + 1
}
if ( iteration == maxiteration )
colour = black
else
colour = iteration
}
Compilation:
javac Triangle.Compiler mandelbrot.tri
Run program:
java TAM.Interpreter

View File

@ -0,0 +1,236 @@
let
! Stores the mantisse and exponent in base 2
type Float ~
record
mnt: Integer,
exp: Integer
end;
! ==============
! Private procedures
! ==============
! Print out in scientific notation.
proc print(x: Float) ~
begin
putint(x.mnt);
put(' ');
put('*');
put(' ');
put('2');
put('^');
putint(x.exp);
end;
! Compare two Floats and return true if x is greater than y.
func gt(x: Float, y: Float) : Boolean ~
if x.exp > y.exp then true
else if x.exp = y.exp then x.mnt > y.mnt
else false;
! Compare two Floats and return true if x is less than y.
func lt(x: Float, y: Float) : Boolean ~
if x.exp < y.exp then true
else if x.exp = y.exp then x.mnt < y.mnt
else false;
! Shift the mantisse to the right.
proc shr(var x: Float) ~
begin
x.mnt := x.mnt / 2;
x.exp := x.exp + 1;
end;
! Shift the mantisse to the left.
proc shl(var x: Float) ~
begin
x.mnt := x.mnt * 2;
x.exp := x.exp - 1;
end;
! Normalize float number.
! Shift mantisse until it exceeds given limit.
proc normalizel(var x: Float, limit: Integer) ~
if x.mnt = 0 then else
if x.mnt < 0 then
begin
x.mnt := 0 - x.mnt;
normalizel(var x, limit);
x.mnt := 0 - x.mnt
end
else while x.mnt < limit do shl(var x);
proc normalizer(var x: Float, limit: Integer) ~
if x.mnt = 0 then else
if x.mnt < 0 then
begin
x.mnt := 0 - x.mnt;
normalizer(var x, limit);
x.mnt := 0 - x.mnt
end
else while x.mnt > limit do shr(var x);
! Shift mantisse until both exponents have the same value.
proc adjust(var x: Float, var y: Float) ~
begin
if x.exp < y.exp then
adjust(var y, var x)
else
while x.exp > y.exp do shr(var y);
end;
! ==============
! Public procedures
! ==============
proc float(var x: Float, mnt: Integer, exp: Integer) ~
begin
x.mnt := mnt;
x.exp := exp;
normalizel(var x, 16384);
end;
! Add x and y. Store result in given parameter.
proc add(a: Float, b: Float, var result: Float) ~
let
var x: Float;
var y: Float
in
begin
x := a;
y := b;
normalizer(var x, 8192);
normalizer(var y, 8192);
adjust(var x, var y);
result.exp := x.exp;
result.mnt := x.mnt + y.mnt;
normalizel(var result, 16384);
end;
! Subtract x by y. Store result in given parameter.
proc sub(a: Float, b: Float, var result: Float) ~
let
var x: Float;
var y: Float
in
begin
x := a;
y := b;
normalizer(var x, 8192);
normalizer(var y, 8192);
adjust(var x, var y);
result.exp := x.exp;
result.mnt := x.mnt - y.mnt;
normalizel(var result, 16384);
end;
! Multiply x by y. Store result in given parameter.
proc mul(a: Float, b: Float, var result: Float) ~
let
var x: Float;
var y: Float
in
begin
x := a;
y := b;
normalizer(var x, 128);
normalizer(var y, 128);
result.exp := x.exp + y.exp;
result.mnt := x.mnt * y.mnt;
normalizel(var result, 16384);
end;
! Divide x by y. Store result in given parameter.
proc div(a: Float, b: Float, var result: Float) ~
let
var x: Float;
var y: Float
in
begin
x := a;
y := b;
normalizel(var x, 16384);
normalizer(var y, 16384);
!Why doesn't the parser swallow this?
!while ((y.mnt & 1) = 0) do shr(var y);
result.exp := x.exp - y.exp;
result.mnt := x.mnt / y.mnt;
normalizel(var x, 16384);
end;
var x1: Float;
var y1: Float;
var x: Float;
var y: Float;
var x0: Float;
var y0: Float;
var x2: Float;
var y2: Float;
var dx: Float;
var dy: Float;
var t: Float;
var c: Float;
var i: Integer;
var max: Integer;
var r: Float
in
begin
float(var dx, 1, 0-5);
float(var dy, 1, 0-5);
float(var y0, 0-1, 0);
float(var y1, 1, 0);
while lt(y0, y1) do
begin
float(var x0, 0-1, 0);
float(var x1, 1, 0);
while lt(x0, x1) do
begin
x := x0;
y := y0;
mul(x, x, var x2);
mul(y, y, var y2);
i := 0;
max := 10;
add(x2, y2, var c);
while (i < max) /\ (c.exp < 1) do
begin
mul(x, y, var y);
float(var t, 2, 0);
mul(y, t, var y);
add(y, y0, var y);
sub(x2, y2, var x);
add(x, x0, var x);
mul(x, x, var x2);
mul(y, y, var y2);
i := i + 1;
add(x2, y2, var c);
end;
if i = max then
put(' ')
else
put('.');
add(x0, dx, var x0);
end;
puteol();
add(y0, dy, var y0);
end;
end

View File

@ -0,0 +1,17 @@
Autorin:
Elif Tekes
Wunschgruppe:
Tomislav Greguric
Nabil Sayegh
Erklärungen zum Programm:
Eingabe: Ein Array aus Integer-Werten mit maximaler Länge 80.
Im Eingabefenster wird pro Zeile ein Element eingegeben.
WICHTIG: Beenden der Eingabe mit 0 (0 ist nicht Element des Arrays)
Das Array wird mit Hilfe vom MergeSort-Algorithmus sortiert und anschließend ausgegeben.

View File

@ -0,0 +1,134 @@
let
type IntArray ~ record
content: array 80 of Integer,
length: Integer
end;
! Liest Eingabe und speichert es in intarray
proc readArray(var intarray: IntArray) ~
let
var i: Integer;
var testeof : Boolean
in begin
intarray.length := 0;
getint(var i);
eof(var testeof);
while i \= 0 /\ \ testeof do begin
intarray.content[intarray.length] := i;
intarray.length := intarray.length + 1;
getint(var i);
eof(var testeof);
end;
end;
! gibt Inhalt des Arrays auf den Bildschirm
proc writeArray(var intarray: IntArray) ~
let
var i: Integer
in begin
i := 0;
while i < intarray.length do begin
putint(intarray.content[i]);
i := i+1;
puteol()
end;
end;
! Teilt intarray in zwei Teile auf
! intarray.length muss größer als 1 sein!
proc splitArray(var intarray: IntArray, var ia1: IntArray, var ia2: IntArray) ~
let
var i: Integer;
var j: Integer
in begin
i := 0;
j := intarray.length / 2;
while i<j do begin
ia1.content[i] := intarray.content[i];
i := i + 1
end;
ia1.length := i;
! zu diesem Zeitpunkt muss gelten i = j (tut es auch, falls nicht irgendwo ein Fehler im Code steckt)
while i < intarray.length do begin
ia2.content[i-j] := intarray.content[i];
i := i + 1
end;
ia2.length := i-j
end;
! Fügt die bereits sortierten Arrays ia1 und ia2 zum ebenfalls sortierten intarray zusammen
proc mergeArray(var intarray: IntArray, var ia1: IntArray, var ia2: IntArray) ~
let
var i : Integer;
var j : Integer;
var k : Integer
in begin
i := 0;
j := 0;
k := 0;
intarray.length := ia1.length + ia2.length;
! Diese While-Schleife läuft so lange, bis das letzte
! Element von entweder ia1 oder ia2 durchgenommen wurde
while (i < intarray.length) /\ (j < ia1.length) /\ (k < ia2.length) do begin
if ia1.content[j] < ia2.content[k] then begin
intarray.content[i] := ia1.content[j];
j := j + 1
end
else begin
intarray.content[i] := ia2.content[k];
k := k + 1
end;
i := i + 1
end;
! Wenn eines der zusammenzufügenden Arrays durch ist, füge den Rest des anderen Arrays ein
if j < ia1.length then
while i < intarray.length do begin
intarray.content[i] := ia1.content[j];
i := i + 1;
j := j + 1
end
else
while i < intarray.length do begin
intarray.content[i] := ia2.content[k];
i := i + 1;
k := k + 1
end;
end;
! Sortiert gegebenes Array mit MergeSort Algorithmus
proc mergesort(var intarray: IntArray) ~
let
var ia1: IntArray;
var ia2: IntArray
in begin
if intarray.length >= 2 then begin
splitArray(var intarray, var ia1, var ia2);
mergesort(var ia1);
mergesort(var ia2);
mergeArray(var intarray, var ia1, var ia2)
end
else;
end;
var intarray: IntArray
in begin
readArray(var intarray);
puteol();
mergesort(var intarray);
writeArray(var intarray);
end

View File

@ -0,0 +1,4 @@
a
b
cd
efg

View File

@ -0,0 +1,72 @@
###############################################################################
########################## README Datei zu packen.tri ############################
###############################################################################
Inhalt
======
1. Autor des Programmes
2. Funktion des Programmes
3. Bedienung des Programmes
4. Ablauf des Programmes
###############################################################################
1. Autor: Fabian Marx
###############################################################################
2. Funktion des Programms
Meine Idee war es ein kleines Packprogramm zu schreiben. Dies war allerdings
schwieriger als gedacht. Insbesondere musste ich in Triangle nicht vorhandene
Funktionen nachbauen (z.B. Bitströme). Herausgekommen ist ein Programm,
dass eine beliebig lange Datei (blockweise) einlesen kann, diese verarbeitet
und das Ergebnis in die Ausgabe schreibt.
###############################################################################
3. Bedienung des Programms
java TAM.Interpreter packen.tri < readme.txt > out.txt
################################################################################
4. Ablauf des Programms
Für die Eingabe-Datei steht ein Char-Array zur Verfügung,
in das 245 Byte eingelesen werden. Die Berechnung basiert auf 4-Bit-Codewörtern,
die aus den Chars mit low und high extrahiert werden.
Nur für den ersten Block wird dann folgendes ausgeführt:
1. Es werden alle 4-Bit-Codewörter gezählt. Dies war ursprünglich für die Berechnung
eines optimalen Huffmann-Codes gedacht. Der autmoatische Aufbau dieses Codes erwies
sich allerdings als zu kompliziert, so dass ich nun einen statischen Code benutze.
Diesen habe ich auf einem Blatt Papier erzeugt und die hier gezählten Häufigkeiten
der Codewörter (für verschiedene Dateien) als Basis genommen.
2. Um dennoch eine Optimierung in der Ausgabe zu erreichen, werden die Häufigkeiten
sortiert und es entsteht eine Abbildung eines Codewortes auf den statischen
Huffmann-Code (schließlich im array code). So wird ein optimaler Huffmann-Code
approximiert.
3. Diese Abbildung wird nun als erstes in die Ausgabe geschrieben.
Nun beginnt die Verarbeitung jedes Eingabeblocks, indem die Code-Wörter jedes Chars
mit low und high ausgelesen werden und mit writeBits der entsprechende Huffmann-code
geschrieben wird. Zu bemerken ist dabei, dass die Prozedur putBit wie ein Bit-Buffer
aggiert und ein char mittels put schreibt, sobald sich 8 Bit angesammelt haben.
Mittels einer while-Schleife wird der Vorgang wiederholt, bis eof erreicht ist.
Die gesamte Eingabe-Datei wurde so blockweise verarbeitet.
Das Ergebniss der ganzen Prozedur hängt aber sehr stark von der Eingabedatei ab.
Am besten funktionieren natürlich Textdateien.
Nähere Beschreibungen finden sich in den Kommentierungen des Quelltextes.
##########################################################################

View File

@ -0,0 +1,306 @@
let
! Array, in dem der aktuelle Eingabeblock gespeichert wird
var input : array 245 of Char;
! Gibt den Füllstand des Eingabeblocks an. Besonders wichtig für den letzten Block, der das Array nicht vollständig ausfüllt.
var iSize : Integer;
! Eine Zeigervariable, die auf die aktuelle Position in input zeigt.
var iP : Integer;
! Diverse temporäre Variablen
var tmpchar : Char;
var tmpint : Integer;
var i : Integer;
var j : Integer;
! Code wird benutzt um die Anzahl der Codewörter zu zählen.
! Mittels Vertauschung in sortiert wird die Abbildung von Huffmann-Code auf Code-Wort erzeugt
! und schließlich wird mittels sortiert ein Code-Wort auf den Huffmann-Code abgebildet.
var code : array 16 of Integer;
var sortiert : array 16 of Integer;
! Liefert die unteren 4 Bits einer Integerzahl als Integer-Wert
! z.B. 37 wird binär zu 0010.0101 unc low liefert dann integer(0101) = 5
proc low(c : Integer, var l : Integer) ~
l := c // 16;
! Analog zu low, nur dass die oberen 4 Bit als Integer-Wert zurück gegeben werden
proc high(c : Integer, var h : Integer) ~
begin
h := c;
i := 0;
while i < 4
do begin
if (h // 2) = 1 then
h := h - 1
else ;
h := h / 2;
i := i + 1;
end;
end;
! Um die Häufigkeiten der Code-Wörter zu sortieren benutze ich Bubble-Sort.
! Dies ist die Tauschefunktion, die in dem Array die Werte der Position x und x + 1 vertauscht.
proc tausche(var a : array 16 of Integer, x : Integer) ~
let
var t : Integer
in begin
t := a[x];
a[x] := a[x + 1];
a[x + 1] := t;
end;
! Es ist ein Bitweises schreiben nötig. Um dies zu realisieren müssen solange Bits
! zwischengespeichert werden, bis 8 Bits geschrieben wurden. Diese können dann
! mit put auf die Ausgabe gelegt werde.
! Speichert die bisher geschriebenen Bits
var bitBuffer : Integer;
! Gibt an, wie viel Bits schon geschrieben wurden
var bitBufP : Integer;
! Sammelt die zu schreibenden Bits in bitBuffer (mittels Shift-Operationen)
! und schreibt schließlich das char (wenn 8 Bits gesammelt)
proc putBit(b : Boolean) ~
begin
! Um eine Stelle nach links shiften
bitBuffer := bitBuffer * 2;
! Mit einer 1 rechts auffüllen, falls true geschrieben werden soll
if b = true then
bitBuffer := bitBuffer + 1
else ;
! Füllstand im BitBuffer anpassen
bitBufP := bitBufP + 1;
! Wenn der BitBuffer voll ist, mittels put Zeichen schreiben und Buffer zurücksetzen
if bitBufP = 8 then
begin
put(chr(bitBuffer));
bitBufP := 0;
bitBuffer := 0;
end else;
end;
! BitBuffer flushen, also char schreiben, auch wenn noch nicht 8 Bits gesammelt sind.
proc flushbitBuffer() ~
begin
while bitBufP < 8 do
bitBuffer := bitBuffer * 2;
put(chr(bitBuffer));
bitBufP := 0;
bitBuffer := 0;
end;
! hcode ist die Darstellung eines einzelnen Huffmann-Code-Worts
type hcode ~ record
! Gibt von links nach rechts die Bits an
bits : array 7 of Boolean,
! Gibt an, wie viele Bits das H-Code-Wort hat.
valid : Integer
end;
! Alle 16 möglichen H-Code-Wörter werden in diesem Array gespeichert.
var huffmann : array 16 of hcode;
! HuffmannCode mit dem Index hc in Ausgabe (mittels BitBuffer) schreiben
proc writeBits(hc : Integer) ~
let
var k : Integer
in begin
k := 0;
! So lange Bit schreiben, bis alle gültigen Bits eines HF-Code-Worts geschrieben wurden
while k < huffmann[hc].valid
do begin
putBit(huffmann[hc].bits[k]);
k := k + 1;
end;
end;
! Gibt an, ob es sich um den ersten gelesenen Block handelt oder nicht. Wird nach dem ersten Durchlauf auf true gesetzt.
var firstRun : Boolean;
! Die Ermittlte Zuordnung Code-Wort -> Huffmann-Code wird in die Ausgabe geschrieben.
proc writeCodierung() ~
begin
i := 0;
while i < 16
do begin
put(chr(code[i]));
i := i + 1;
end
end;
var testeof : Boolean
in begin
! Initalisierungen
iSize := 0;
iP := 0;
bitBuffer := 0;
bitBufP := 0;
firstRun := false;
! Array sortiert vorbereiten, um Permutation zu erreichen
i := 0;
while i < 16
do begin
sortiert[i] := i;
i := i + 1;
end;
! Darstellung des verwendetetn statischen Huffmann-Code
! Aus Beispieldokumenten habe ich folgende Häufigkeiten erhalten:
! 0: 128, 1: 62, 2: 236, 3: 153, 4: 214, 5: 144, 6: 372, 7: 195, 8: 27, 9: 54, 10: 33, 11: 19, 12: 95, 13: 63, 14: 77, 15: 88
! Aus diesen Werte habe ich diese Codierung erzeugt (nach Huffmann)
! In diesem Array steht die Codierung nach Häufigkeit der Code-Wörter aufsteigend sortiert.
huffmann := [
{ bits ~ [true,true,true,true,true,true,true], valid ~ 7}, ! CodeWort für 11
{ bits ~ [true,true,true,true,true,true,false], valid ~ 7}, ! CodeWort für 8
{ bits ~ [true,true,true,true,true,false,false], valid ~ 6}, ! CodeWort für 10
{ bits ~ [false,true,true,true,true,false,false], valid ~ 5}, ! CodeWort für 9
{ bits ~ [false,true,true,true,false,false,false], valid ~ 5}, ! CodeWort für 1
{ bits ~ [true,false,true,true,true,false,false], valid ~ 5}, ! CodeWort für 13
{ bits ~ [true,false,true,true,false,false,false], valid ~ 5}, ! CodeWort für 14
{ bits ~ [true,true,true,true,false,false,false], valid ~ 5}, ! CodeWort für 15
{ bits ~ [false,true,true,false,false,false,false], valid ~ 4}, ! CodeWort für 12
{ bits ~ [true,false,true,false,false,false,false], valid ~ 4}, ! CodeWort für 0
{ bits ~ [true,true,false,true,false,false,false], valid ~ 4}, ! CodeWort für 5
{ bits ~ [true,true,false,false,false,false,false], valid ~ 4}, ! CodeWort für 3
{ bits ~ [true,true,true,false,false,false,false], valid ~ 4}, ! CodeWort für 7
{ bits ~ [false,true,false,false,false,false,false], valid ~ 3},! CodeWort für 4
{ bits ~ [true,false,false,false,false,false,false], valid ~ 3},! CodeWort für 2
{ bits ~ [false,false,true,false,false,false,false], valid ~ 2} ! CodeWort für 6
];
! Solange weitermachen, bis Dateiende erreicht wurde
eof(var testeof);
while \testeof
do begin
! Der Eingabeblock wird gelesen und in input gespeichert
iP := 0;
eof(var testeof);
while (iP < 245) /\ \testeof
do begin
get(var input[iP]);
iP := iP + 1;
eof(var testeof);
end;
! Füllmenge des Buffers setzen
iSize := iP;
! Dieser Teil wird nur beim ersten Block ausgeführt
! Es wird die Häufigkeit der einzelnen Code-Wörter gezählt und aufsteigend sortiert
! Es entsteht dadurch eine Zuordnung von aktuellem Code-Wort zu dem obigen Huffman-Code
! Ich versuche so einen optimalen Huffman-Code zu approximieren.
if \firstRun then
begin
! Codeanzahl zählen und in code speichern
iP := 0;
tmpint := 0;
while iP < iSize
do begin
low(ord(input[iP]),var tmpint);
code[tmpint] := code[tmpint] + 1;
high(ord(input[iP]),var tmpint);
code[tmpint] := code[tmpint] + 1;
iP := iP + 1;
end;
! Codeanzahlen ausgeben
! i := 0;
! while i < 16
! do begin
! puteol();
! putint(i);
! put(':');
! putint(code[i]);
! i := i + 1;
! end;
! puteol();
! Code-Array sortieren mit Bubblesort
i := 0;
while i < 16
do begin
j := 0;
while j < 15
do begin
if code[j] > code[j+1] then
begin
tausche(var code, j);
tausche(var sortiert, j);
end
else;
j := j + 1;
end;
i := i + 1;
end;
! Abbildung: Code Wort in Quelltext -> Huffman-Codewort erstellen (Abbildungsrichtung von sortiert wird umgedreht)
i := 0;
while i < 16
do begin
code[sortiert[i]] := i;
i := i + 1
end;
! Sortierten Code ausgeben (z.B. für Debugging)
! i := 0;
! while i < 16
! do begin
! puteol();
! put('c');
! putint(i);
! put(':');
! putint(code[i]);
! i := i + 1
! end;
writeCodierung();
! Den vorangegangenen Teil für die nächsten Blöcke nicht mehr ausführen
firstRun := true;
end else ;
! Ausgabe schreiben, indem für jedes Char im input-Array zunächst
! high ermittelt wird und mittels writeBits der zugehörige H-Code geschrieben wird
! und das gleiche für low getan wird.
iP := 0;
while iP < iSize
do begin
high(ord(input[iP]), var tmpint);
! Debugging-Ausgaben
!puteol();
!put('h');
!putint(ord(input[iP]));
!put(',');
!putint(tmpint);
!put(',');
!putint(code[tmpint]);
writeBits(code[tmpint]);
low(ord(input[iP]), var tmpint);
! Debugging-Ausgaben
!put(',');
!put('l');
!putint(ord(input[iP]));
!put(',');
!putint(tmpint);
!put(',');
!putint(code[tmpint]);
writeBits(code[tmpint]);
iP := iP + 1;
end;
eof(var testeof);
end;
end;

View File

@ -0,0 +1 @@
ABCDEFGHIJKL

View File

@ -0,0 +1,28 @@
Gruppe: Jan Sinschek
Benjamin Otto
Anselm Foehr
* Programm "prime":
Autor: Anselm Foehr
Beschreibung: Das Programm findet einen Faktor der Eingabe (nicht zwingend prim)
mit Hilfe des einfachen Pollard-Rho-Verfahrens.
Gerechnet wird auf dem Datentyp BigInt, dieser kann 32 Ziffern lang
werden.
Benutzung:
java Triangle/Compiler prime.tri
java TAM/Interpreter obj.tam
< Eingabe der zu faktorisierenden Zahl
> Ausgabe des ersten Primfaktors
Beispiel Eingabe: 177777
Beispiel Ausgabe: 9
Beispiel Eingabe: 6667
Beispiel Ausgabe: 59
Beispiel Eingabe: 123451
Beispiel Ausgabe: 41 (dauert)

View File

@ -0,0 +1,360 @@
!
! Abgabe Gruppe:
! Jan Sinschek
! Benjamin Otto
! Anselm Foehr
!
! Programm:
! Autor: Anselm Foehr
! Beschreibung:
! Das Programm berechnet eine Primfaktorzerlegung nach dem einfachen
! Pollard-Rho-Verfahren.
! Gerechnet wird auf dem Datentyp BigInt, dieser kann 32 Ziffern lang
! werden.
!
! Benutzung:
! java Triangle/Compiler prime.tri
! java TAM/Interpreter obj.tam
! < Eingabe der zu faktorisierenden Zahl
! > Ausgabe des ersten Primfaktors
!
! WARNUNG: Extrem langsam fuer groessere Zahlen!
!
let
const MAXLENGTH ~ 32;
! big (unsigned) integer
type BigInt ~ record
digit : array 32 of Integer,
length : Integer
end;
! print a bigint to stdout
proc putbigint(x : BigInt) ~
let
var i : Integer
in begin
i := x.length - 1;
while i >= 0 do begin
putint(x.digit[i]);
i := i - 1;
end
end;
! return the absolute value of Integer x
func abs(x : Integer) : Integer ~
if x < 0 then 0-x
else x;
! create a BigInt from an Integer
proc int2bigint(i : Integer, var result : BigInt) ~
let
var tmp : Integer;
var j : Integer
in begin
j := 0;
tmp := abs(i);
result.length := 1;
if i = 0 then
result.digit[0] := 0
else;
while tmp > 0 do begin
result.digit[j] := tmp // 10;
tmp := tmp / 10;
j := j + 1;
end;
result.length := j;
end;
! result = x == 1
func beq1(x : BigInt) : Boolean ~
(x.length = 1) /\ (x.digit[0] = 1);
! result = x > 1
func bgt1(x : BigInt) : Boolean ~
(x.length > 1) \/ (x.digit[0] > 1);
! result = x > 0
func bgt0(x : BigInt) : Boolean ~
(x.length > 1) \/ (x.digit[0] \= 0);
! result = x == y
proc beq(x : BigInt, y : BigInt, var result : Boolean) ~
let
var i : Integer
in begin
if x.length \= y.length then
result := false
else begin
result := true;
i := x.length - 1;
while i >= 0 /\ result do begin
if x.digit[i] \= y.digit[i] then begin
result := false;
end else ;
i := i - 1;
end
end
end;
! result = x > y
proc bgt(x : BigInt, y : BigInt, var result : Boolean) ~
let
var i : Integer;
var check : Boolean
in begin
i := x.length - 1;
result := false;
if x.length > y.length then
result := true
else if x.length = y.length then begin
check := true;
while i >= 0 /\ check do begin
if x.digit[i] < y.digit[i] then begin
result := false;
check := false;
end else if x.digit[i] > y.digit[i] then begin
result := true;
check := false;
end else
i := i - 1;
end
end else result := false
end;
! result = x + y
proc badd(x : BigInt, y : BigInt, var result : BigInt) ~
let
var carry : Integer;
var t1: BigInt;
var t2: BigInt;
var i : Integer
in begin
carry := 0;
if x.length < y.length then begin
t2 := x;
t1 := y;
end else begin
t1 := x;
t2 := y;
end;
i := 0;
while i < t1.length do begin
result.digit[i] := (t1.digit[i] + t2.digit[i] + carry) // 10;
carry := (t1.digit[i] + t2.digit[i] + carry) / 10;
i := i + 1;
end;
if carry = 1 then begin
result.digit[i] := 1;
result.length := i + 1;
end else
result.length := i;
end;
! result = x + y * 10 ^ z
proc badd10(x : BigInt, y : BigInt, z : Integer, var result : BigInt) ~
let
var t1: BigInt;
var i : Integer
in begin
i := MAXLENGTH - 1;
t1 := y;
while (i - z) >= 0 do begin
t1.digit[i] := t1.digit[i - z];
i := i - 1;
end;
while i >= 0 do begin
t1.digit[i] := 0;
i := i - 1;
end;
t1.length := y.length + z;
badd(x, t1, var result);
end;
! result = |x - y|
proc bsub(x : BigInt, y : BigInt, var result : BigInt) ~
let
var carry : Integer;
var lastCarry : Integer;
var length: Integer;
var bool: Boolean;
var t1: BigInt;
var t2: BigInt;
var i : Integer
in begin
bgt(x, y, var bool);
if bool then begin
t1 := x;
t2 := y;
end else begin
t2 := x;
t1 := y;
end;
carry := 0;
if t1.length > t2.length then
length := t1.length
else
length := t2.length;
i := 0;
while i < length do begin
lastCarry := carry;
if t1.digit[i] < (t2.digit[i] + carry) then
carry := 1
else
carry := 0;
result.digit[i] := (10 * carry + t1.digit[i])
- (t2.digit[i] + lastCarry);
i := i + 1;
end;
while result.digit[i - 1] = 0 do
i := i - 1;
result.length := i;
end;
! result = x * (int)y
proc bimul(x : BigInt, y : Integer, var result : BigInt) ~
let
var tmp: BigInt;
var i : Integer
in begin
i := y;
result.length := 1;
result.digit[0] := 0;
while i > 0 do begin
badd(result, x, var tmp);
result := tmp;
i := i - 1;
end
end;
! result = x * y
proc bmul(x : BigInt, y : BigInt, var result : BigInt) ~
let
var tmp: BigInt;
var tmp2: BigInt;
var i : Integer
in begin
i := 0;
result.digit[0] := 0;
result.length := 1;
while i < y.length do begin
bimul(x, y.digit[i], var tmp);
badd10(x, tmp, i, var result);
i := i + 1;
end
end;
! result = x % y
proc bmod(x : BigInt, y : BigInt, var result : BigInt) ~
let
var tmp : BigInt;
var tmp2 : BigInt;
var bool : Boolean
in begin
result := x;
bgt(result, y, var bool);
while bool do begin
if result.length > (y.length + 1) then begin
bimul(y, 10, var tmp);
bsub(result, tmp, var tmp2);
result := tmp2;
end else begin
bsub(result, y, var tmp);
result := tmp;
end;
bgt(result, y, var bool);
end
end;
! result = gcd(x, y)
proc bgcd(x : BigInt, y : BigInt, var result : BigInt) ~
let
var bool : Boolean;
var a : BigInt;
var b : BigInt;
var tmp : BigInt
in begin
a := x; b := y;
beq(x, y, var bool);
while \ bool do begin
bgt(a, b, var bool);
if bool then begin
bsub(a, b, var tmp);
a := tmp;
end else begin
bsub(b, a, var tmp);
b := tmp;
end;
beq(a, b, var bool);
end;
result := a;
end;
! ireduzibles polynom fuer pollard-rho
proc f(x : BigInt, a : BigInt, n : BigInt, var result : BigInt) ~
let
var tmp : BigInt
in begin
bmul(x, x, var result);
badd(result, a, var tmp);
bmod(tmp, n, var result);
end;
! pollardrho verfahren
proc pollardrho(n : BigInt) ~
let
var x : BigInt;
var y : BigInt;
var d : BigInt;
var a : BigInt;
var tmp : BigInt;
var bool : Boolean;
var run : Boolean
in begin
int2bigint(1, var a);
int2bigint(2, var x);
int2bigint(2, var y);
int2bigint(1, var d);
run := true;
while beq1(d) /\ run do begin
f(x, a, n, var tmp);
x := tmp;
f(y, a, n, var tmp);
y := tmp;
f(y, a, n, var tmp);
y := tmp;
bsub(x, y, var tmp);
bgcd(tmp, n, var d);
put('.');
bgt(n, d, var bool);
if bgt1(d) /\ bool then begin
putbigint(d);
run := false
end else ;
beq(d, n, var bool);
if bool then begin
put('f');
run := false
end else ;
end
end;
var n : Integer;
var b1: BigInt
in begin
put('f');put('a');put('c');put('t');put('o');put('r');put(':');
getint(var n);
int2bigint(n,var b1);
pollardrho(b1);
end

View File

@ -0,0 +1,13 @@
let
var f : Integer;
var g : Integer;
var n : Integer;
proc p() ~ begin f := 2*g; g := g+1 end
in begin
n := 1; f := 2; g := 3;
while n < 10 do begin
p();
n := n + 1
end;
putint(f); puteol(); putint(g)
end

View File

@ -0,0 +1,41 @@
Autor:
Sayegh, Nabil
Wunschgruppe:
Greguric, Tomislav
Tekes, Elif
Funktion:
Es handelt sich um einen minimalst raytracer.
Es gibt eine Kugel, ein Fenster und einen Beobachter.
Reflektionen sind noch nicht implementiert und Leuchtquellen gibt es auch keine.
Der Raytracer wird wiederholt aufgerufen, gewissermassen als Animation.
Das Fenster entfernt sich vom Beobachter, dadurch sieht das Objekt groesser aus.
Hilfsfunktionen:
Quadratwurzelberechnung (ganzzahlig)
Loesung quadratischer Gleichungen
Bedienung:
Alle Parameter sind hardcoded, zwichen
!START EDITING HERE
und
!END EDITING HERE
Beispieleingaben:
siehe Code
Erwartete Ausgabe:
3-Dimensionale Darstellungen der Kugel als (Pseudo-)Animation
Die Zahlenwerte geben die z-Koordinate an.
Bei einer Kugel erwarten wir, dass das Zentrum naeher am Beobachter ist, als die aeussen Bereiche,
d.h. in der Mitte muessen kleinere Zahlen sein als aussen.
Interessanterweise veraendert sich die Zahl im Mittelpunkt nicht,
das ist aber korrekt, schliesslich verschieben wir das Fenster, und nicht die Kugel!
Bemerkung:
Da maxint leider nur 32768 betraegt, und Quadrierungen vorkommen,
koennen die Werte nur begrenzt vergroessert werden. Das laesst leider
auch keinen echten Spielraum fuer Fixpunkt schiebereien.

View File

@ -0,0 +1,235 @@
let
type Vektor ~ record
x: Integer,
y: Integer,
z: Integer
end;
! _ _
! (x - m)^2 = r^2
!
type Kugel ~ record
m: Vektor, ! Mittelpunkt
r: Integer ! Radius
end;
! _ _
! o + lambda * p
!
type Gerade ~ record
o: Vektor, ! Ort
p: Vektor ! Richtung
end;
! Subtraktion von Vektoren
proc sub(a: Vektor, b: Vektor, var ret: Vektor) ~
begin
ret.x := a.x - b.x;
ret.y := a.y - b.y;
ret.z := a.z - b.z;
end;
! skalen in gerade Einsetzen um Koordinaten rauszubekommen
proc geradeEinsetzen(g: Gerade, lambda: array 2 of Integer, var ret: array 2 of Vektor) ~
let
var i: Integer
in
begin
i:=0;
while (i<2) do
begin
ret[i].x := g.o.x + (lambda[i] * g.p.x);
ret[i].y := g.o.y + (lambda[i] * g.p.y);
ret[i].z := g.o.z + (lambda[i] * g.p.z);
i:=i+1;
end
end;
! print padded
proc putintPadded(value: Integer) ~
begin
! if (value <= 99) then
! putint(0)
! else
! ;
if (value <= 9) then
putint(0)
else
;
putint(value);
end;
! Quadratwurzel
proc sqrt(x: Integer, var ret: Integer) ~
let
var tmp: Integer
in
begin
tmp:=(x+1) / 2;
ret:=0;
while (tmp>ret) do
begin
tmp:=tmp-ret;
ret:=ret+1
end
end;
! Loesung quadratischer Gleichungen der Form ax^2 + bx + c = 0
! max 2 Loesungen
proc solvesq(a: Integer, b:Integer, c: Integer, var ret: array 2 of Integer, var success: Boolean) ~
let
var p: Integer;
var q: Integer;
var d: Integer
in
begin
p:=b/a;
q:=c/a;
if (((p/2)*(p/2))-q < 0) then
success:=false
else
begin
success:=true;
sqrt(((p/2)*(p/2))-q, var d);
ret[0]:=0-(p/2)-d;
ret[1]:=0-(p/2)+d;
! putint(ret[0]);
! put(' ');
! putint(ret[1]);
! put(' ');
! put(' ');
end
;
end;
var a: Integer;
var b: Integer;
var c: Integer;
var tmp: Vektor;
var success: Boolean;
var lambda: array 2 of Integer;
var schnittpunkte: array 2 of Vektor;
! START EDITING HERE
! START EDITING HERE
! START EDITING HERE
! START EDITING HERE
!Dimensionen des Fensters, Position und Richtung sind erstmal nicht aenderbar
!Die Mitte des Fensters befindet sich bei 0/0
const WIDTH ~ 15;
const HEIGHT ~ 15;
var k: Kugel;
var g: Gerade;
var frame: Integer
in begin
frame:=0;
while (frame<7) do
begin
frame:=frame+1;
k.m.x:=0;
k.m.y:=0;
g.o.x:=0;
g.o.y:=0;
k.r:=75; !Kugelradius
k.m.z:=150; !Entfernung der Kugel vom Fenster
tmp.z:=frame; !Entfernung des Fensters (Animation, die Distanz Beobachter<->Fenster wird groesser, dadurch sieht das Objekt groesser aus)
g.o.z:=0; !Entfernung des Betrachters vom Fenster
!Beobachter und Sicht
! STOP EDITING HERE
! STOP EDITING HERE
! STOP EDITING HERE
! STOP EDITING HERE
!erst Zeilen, dann Spalten
tmp.y:=(HEIGHT/2+1);
while tmp.y > (0-(HEIGHT/2)) do begin
tmp.x:=0-(WIDTH/2);
while tmp.x < (WIDTH/2+1) do begin
! Berechne den Richtungsvektor des Beobachters durchs Fenster
sub(tmp, g.o, var g.p);
! Kugel mit Strahl schneiden und quadratische Gleichung bestimmen
a:= (g.p.x * g.p.x) +
(g.p.y * g.p.y) +
(g.p.z * g.p.z);
b:= ((g.o.x+(0-k.m.x))*2*g.p.x) +
((g.o.y+(0-k.m.y))*2*g.p.y) +
((g.o.z+(0-k.m.z))*2*g.p.z);
c:= (g.o.x * g.o.x ) +
(g.o.x *(0-k.m.x)) +
(g.o.x *(0-k.m.x)) +
((0-k.m.x)*(0-k.m.x)) +
(g.o.y * g.o.y ) +
(g.o.y *(0-k.m.y)) +
(g.o.y *(0-k.m.y)) +
((0-k.m.y)*(0-k.m.y)) +
(g.o.z * g.o.z ) +
(g.o.z *(0-k.m.z)) +
(g.o.z *(0-k.m.z)) +
((0-k.m.z)*(0-k.m.z)) -
(k.r*k.r);
solvesq(a,b,c, var lambda, var success);
geradeEinsetzen(g, lambda, var schnittpunkte);
! Wir wollen nur Schnittpunkte sehen, die jenseits des Fensters liegen
if (success) then
if ((schnittpunkte[0].z > tmp.z) /\
(schnittpunkte[1].z > tmp.z)) then
if (schnittpunkte[0].z <
schnittpunkte[1].z) then
putintPadded(schnittpunkte[0].z/10)
else
putintPadded(schnittpunkte[1].z/10)
else
if (schnittpunkte[0].z > tmp.z) then
putintPadded(schnittpunkte[0].z/10)
else
if (schnittpunkte[1].z > tmp.z) then
putintPadded(schnittpunkte[1].z/10)
else
begin
put(' ');
put(' ');
! put(' ');
end
else
begin
put(' ');
put(' ');
! put(' ');
end
;
put(' ');
tmp.x:=tmp.x+1;
end;
! Zeilenende, weiter mit naechster Zeile
puteol();
tmp.y:=tmp.y-1;
end;
end
end

View File

@ -0,0 +1,12 @@
! [file: repeat-err1.tri, started: 23-Apr-2004]
! Testing repeat/until-statement.
! error: repeat's expression is not a boolean.
let
var i: Integer
in begin
repeat
i := i+1
until i;
putint(i);
end;

View File

@ -0,0 +1,20 @@
! [file: repeat-sum.tri, started: 22-Apr-2004]
! Testing repeat/until-statement.
! Compute the sum(1+...+n) for an integer n.
let
var n: Integer;
var i: Integer;
var sum: Integer
in begin
getint(var n);
i := 0;
sum := 0;
repeat
begin
i := i+1;
sum := sum+i;
end
until (i>=n);
putint(sum);
end;

View File

@ -0,0 +1,42 @@
let
type Line ~ record
content: array 80 of Char,
length: Integer
end;
! reads a line from the standard input
proc readLine(var line: Line) ~
let
var ch: Char
in begin
line.length := 0;
get(var ch);
while \ eol() /\ \ eof() do begin
line.content[line.length] := ch;
line.length := line.length + 1;
get(var ch);
end;
end;
! writes the reversed line to the standard output
proc putReversedLine(line: Line) ~
let
var i: Integer
in begin
i := line.length;
while i > 0 do begin
i := i-1;
put(line.content[i])
end;
puteol();
end;
var line: Line
in begin
while \ eof () do begin
readLine(var line);
putReversedLine(line);
end;
end

View File

@ -0,0 +1,134 @@
###############################################################################
########################## README Datei zu rsa.tri ############################
###############################################################################
Inhalt
======
1. Autor des Programmes
2. Funktion des Programmes
3. Bedienung und Ablauf des Programmes
4. Beispieleingaben und erwartete Ausgaben
###############################################################################
1. Autor: Karsten Bamberg
###############################################################################
2. Funktion des Programmes
Das Programm "rsa.tri" ist eine Implementierung des Public Key Verschlüs-
selungsverfahrens RSA. Es verschlüsselt Texte von bis zu 60 Zeichen Länge
in einer Art Blockchiffre, wobei immer 3 Zeichen des Klartextes in einen
Schlüsseltextblock der Länge 4 kodiert werden. Das Eingabealphabet besteht
aus den 26 Kleinbuchstaben des deutschen Alphabets und dem Leerzeichen.
Wird ein ungültiges Zeichen eingegeben, so ignoriert das Programm darauf
folgende Eingaben. Nachdem die Verschlüsselung abgeschlossen ist besteht
die Möglichkeit einen geheimen Schlüssel einzugeben, mit dem der gerade
verschlüsselte Text wieder entschlüsselt wird.
Das Programm verwendet eine Long-Datenstruktur, die aus 2 Integer-Werten,
einem low- und einem high-Teil, besteht. Diese Implementierung war nötig,
um mit Zahlen rechnen zu können die größer als 32767 sind. Stephan Unkels
verwendet in seinem Programm "kdtree.tri" ebenfalls die Long-Datenstruktur
in "voller" Form. In diesem Programm musste sie wegen der, durch den
Compiler begrenzten Anzahl an Instruktionen auf die nötigsten Funktionen
und Operationen reduziert werden und unterstützt nur noch positve Zahlen.
###############################################################################
3. Bedienung und Ablauf des Programmes
Nach dem Start erwartet das Programm die Eingabe des öffentlichen Schlüs-
sels, mit dem verschlüsselt werden soll. Der Schlüssel wird im Form von
zwei, durch ein Leerzeichen getrennten, Integer-Werten eingegeben. Die
erste dieser Zahlen ist das Produkt n zweier Primzahlen p und q. Dieses
sollte für "rsa.tri" im Bereich von 20000 bis 32767 liegen. Die zweite Zahl
des Tupels ist der Verschlüsselungsexponent e. Für ihn muss gelten
1 < e < (p - 1) * (q - 1) und gcd(e, (p - 1) * (q - 1)) = 1, wobei gcd der
größte gemeinsame Teiler ist. Nach einem weiteren Leerzeichen folgt die
Eingabe des zu verschlüsselnden Textes. Dieser kann bis zu 60 Zeichen lang
sein. Die Eingabe wird mit "Return" oder "Enter" bestätigt. Das Programm
berechnet nun den Schlüsseltext und gibt diesen auf der Konsole aus. Danach
wird die nächste Eingabe vom Benutzer erwartet. Es muss wieder ein Tupel
von zwei Integer-Werten eingegeben werden, nämlich noch einmal das Prim-
zahlenprodukt n, gefolgt vom geheimen Schlüssel d, mit dessen Hilfe der
verschlüsselte Text wieder entschlüsselt werden soll. Auch für d muss gel-
ten 1 < d < (p - 1) * (q - 1). Berechnen kann man d aus der Gleichung
d * e = 1 mod (p - 1) * (q - 1). Wenn man nur den öffentlichen Schlüssel
(n, e) kennt, kann man das nur dann, wenn man n faktorisieren kann.
Nach Bestätigung der Eingabe mit "Return" oder "Enter" startet die Ent-
schlüsselung, der entschlüsselte Text wird auf der Konsole ausgegeben und
das Programm wird beendet.
###############################################################################
4. Beispieleingaben und erwartete Ausgaben
Man wählt die Primzahlen p = 211 und q = 151. Es ergibt sich n = 31861. Als
Verschlüsselungsexponent wird e = 101 gewählt. Der zugehörige geheime
Schlüssel ist d = 18401. Die Eingabe und Ausgabe auf der Konsole sieht
folgendermaßen aus:
============================================
31861 101 der erste mai ist frei (n e Klartext)
abrxa wo zgl nitamli ykm hlc d u (Schlüsseltext)
31861 18401 (n d)
der erste mai ist frei (entschlüsselter Klartext)
============================================
Mit falschem geheimen Schlüssel wird der Klartext nicht richtig dekodiert:
============================================
31861 101 der erste mai ist frei
abrxa wo zgl nitamli ykm hlc d u
31861 15333
?abbxpcbo?vh~yu?vgeozlb
============================================
###########################################################################
Ein Beispiel mit öffentlichem Schlüssel (n, e) = (20651, 10519) und
geheimem Schlüssel d = 20263:
============================================
20651 10519 compiler optimieren macht spass
wdk aqn ubt xbm efc tgq eii sjp lt acy wuj
20651 20263
compiler optimieren macht spass
============================================
Mit falschem Schlüssel:
============================================
20651 10519 compiler optimieren macht spass
wdk aqn ubt xbm efc tgq eii sjp lt acy wuj
20651 12345
gcdrittfn{ggtec{ncp dvutgquostens
============================================
###########################################################################
Weitere Beispiele für mögliche Schlüssel sind:
(n, e) = (27317, 17), d = 6305
(n, e) = (29719, 73), d = 14873
(n, e) = (23183, 521), d = 2105
Es können auch beliebige eigene Schlüssel verwendet werden, sofern sie die
in Abschnitt 3 genannten Bedingungen für den öffentlichen und geheimen
Schlüssel erfüllen.
###############################################################################
##################### Ende der README Datei zu rsa.tri ########################
###############################################################################

View File

@ -0,0 +1,357 @@
let
!##############################################################################
!############## Datenstruktur "Long" mit Grundrechenoperationen ###############
!##############################################################################
type Long ~ record
hi: Integer,
lo: Integer
end;
!Funktion "less than"
func lt(l1: Long, l2: Long): Boolean ~
if (l1.hi <= l2.hi) /\ (l1.lo < l2.lo) then
true
else
false;
!Inkrementiert eine POSITIVE Long-Zahl
proc incrLong(var nr: Long) ~
begin
if nr.lo < maxint then
nr.lo := nr.lo + 1
else begin
nr.hi := nr.hi + 1;
nr.lo := 0
end
end; !incrLong
!Dekrementiert eine POSITIVE Long-Zahl wenn sie größer 0 ist
proc decrLong(var nr: Long) ~
begin
if nr.lo > 0 then
nr.lo := nr.lo - 1
else if nr.hi > 0 then begin
nr.hi := nr.hi - 1;
nr.lo := maxint
end else;
end; !decrLong
!Addition zweier POSITIVER Long-Zahlen
proc addLong(l1: Long, l2: Long, var result: Long) ~
begin
result.lo := 0;
result.hi := 0;
if ( maxint - l1.lo) < l2.lo then
!ueberlauf
begin
result.hi := l2.hi + l1.hi;
result.hi := result.hi + 1;
result.lo := 0 - maxint + l1.lo + l2.lo - 1
end
else
begin
result.hi := l2.hi + l1.hi;
result.lo := l2.lo + l1.lo
end
end; !addLong
!Multiplikation zweier POSITIVER Long-Zahlen
proc mulLong(l1: Long, l2: Long, var result: Long) ~
let
var count: Long
in begin
result.lo := 0;
result.hi := 0;
if lt(l1, l2) then
begin
count := l1;
while ((count.hi > 0) \/ (count.lo > 0)) do begin
decrLong(var count);
addLong(result, l2, var result)
end
end
else
begin
count := l2;
while ((count.hi > 0) \/ (count.lo > 0)) do begin
decrLong(var count);
addLong(result, l1, var result)
end
end
end; !mulLong
!Berechnet den Rest der Division eines Long durch einen Integer
proc modLong(d1: Long, d2: Integer, var result: Long) ~
let
var temp: Long
in begin
temp := d1;
result.lo := 0;
result.hi := 0;
while temp.hi > 0 do begin
result.lo := result.lo - d2;
if result.lo < 0 then begin
temp.hi := temp.hi - 1;
result.lo := (result.lo + maxint) + 1
end else;
end;
result.lo := result.lo // d2;
temp.lo := temp.lo // d2;
if result.lo <= (maxint - temp.lo) then
result.lo := (result.lo + temp.lo) // d2
else
result.lo := ((result.lo - d2) + temp.lo) // d2;
end; !modLong
!Gibt eine Long Zahl aus
proc showLong(zahl: Long) ~
begin
putint(zahl.hi);
put(chr(44));
putint(zahl.lo);
end; !showLong
!##############################################################################
!####################### Ende der "Long" Datenstruktur ########################
!##############################################################################
type CharMsg ~ record
content: array 60 of Char,
length: Integer
end;
type IntMsg ~ record
content: array 80 of Integer,
length: Integer
end;
var msg: CharMsg;
var crypt: CharMsg;
var exp: Integer;
var n: Integer;
var d: Integer;
var testeof : Boolean;
var testeol : Boolean;
! reads a line from the standard input
proc readLine(var line: CharMsg) ~
let
var ch: Char
in begin
line.length := 0;
get(var ch);
eol(var testeol);
eof(var testeof);
while (\ testeol /\ \ testeof) /\ \(ord(ch) = 13) do begin
line.content[line.length] := ch;
line.length := line.length + 1;
get(var ch);
eol(var testeol);
eof(var testeof);
end;
end;
!Konvertiert eine Zeile bis zum ersten "ungültigen" Zeichen in interne Repräsentation
proc convertLine(line: CharMsg, var conline: IntMsg) ~
let
var i: Integer;
var tmp: Integer
in begin
conline.length := line.length;
i := 0;
tmp := ord(line.content[i]);
!Solange "Leerzeichen" oder "a - z" gelesen wird konvertieren
while ((tmp = 32) \/ ((96 < tmp) /\ (tmp < 123))) /\ (i < 60) do begin
if tmp = 32 then
conline.content[i] := 0
else
conline.content[i] := tmp - 96;
i := i + 1;
tmp := ord(line.content[i])
end
end;
!Übersetzt eine Int-Zeile in Char-Repräsentation zurück
proc reconvertLine(line: IntMsg, var conline: CharMsg) ~
let
var i: Integer;
var tmp: Integer
in begin
i := 0;
tmp := line.content[i];
while i < line.length do begin
if tmp = 0 then
conline.content[i] := chr(32)
else
conline.content[i] := chr(tmp + 96);
i := i + 1;
tmp := line.content[i]
end;
conline.length := line.length
end;
!Gibt eine CharMsg-Zeile auf der Konsole aus
proc writeCharLine(line: CharMsg) ~
let
var i: Integer
in begin
i := 0;
while i < line.length do begin
put(line.content[i]);
i := i + 1;
end;
puteol()
end;
!Exponentiation mit Modulo-Berechnung
proc powmod(var base: Long, var exp: Integer, mod: Integer, var result: Long) ~
begin
result.lo := 1;
result.hi := 0;
while exp > 0 do begin
!Wenn aktueller Exponent ungerade ist Basis * aktuelles Ergebisnis berechnen
if exp // 2 = 1 then begin
mulLong(result, base, var result);
modLong(result, mod, var result);
end else;
!Basis quadrieren und Exponent halbieren
mulLong(base, base, var base);
modLong(base, mod, var base);
exp := exp / 2
end
end;
!RSA-Verschlüsselung in Blöcken
!Jeweils 3 Zeichen Klartext werden zu 4 Zeichen Schlüsseltext kodiert
proc encrypt(plain: CharMsg, var crypt: CharMsg) ~
let
var plainint: IntMsg;
var cryptint: IntMsg;
var i: Integer;
var j: Integer;
var tmpexp: Integer;
var value: Long;
var result: Long
in begin
!Zähler initialisieren
i := 0;
j := 0;
!Zeile von Char in Int-Repräsentation konvertieren
convertLine(plain, var plainint);
!Längenattribute setzen
plainint.length := plainint.length + (3 - (plainint.length // 3));
cryptint.length := (plainint.length / 3) * 4;
!Solange es noch Zeichen zu kodieren gibt nächsten Block verschlüsseln
while i < plainint.length do begin
tmpexp := exp;
!Jeweils 3 Zahlen als eine der Basis 27 interpretieren
value.hi := 0;
value.lo := ((plainint.content[i] * 27) * 27)
+ (plainint.content[i + 1] * 27)
+ plainint.content[i + 2];
!Value verschlüsseln
powmod(var value, var tmpexp, n, var result);
!Verschlüsselte Zahl wieder zur Basis 27 in cryptint schreiben
cryptint.content[j] := result.lo / ((27 * 27) * 27);
cryptint.content[j + 1] := (result.lo // ((27 * 27) * 27)) / (27 * 27);
cryptint.content[j + 2] := (result.lo // (27 * 27)) / 27;
cryptint.content[j + 3] := result.lo // 27;
!Zähler erhöhen
i := i + 3;
j := j + 4
end;
!Verschlüsselte Nachricht wieder in Char-Repräsentation schreiben
reconvertLine(cryptint, var crypt);
end;
!RSA-Entschlüsselung
!Schlüsseltextblöcke werden wieder entschlüsselt
proc decrypt(crypt: CharMsg, var plain: CharMsg) ~
let
var plainint: IntMsg;
var cryptint: IntMsg;
var i: Integer;
var j: Integer;
var tmpexp: Integer;
var value: Long;
var result: Long
in begin
!Zähler initialisieren
i := 0;
j := 0;
!Zeile von Char in Int-Repräsentation konvertieren
convertLine(crypt, var cryptint);
!Längenattribut setzen
plainint.length := (cryptint.length / 4) * 3;
!Solange noch nicht alles dekodiert ist weiter entschlüsseln
while i < cryptint.length do begin
tmpexp := d;
!Jeweils 4 Zahlen als eine der Basis 27 interpretieren
value.hi := 0;
value.lo := (((cryptint.content[i] * 27) * 27) * 27)
+ ((cryptint.content[i + 1] * 27) * 27)
+ (cryptint.content[i + 2] * 27)
+ cryptint.content[i + 3];
!Value entschlüsseln
powmod(var value, var tmpexp, n, var result);
!Entschlüsselte Zahl wieder zur Basis 27 in plainint schreiben
plainint.content[j] := result.lo / (27 * 27);
plainint.content[j + 1] := (result.lo // (27 * 27)) / 27;
plainint.content[j + 2] := result.lo // 27;
!Zähler erhöhen
i := i + 4;
j := j + 3
end;
!Entschlüsselte Nachricht wieder in Char-Repräsentation schreiben
reconvertLine(plainint, var plain)
end
in begin
!Einlesen des öffentlichen Schlüssels
getint(var n);
getint(var exp);
!Einlesen der zu verschlüsselnden Nachricht
readLine(var msg);
puteol();
!Verschlüsseln
encrypt(msg, var crypt);
!Verschlüsselten Text ausgeben
writeCharLine(crypt);
puteol();
!Geheimen Schlüssel einlesen
getint(var n);
getint(var d);
!Entschlüsseln
decrypt(crypt, var msg);
!Entschlüsselte Nachricht ausgeben
writeCharLine(msg)
end

View File

@ -0,0 +1,42 @@
let
! genrwset: decl {x.0}
var x : Integer;
! genrwset: decl {y.1}
var y : Integer;
! genrwset: decl {k.2, l.3} read {k.2,l.3,y.1} write {k.2,y.1}
proc foo (var k : Integer, l : Integer) ~
let
! genrwset: decl {o.4}
var o : Integer;
! genrwset: decl {k.5,l.6} read {k.5,l.6,y.1} write {k.5,y.1}
proc bar (var k : Integer, l : Integer) ~
let
! genrwset: decl {dummy.7}
var dummy : Integer
in begin
! genrwset: read {l.6,y.1} write {k.5}
k := l * y;
! genrwset: read {k.5} write {y.1}
y := k + 1
end
in begin
! genrwset: read {l.3} write {o.3}
o := l * 2;
! genrwset: read (k.2,o.3,y.1} write {k.2,y.1}
bar(var k, o)
end
in begin
! genrwset: write {x.0}
x := 42;
! genrwset: read {x.0,y.1} write {x.0,y.1}
foo(var x, 3);
! genrwset: read {x.0}
putint(x);
! genrwset: read {y.1}
putint(y)
end

View File

@ -0,0 +1,178 @@
SAT-Solver von Patrick Frankenberger
sat.tri löst das Erfüllbarkeitsproblem für beliebige Klauselmengen in konjunktiver Normalform mit dem Davis-Putnam Algorithmus und gibt eine Belegung der Variablen aus die die Klauselmenge erfüllt.
Die Eingabedaten orientieren sich dabei am Format das in http://www.intellektik.informatik.tu-darmstadt.de/SATLIB/ verwendet wird, Kommentarzeilen werden nicht unterstützt, statt der Beschreibungszeile wird nur die Zahl der Variablen gelesen und als letzter Unterschied muss nach der letzten Klausel eof folgen.
Wegen mangelnder Freispeicherverwaltung in Triangle sind die Obergrenzen der Anzahl der Variablen, Klauseln und Klausellängen im Programmtext fest eingetragen.
Variablen: max 104
Klauseln: max 550
Klausellänge: max 4
Weiterhin benötigt sat.tri eine Modifikation von TAM.Interpreter, da eine Speicherobergrenze von 1024 viel zu gering für sinnvolle Problemgrößen ist. Mit 15.000 funktioniert es, die angefügte Interpreter.java Version hat aber 63*1024 als Obergrenze.
Je nach Eingabegröße und Schwierigkeit der Eingabe variiert die Laufzeit zwischen "sofort fertig" und "viele Minuten".
Beispieleingabe (20 Variablen, 91 Klauseln):
20
-14 -9 1 0
6 11 -15 0
13 12 -4 0
-17 16 -3 0
2 17 7 0
5 -1 11 0
9 20 19 0
-17 13 16 0
-12 -19 -18 0
-6 19 14 0
14 -12 -2 0
-13 5 -16 0
-16 4 9 0
-13 15 9 0
8 16 -5 0
3 1 4 0
-20 17 -6 0
-12 -3 -16 0
-10 -6 14 0
4 18 -8 0
-8 6 3 0
12 -7 9 0
-19 -18 -16 0
-8 -17 5 0
-16 -9 1 0
18 -20 -8 0
10 -19 9 0
-5 15 -17 0
-7 -6 5 0
-5 10 2 0
16 2 10 0
17 12 -20 0
11 -6 -7 0
11 -18 5 0
12 1 -7 0
5 7 9 0
-9 2 -5 0
7 12 8 0
-11 17 -2 0
2 1 15 0
-17 15 -6 0
19 8 15 0
18 -11 -8 0
11 -15 13 0
-10 18 19 0
-14 20 6 0
-9 -10 -16 0
13 4 19 0
-16 17 -14 0
-17 -3 -15 0
3 -7 17 0
-18 11 20 0
-18 -15 1 0
15 -13 -7 0
-19 8 -15 0
8 7 -18 0
10 8 4 0
-12 -19 -1 0
1 13 11 0
-19 -20 -10 0
4 2 1 0
15 -17 18 0
15 -17 4 0
-7 8 -13 0
12 9 -4 0
9 4 18 0
5 3 2 0
1 -20 9 0
13 2 -3 0
18 19 -1 0
12 -4 16 0
6 -14 7 0
12 20 9 0
-10 19 -4 0
9 3 -12 0
7 -17 15 0
-5 3 -20 0
1 20 -9 0
12 4 15 0
-12 -11 -19 0
6 -12 -7 0
-11 -12 3 0
1 -10 12 0
-13 18 17 0
8 -16 -3 0
-12 -2 -19 0
-11 1 -2 0
17 -2 -8 0
-17 -14 -7 0
20 15 14 0
-18 -8 -6 <eof>
Beispielausgabe:
91 clauses
Testing 1
Testing 2
Testing 3
Testing 4
Testing 5
Testing 6
Testing 7
Testing 8
Testing 9
Testing 7
Testing 8
Testing 9
Testing 10
Testing 8
Testing 9
Testing 10
Testing 6
Testing 5
Testing 6
Testing 7
Testing 8
Testing 7
Testing 8
Testing 9
Testing 10
Testing 8
Testing 9
Testing 4
Testing 5
Testing 6
Testing 7
Testing 8
Testing 8
Testing 9
Testing 10
Testing 11
Testing 12
Testing 13
Testing 14
Testing 15
Testing 16
Testing 17
Testing 18
Testing 19
Testing 20
Testing 21
solution:
1=T
2=T
3=F
4=T
5=T
6=T
7=F
8=T
9=T
10=F
11=F
12=F
13=T
14=T
15=T
16=T
17=T
18=F
19=T
20=F

View File

@ -0,0 +1,161 @@
let
proc inc(var x : Integer) ~
x:=x+1;
func abs(a : Integer) : Integer ~
if a<0 then 0-a else a;
type Clause ~
record
length : Integer,
content : array 4 of Integer
end;
type CList ~
record
length : Integer,
content : array 550 of Clause
end;
type asgn ~ array 105 of Char; ! can be _T_rue, _F_alse, _U_ndefined or X=free
var numvars : Integer;
var A : asgn;
var P : CList;
var state : Char; !can be _R_unning, _D_one or _C_onflict
proc printit (Asn: asgn) ~
let var i:Integer
in begin
i:=1;
while i<=numvars do
begin
putint(i);put('=');put(Asn[i]);put(' ');puteol();
inc(var i)
end
end;
proc initA() ~
let var i : Integer
in begin
getint(var numvars);
while i<105 do
begin
if(i<=numvars) then
A[i]:='X'
else
A[i]:='U';
inc(var i)
end
end;
! reads one clause
proc readclause() ~
let var literal : Integer
in begin
getint(var literal);
while \ (literal = 0) do
begin
P.content[P.length].content[P.content[P.length].length] := literal; ! buffer overflow here !!!
inc(var P.content[P.length].length);
getint(var literal)
end
end;
! boolean clause propagation, finds implied values of variables or conflicts
proc bcpi(var A : asgn) ~
let var i : Integer; var j:Integer; var sat : Boolean;
var ind: Integer;var aind:Integer;
var cl : Clause; var numfree : Integer
in begin
i:=0;
while (state='R') /\ (i<P.length) do
begin
j:=0; sat:=false;
cl := P.content[i];
numfree:=0;
while j < cl.length do
begin
ind := cl.content[j];
aind := abs(ind);
if A[aind]='X' then inc(var numfree) else;
if ((ind<0) /\ (A[aind]='F')) \/ ((ind>0) /\ (A[aind]='T')) then
sat:=true
else;
inc(var j)
end;
if numfree=1 /\ (\sat) then begin
!putint(6666);put(' ');putint(i);puteol();
j:=0;
while j < cl.length do
begin
ind := cl.content[j];
aind := abs(ind);
if (A[aind]='X') /\ (ind>0) then A[aind]:='T' else;
if (A[aind]='X') /\ (ind<0) then A[aind]:='F' else;
inc(var j)
end;
end else;
if (numfree=0) /\ (\sat) then
begin
!putint(7777); put(' ');putint(i);puteol();
state:='C' end
else;
inc(var i)
end
end;
! lets set some variables to some values and look what happens ;)
! backtrack if conflicts arise
proc deci(var A :asgn, i : Integer) ~
let proc decir(var A : asgn, i : Integer) ~
let var pa : asgn
in begin
!putint(8800); putint(i); puteol();
if i=(numvars+1) then begin
put('s');put('o');put('l');put('u');put('t');put('i');put('o');put('n');put(':'); puteol();
printit(A); state:='D' end
else begin
!putint(8810); putint(i); puteol();
pa := A;
state:='R';
pa[i]:='T'; bcpi(var pa);
if state='R' then deci(var pa,i+1) else;
if \(state='D') then begin
!putint(8820); putint(i); puteol();
pa := A;
state:='R';
pa[i]:='F'; bcpi(var pa);
if state='R' then deci(var pa,i+1) else
end
else
end
end
in begin
put('T');put('e');put('s');put('t');put('i');put('n');put('g'); put(' '); putint(i); puteol();
if \(state='D') then
if (\(A[i]='X')) /\ (i<=numvars) then deci(var A,i+1)
else decir(var A,i)
else;
end;
proc solveit () ~
begin
state:='R';
deci(var A,1);
end;
var testeof : Boolean
in
begin
initA();
eof(var testeof);
while \ testeof do
begin
readclause();
inc(var P.length);
eof(var testeof);
end;
putint(P.length);put(' ');put('c');put('l');put('a');put('u');put('s');put('e');put('s');puteol();
solveit();
end

View File

@ -0,0 +1,4 @@
3
1 -2 3 0
-1 -2 3 0
-1 -2 -3

View File

@ -0,0 +1,430 @@
100
33 -47 -53 0
75 -76 -83 0
43 -75 -92 0
1 47 91 0
-1 16 67 0
-19 -20 -35 0
-11 51 52 0
-12 -64 -91 0
-8 17 -21 0
2 -13 80 0
-41 -64 -85 0
42 67 -89 0
-6 81 -94 0
2 8 88 0
-18 74 -98 0
-27 37 -46 0
32 34 -41 0
1 70 -75 0
27 -62 94 0
74 -83 86 0
24 73 94 0
21 -70 -87 0
5 -19 -71 0
-62 -74 91 0
-11 55 -75 0
44 -61 -95 0
-35 -47 74 0
-69 -91 96 0
10 -65 66 0
9 -59 100 0
36 -44 51 0
-16 59 -75 0
-1 -69 90 0
-8 38 -71 0
-13 22 -99 0
-50 -51 84 0
-5 72 83 0
30 33 -38 0
-12 -39 -60 0
27 62 -98 0
28 48 58 0
-33 -59 99 0
-27 -33 -60 0
-32 72 97 0
61 -64 -78 0
1 61 85 0
9 46 -57 0
-13 -29 81 0
20 78 -91 0
21 83 -94 0
4 32 -51 0
-33 61 -69 0
44 -64 -98 0
7 -73 99 0
-18 -27 -57 0
39 -74 -91 0
59 73 87 0
14 21 75 0
44 -45 -88 0
-26 -73 -97 0
34 -38 94 0
23 -37 -91 0
49 -72 -98 0
23 26 86 0
-24 -41 -78 0
-19 -85 95 0
37 61 92 0
5 56 85 0
-22 -65 92 0
-25 -26 40 0
-6 -11 60 0
3 -41 100 0
22 -25 35 0
25 63 91 0
-23 87 92 0
-44 -50 72 0
26 77 -91 0
2 14 -43 0
37 -82 87 0
36 64 73 0
31 82 89 0
-52 -69 89 0
22 -37 52 0
3 49 89 0
-34 -47 -74 0
-5 -25 -42 0
7 -23 -82 0
25 -66 69 0
-19 -72 87 0
19 29 51 0
11 16 59 0
-2 51 -90 0
-19 -76 -89 0
54 71 -100 0
4 9 -38 0
30 -42 58 0
61 69 89 0
5 -13 -66 0
48 52 67 0
-2 -8 87 0
-13 -67 -91 0
-71 75 78 0
-2 -26 96 0
1 65 99 0
-11 59 71 0
19 -20 -41 0
-21 -22 43 0
-20 32 -43 0
1 -9 39 0
3 24 -73 0
-22 80 -97 0
-11 -60 93 0
41 42 78 0
-12 19 67 0
31 37 -47 0
-23 25 27 0
-45 72 -92 0
-18 -23 -63 0
22 -33 -100 0
-30 -39 -91 0
29 60 69 0
6 -33 65 0
42 52 -69 0
-43 -54 -86 0
-20 24 41 0
-42 56 -82 0
-10 69 72 0
20 -47 -59 0
20 -25 77 0
27 -39 55 0
-36 41 67 0
72 -73 76 0
-20 -77 -86 0
34 -41 74 0
-13 -73 77 0
24 74 -92 0
-21 -39 80 0
-22 -49 -60 0
3 26 -55 0
40 44 58 0
-49 -57 -80 0
25 55 73 0
19 -38 -99 0
-28 35 43 0
28 -75 -91 0
-34 -45 71 0
41 -79 -93 0
56 -87 -91 0
-25 -46 83 0
-37 -76 -89 0
-4 -15 41 0
-6 -61 -64 0
32 62 -98 0
-10 97 -98 0
-8 55 68 0
28 32 42 0
-26 -73 -75 0
-15 -55 -61 0
33 -75 -95 0
-48 -76 98 0
-78 -85 -93 0
9 78 96 0
14 78 -96 0
15 -26 42 0
38 -79 -87 0
-14 -74 -95 0
-1 40 47 0
-4 17 26 0
-25 51 -71 0
-26 -74 -99 0
-70 -82 -96 0
31 -73 81 0
5 -62 85 0
10 23 -75 0
-45 -66 69 0
9 70 84 0
82 91 95 0
27 -62 91 0
40 -45 58 0
27 -29 45 0
52 -57 -100 0
44 55 -69 0
-18 53 82 0
-47 -51 83 0
-48 -87 95 0
22 43 100 0
42 82 89 0
-19 22 39 0
6 16 -69 0
24 -55 62 0
-9 48 -86 0
-26 32 74 0
25 -52 91 0
59 -91 93 0
-91 92 -95 0
-3 -55 85 0
35 64 71 0
26 -28 -87 0
12 -27 75 0
-11 39 97 0
-7 20 -50 0
-8 -40 -61 0
-10 -18 24 0
-59 62 75 0
30 40 -52 0
8 16 -53 0
-29 -47 -95 0
-83 97 -99 0
-38 -42 83 0
42 -66 -76 0
10 13 -67 0
-9 44 69 0
-28 34 -69 0
-1 -46 -84 0
-45 -80 -92 0
23 -66 -98 0
17 40 47 0
32 45 -85 0
20 -36 -94 0
6 -30 45 0
32 74 -96 0
15 73 100 0
11 21 -99 0
20 40 -43 0
47 52 -53 0
11 58 85 0
47 -54 -59 0
68 91 -93 0
-40 65 81 0
17 50 97 0
-58 71 93 0
-4 45 53 0
4 80 -82 0
36 -46 84 0
22 -54 96 0
9 -18 66 0
-39 44 49 0
17 58 100 0
17 54 62 0
27 62 -90 0
8 -79 -91 0
2 -29 -59 0
67 71 -89 0
46 -49 -71 0
27 74 -97 0
62 69 73 0
76 82 90 0
4 43 -65 0
38 43 53 0
13 44 -98 0
32 59 68 0
-26 87 100 0
-16 -83 90 0
-10 -20 -35 0
-2 3 7 0
59 75 89 0
-5 44 95 0
-56 73 -91 0
34 45 -77 0
6 73 -92 0
15 17 -86 0
-21 24 50 0
-11 41 -70 0
-38 70 96 0
-37 -61 100 0
-31 -41 -72 0
31 -33 52 0
67 -90 99 0
27 57 97 0
39 -77 -81 0
-4 -88 89 0
-41 -52 53 0
23 25 -58 0
-20 -29 77 0
52 -70 90 0
4 61 70 0
-43 58 79 0
6 -63 -93 0
44 84 89 0
31 -42 53 0
-32 54 -65 0
-55 71 84 0
-34 -45 48 0
2 57 76 0
28 -44 48 0
-13 -24 73 0
-19 48 -69 0
19 -63 -97 0
-33 90 -96 0
-55 -87 -92 0
19 -56 -84 0
-7 70 80 0
-18 -42 -100 0
18 -92 -96 0
-28 38 96 0
18 44 -100 0
4 72 -100 0
-40 -79 -100 0
-39 64 -91 0
-9 40 71 0
-21 24 25 0
-26 45 82 0
-23 65 -80 0
31 -52 -59 0
-9 -42 59 0
13 -18 -60 0
-33 35 49 0
-57 -58 -67 0
13 -51 83 0
7 74 -96 0
12 57 83 0
-33 -55 -95 0
-5 10 84 0
-1 -18 -80 0
-33 -76 -87 0
-23 58 65 0
-20 -74 81 0
-6 10 33 0
-14 21 39 0
9 50 56 0
85 -91 96 0
36 -50 -71 0
33 -36 85 0
23 37 99 0
-30 39 -53 0
-32 -41 -53 0
-76 -81 87 0
1 -14 -34 0
35 51 65 0
48 -87 93 0
-39 48 79 0
-41 61 89 0
52 -68 -74 0
20 40 54 0
-61 -96 -100 0
27 30 75 0
21 -73 81 0
30 92 -99 0
35 -37 -98 0
-23 -37 62 0
4 14 -39 0
58 -65 -86 0
1 -3 90 0
-11 46 62 0
64 -67 -93 0
24 73 85 0
28 -60 -97 0
47 50 -77 0
41 -68 89 0
-43 -83 90 0
53 -78 -89 0
-10 40 59 0
14 78 94 0
81 -84 98 0
-45 75 98 0
-15 -40 82 0
9 28 35 0
1 17 79 0
-38 44 -78 0
7 27 93 0
9 -11 90 0
39 55 95 0
-59 69 79 0
1 -7 58 0
18 -23 38 0
-13 49 87 0
1 -21 -53 0
65 79 -89 0
-18 -25 -87 0
35 46 50 0
8 37 -79 0
-49 -94 98 0
11 -42 77 0
-54 65 67 0
-8 52 -71 0
9 -40 52 0
1 -5 -32 0
16 -70 91 0
-13 -64 94 0
22 -42 98 0
73 78 -92 0
-16 -91 98 0
28 40 -70 0
8 35 -49 0
17 -52 62 0
9 36 -39 0
-34 -72 -84 0
51 -65 -94 0
25 -53 -90 0
-14 21 -28 0
4 -33 -83 0
-21 39 67 0
-16 -56 -63 0
-79 -85 99 0
55 79 86 0
-50 -88 95 0
61 94 100 0
-28 29 62 0
25 -66 -75 0
24 46 -60 0
-16 -48 93 0
-14 -74 91 0
18 37 75 0
-42 55 -88 0
21 55 -88 0
-20 -25 90 0
28 -50 71 0
46 52 88 0
8 29 86 0
7 -52 99 0
15 -74 -79 0
12 -18 95 0
44 -57 93 0
-47 71 -87 0
34 -58 -68 0
-23 40 -87 0
-4 -41 -99 0
-4 9 -80 0
15 -34 80 0
-73 -75 86 0
42 -43 -97 0
-51 68 77 0
22 54 -85 0
3 73 91 0
-3 -13 -26 0
28 -76 91 0
3 22 -64 0
-49 75 91 0
69 -77 100

View File

@ -0,0 +1,101 @@
50
-9 17 50 0
17 20 -50 0
17 -20 -50 0
-9 -17 39 0
-9 -17 -39 0
9 29 43 0
9 -29 43 0
9 10 -43 0
-10 -27 -43 0
4 -10 -43 0
-4 -6 -10 0
-4 11 -16 0
6 -11 -16 0
-4 6 26 0
11 -26 39 0
6 -11 39 0
-26 32 38 0
32 -38 -39 0
12 -26 -32 0
-12 25 -39 0
-13 -25 -32 0
7 -12 -25 0
-7 28 49 0
-7 -25 49 0
-7 33 -49 0
8 -33 -49 0
1 -8 -49 0
-1 -8 21 0
-1 5 36 0
-5 -8 36 0
-1 -14 -36 0
-21 -36 -50 0
14 24 -36 0
14 -24 -38 0
-23 34 50 0
-23 -24 -34 0
23 -24 -34 0
23 34 -42 0
28 34 42 0
-11 -28 42 0
15 -28 42 0
23 35 45 0
-23 -28 45 0
-15 -35 45 0
-15 -17 -45 0
12 -15 30 0
-12 30 -45 0
22 -30 -45 0
-22 -30 -37 0
-3 -22 -30 0
3 -22 -47 0
37 40 44 0
-31 40 44 0
4 13 37 0
13 37 -40 0
-13 33 -40 0
-13 -33 44 0
2 3 -44 0
-2 -40 -44 0
27 43 47 0
-2 16 41 0
-16 27 47 0
-27 41 47 0
41 -44 -47 0
-18 38 -41 0
-2 -18 -38 0
40 -41 46 0
-20 33 -46 0
-20 -33 -41 0
18 19 28 0
14 18 19 0
-14 18 19 0
-5 -19 -46 0
-5 -18 -46 0
20 21 -35 0
-19 20 -35 0
3 35 -48 0
-3 -19 -48 0
29 35 48 0
-29 31 38 0
27 31 48 0
-29 31 48 0
4 12 16 0
25 26 -42 0
-6 13 -37 0
11 25 -37 0
8 16 -47 0
1 15 -31 0
1 10 -21 0
-14 22 -42 0
32 -32 36 0
2 10 -21 0
-3 5 8 0
15 21 22 0
5 7 29 0
26 -27 50 0
30 -31 -48 0
7 -34 46 0
-6 24 49 0
2 24 46

View File

@ -0,0 +1,301 @@
90
-1 -2 0
-1 -3 0
-2 -3 0
1 2 3 0
-4 -5 0
-4 -6 0
-5 -6 0
4 5 6 0
-7 -8 0
-7 -9 0
-8 -9 0
7 8 9 0
-10 -11 0
-10 -12 0
-11 -12 0
10 11 12 0
-13 -14 0
-13 -15 0
-14 -15 0
13 14 15 0
-16 -17 0
-16 -18 0
-17 -18 0
16 17 18 0
-19 -20 0
-19 -21 0
-20 -21 0
19 20 21 0
-22 -23 0
-22 -24 0
-23 -24 0
22 23 24 0
-25 -26 0
-25 -27 0
-26 -27 0
25 26 27 0
-28 -29 0
-28 -30 0
-29 -30 0
28 29 30 0
-31 -32 0
-31 -33 0
-32 -33 0
31 32 33 0
-34 -35 0
-34 -36 0
-35 -36 0
34 35 36 0
-37 -38 0
-37 -39 0
-38 -39 0
37 38 39 0
-40 -41 0
-40 -42 0
-41 -42 0
40 41 42 0
-43 -44 0
-43 -45 0
-44 -45 0
43 44 45 0
-46 -47 0
-46 -48 0
-47 -48 0
46 47 48 0
-49 -50 0
-49 -51 0
-50 -51 0
49 50 51 0
-52 -53 0
-52 -54 0
-53 -54 0
52 53 54 0
-55 -56 0
-55 -57 0
-56 -57 0
55 56 57 0
-58 -59 0
-58 -60 0
-59 -60 0
58 59 60 0
-61 -62 0
-61 -63 0
-62 -63 0
61 62 63 0
-64 -65 0
-64 -66 0
-65 -66 0
64 65 66 0
-67 -68 0
-67 -69 0
-68 -69 0
67 68 69 0
-70 -71 0
-70 -72 0
-71 -72 0
70 71 72 0
-73 -74 0
-73 -75 0
-74 -75 0
73 74 75 0
-76 -77 0
-76 -78 0
-77 -78 0
76 77 78 0
-79 -80 0
-79 -81 0
-80 -81 0
79 80 81 0
-82 -83 0
-82 -84 0
-83 -84 0
82 83 84 0
-85 -86 0
-85 -87 0
-86 -87 0
85 86 87 0
-88 -89 0
-88 -90 0
-89 -90 0
88 89 90 0
-52 -1 0
-53 -2 0
-54 -3 0
-82 -1 0
-83 -2 0
-84 -3 0
-85 -1 0
-86 -2 0
-87 -3 0
-37 -4 0
-38 -5 0
-39 -6 0
-55 -4 0
-56 -5 0
-57 -6 0
-67 -7 0
-68 -8 0
-69 -9 0
-79 -7 0
-80 -8 0
-81 -9 0
-85 -7 0
-86 -8 0
-87 -9 0
-46 -10 0
-47 -11 0
-48 -12 0
-55 -10 0
-56 -11 0
-57 -12 0
-58 -10 0
-59 -11 0
-60 -12 0
-70 -10 0
-71 -11 0
-72 -12 0
-52 -13 0
-53 -14 0
-54 -15 0
-55 -13 0
-56 -14 0
-57 -15 0
-58 -13 0
-59 -14 0
-60 -15 0
-73 -13 0
-74 -14 0
-75 -15 0
-82 -13 0
-83 -14 0
-84 -15 0
-88 -13 0
-89 -14 0
-90 -15 0
-37 -16 0
-38 -17 0
-39 -18 0
-67 -16 0
-68 -17 0
-69 -18 0
-76 -16 0
-77 -17 0
-78 -18 0
-37 -19 0
-38 -20 0
-39 -21 0
-40 -19 0
-41 -20 0
-42 -21 0
-49 -19 0
-50 -20 0
-51 -21 0
-61 -19 0
-62 -20 0
-63 -21 0
-73 -19 0
-74 -20 0
-75 -21 0
-85 -19 0
-86 -20 0
-87 -21 0
-34 -22 0
-35 -23 0
-36 -24 0
-46 -22 0
-47 -23 0
-48 -24 0
-58 -22 0
-59 -23 0
-60 -24 0
-61 -22 0
-62 -23 0
-63 -24 0
-73 -22 0
-74 -23 0
-75 -24 0
-76 -22 0
-77 -23 0
-78 -24 0
-31 -25 0
-32 -26 0
-33 -27 0
-52 -25 0
-53 -26 0
-54 -27 0
-67 -25 0
-68 -26 0
-69 -27 0
-76 -25 0
-77 -26 0
-78 -27 0
-34 -28 0
-35 -29 0
-36 -30 0
-40 -28 0
-41 -29 0
-42 -30 0
-64 -28 0
-65 -29 0
-66 -30 0
-64 -31 0
-65 -32 0
-66 -33 0
-79 -31 0
-80 -32 0
-81 -33 0
-82 -31 0
-83 -32 0
-84 -33 0
-73 -34 0
-74 -35 0
-75 -36 0
-79 -34 0
-80 -35 0
-81 -36 0
-61 -37 0
-62 -38 0
-63 -39 0
-70 -40 0
-71 -41 0
-72 -42 0
-73 -40 0
-74 -41 0
-75 -42 0
-76 -43 0
-77 -44 0
-78 -45 0
-64 -46 0
-65 -47 0
-66 -48 0
-70 -46 0
-71 -47 0
-72 -48 0
-73 -49 0
-74 -50 0
-75 -51 0
-76 -49 0
-77 -50 0
-78 -51 0
-85 -49 0
-86 -50 0
-87 -51 0
-88 -52 0
-89 -53 0
-90 -54 0
-70 -55 0
-71 -56 0
-72 -57 0
-79 -55 0
-80 -56 0
-81 -57 0
-76 -58 0
-77 -59 0
-78 -60 0
-85 -58 0
-86 -59 0
-87 -60 0
-88 -58 0
-89 -59 0
-90 -60

View File

@ -0,0 +1,21 @@
Autor: Jens Huthmann
Das Programm sucht nach den Stellen an denen der Suchstring im zu durchsuchenden Text auftaucht. Dies geschieht mit Hilfe des Karb-Rabin Algorithmus welcher mit Hashing arbeitet. (siehe http://zuseex.algo.informatik.tu-darmstadt.de/lehre/2006ss/bioinf/mat/lecture2-p4.pdf Folien 43-49)
Die Länge des Suchstrings ist auf 500 Zeichen beschränkt und die Menge der Zeichen ist wiederum beschränkt auf {A-Z,a-z}. Der Suchstring wird als erstes eingegeben und mit Enter bestätigt.
Der zu durchsuchende String darf unendlich lang sein ist
Die Ausgabe gibt den Anfang an, an dem der Suchstring gefunden wurde. Die erste Stelle im String ist dabei 0.
Bei einer Stelle größer 32767 (maxint) wird die Stelle in Form von Stelle div maxint*maxint+Stelle mod maxint ausgegeben. Hierdurch wird die Größe des Suchstrings auf 32767 * 32767 beschränkt. Dies sollte aber für alle unseren Zwecke genügen.
Beispieleingabe
bb (Suchstring)
aabbaabbaa (Zu durchsuchender String)
Ausgabe
2,6,

View File

@ -0,0 +1,187 @@
let
const k ~ 28;
const q ~ 1000;
type Buffer ~ record
content: array 512 of Char,
first : Integer,
last : Integer
end;
type CharBuffer ~ array 28 of Integer;
proc inc(var i:Integer) ~
begin
i := i+1;
end;
proc initBuffer(var c : CharBuffer) ~
let
var i : Integer
in begin
i := 0;
while i < k do begin
c[i] := 0;
inc(var i);
end;
end;
proc compareBuffer(a : CharBuffer, b : CharBuffer, var x : Boolean) ~
let
var i : Integer
in begin
i := 1;
x := true;
while i < k do begin
if(a[i] \= b[i]) then x := false else;
inc(var i);
end;
end;
! Converts a Char to a Integer representation, ignoring case
proc charToInt(c : Char, var i : Integer) ~
let
var x : Integer
in begin
i := 0;
if(ord(c) >= ord('a')) /\ (ord(c) <= ord('z')) then i := ord(c)-ord('a')+1 else;
if(ord(c) >= ord('A')) /\ (ord(c) <= ord('Z')) then i := ord(c)-ord('A')+1 else;
end;
!computes n^m mod q
proc modpot(n : Integer, m : Integer, q : Integer, var result : Integer) ~
let
var i : Integer
in begin
i := 0;
result := 1;
while i < m do begin
result := (result * n) // q;
inc(var i);
end;
end;
proc rehash(oldHash : Integer, cRemove : Char, cAdd : Char, n : Integer, var newHash : Integer) ~
let
var x : Integer;
var y : Integer;
var res : Integer
in begin
!putint(oldHash);put('<');put(cRemove);put(' ');put('>');put(cAdd);
res := oldHash;
charToInt(cRemove,var x);
!putint(x);puteol();
modpot(k,n-1,q,var y);
!putint(res);put('-');putint(x);put('*');putint(y);puteol();
res := ((res - ( (x * y) // q))*k);
while res < 0 do res := res + q;
!put('n');putint(res);puteol();
charToInt(cAdd, var x);
!put('x');putint(x);puteol();
newHash := (res + x) // q;
!putint(newHash);puteol();
end;
proc search(var b : Buffer, sCBuffer : CharBuffer, var sbCBuffer : CharBuffer, var i : Integer, sHash : Integer, sbHash : Integer, n : Integer) ~
let
var ch : Char;
var cRemove : Char;
var cAdd : Char;
var hash : Integer;
var x : Integer;
var comp : Boolean;
var xi : Integer;
var testeol : Boolean;
var testeof : Boolean
in
begin
hash := sbHash;
xi := 0;
get(var ch);
eol(var testeol);
eof(var testeof);
while \testeol /\ \testeof do begin
if( ((i+1) // maxint) = 0 ) then inc(var xi) else;
i := i+1 // maxint;
cRemove := b.content[b.first];
charToInt(cRemove, var x);
sbCBuffer[x] := sbCBuffer[x] -1;
cAdd := ch;
charToInt(cAdd, var x);
sbCBuffer[x] := sbCBuffer[x] +1;
b.first := b.first + 1 // 512;
b.content[b.last] := cAdd;
b.last := b.first + n // 512;
rehash(hash,cRemove,cAdd,n,var hash);
if(hash = sHash) then
begin
compareBuffer(sCBuffer,sbCBuffer, var comp);
if comp then
begin
if(xi > 0) then
begin putint(xi);put('*');putint(maxint);put('+');end else;
putint(i);put(',');
end else;
end else;
!putint(sHash);put(cRemove);put('<');put('>');put(cAdd);putint(hash);puteol();
get(var ch);
eol(var testeol);
eof(var testeof);
end;
end;
proc hash(var b : Buffer,var c : CharBuffer, n : Integer, var hash : Integer) ~
let
var bla : array 2 of Integer;
var ch: Char;
var i : Integer;
var x : Integer;
var testeol : Boolean;
var testeof : Boolean
in begin
i := 0;
hash :=0;
get(var ch);
eol(var testeol);
eof(var testeof);
while (\ testeol) /\ (\testeof) /\ (i < 512) /\ ( (n < 0)\/(i<=n))do begin
hash := ((hash * k) // q);
charToInt(ch,var x);
b.content[i] := ch;
if(x > 0) /\ (x <= 26) then c[x] := c[x] +1 else;
b.first := 0;
b.last := i+1;
hash := hash + x;
bla[i//2] := hash;
inc(var i);
if (n >= 0) /\ ( i > n) then else get(var ch);
eol(var testeol);
eof(var testeof);
end;
! stupid hack start
! loop body gets executed one time to much, because eol doesn't work quite right
if(n<0)then begin
b.last := b.last -1;
!hash := hash -x;
!hash := (((hash) / k) // q);
hash := bla[i//2];
end else;
! stupid hack end
hash := hash // q
end;
var i : Integer;
var sHash : Integer;
var sCBuffer : CharBuffer;
var sbHash : Integer;
var sbCBuffer : CharBuffer;
var buffer : Buffer
in begin
i := 0;
initBuffer(var sCBuffer);
initBuffer(var sbCBuffer);
hash(var buffer, var sCBuffer, 0-1, var sHash);
!putint(sHash);puteol();
hash(var buffer, var sbCBuffer, buffer.last-1,var sbHash);
!putint(sbHash);puteol();
if(sHash = sbHash) then begin putint(i);put(','); end else;
search(var buffer, sCBuffer, var sbCBuffer, var i, sHash, sbHash, buffer.last);
end

File diff suppressed because one or more lines are too long

Some files were not shown because too many files have changed in this diff Show More