Italia
Fonte/ Codesnippets

Umleer-Rätsel per zwei Behälter lösen

 

p.specht

Inspiriert vom "Simon-says"-Rätsel aus dem Film "Stirb langsam", liefert dass nachstehende Programm mögliche Umleer-Abfolgen zur Erzielung bestimmter Zielmengen - allerdings nicht immer die kürzeste Variante: Dreht man die beiden Gefäßkapazitäten um, ergeben sich oft kürzere Wege zum Erfolg.

Hinweis: Nur wenn eine der Gefäßkapazitäten eine Primzahl ist, oder die beiden Fassungsvermögen "relativ prim" zueinander sind (GgT=1), werden (in beiden Richtungen) garantiert alle überhaupt möglichen Ergebnisse geliefert.


Damit lassen sich auch die sog. Zwei-Sanduhren-Rätsel lösen. Im Programm wird dann ermittelt, wie man den fehlenden Restwert an Zeit erzeugen kann.
WindowTitle "Umleer-Rätsel per 2 Behälter lösen"
declare Ziel&, LMax&,RMax&,L&,R&,n&,kann&,ist&
Beginn:
CLS:Font 2:Print " Ziel = ";:Input Ziel&
' Ziel&=2
LMax&=7
RMax&=11
Case Ziel&<0:ziel&=abs(ziel&)
Ziel&=Ziel& mod if(LMax&>RMax&,LMax&,RMax&)
n&=0:L&=0:R&=0

Repeat

    'Wenn Ziel erreicht:

    if (LMax&=Ziel&) or (RMax&=Ziel&):inc n&:break:endif

        if (L&=Ziel&) or (R&=Ziel&):Zeigen:break:endif

            'Wenn etwas da ist zum transportieren und keine Kapazität frei ist: Mache frei!

            if (L&>0) and (R&=RMax&):R&=0:inc n&: Zeigen :Endif

                'Wenn nichts mehr da ist zum transportieren, schöpfe neu!

                if (L&=0):L&=LMax&:inc n&: Zeigen :endif

                    'Wenn etwas da ist zum transportieren und noch Kapazität frei ist: Leere um!

                    if (L&>0) and (R&<RMax&): Umleeren :inc n&: Zeigen :Endif

                    Until (L&=Ziel&) or (R&=Ziel&)

                    print " ";n&;" Schritte."
                    Waitinput
                    Goto "Beginn"

                    Proc Umleeren

                        kann&=RMax&-R& : ist&=if(kann&<L&,kann&,L&)
                        L&=L&-ist& : R&=R&+ist&

                    Endproc

                    Proc Zeigen

                        print tab(3);n&;". ";tab(12);L&,tab(20);R&

                        if %csrlin>20:waitinput 2000:cls:endif

                        Endproc

                        END
 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
30.05.2021  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

1.469 Views

Untitledvor 0 min.
p.specht21.11.2021
R.Schneider20.11.2021
Uwe Lang20.11.2021
Manfred Barei19.11.2021
Di più...

Themeninformationen

Dieses Thema hat 1 subscriber:

p.specht (1x)


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie