L = Sqrt(Sqr(A) + Sqr(B)) oder andersrum gesagt, Herr Pythagoras hat das früher mit 10€-Scheinen probiert, weil es mit seiner landesüblichen Währung nicht geklappt hat
Gruß Volkmar
L = Sqrt(Sqr(A) + Sqr(B)) oder andersrum gesagt, Herr Pythagoras hat das früher mit 10€-Scheinen probiert, weil es mit seiner landesüblichen Währung nicht geklappt hat
Gruß Volkmar
Fast! Das wäre schon mal die Diagonale. Aber wie lang ist der Falz?
[_5_]
./\
[5/ <==
So ist das, wenn man gar kein Geld hat. Diagonal wäre es nur mit quadratischen Scheinen
Gruß Volkmar
Lösung zu SwR 8 "Fehlerteufelchen"
----------------------------------
Der Fehler saß hier (Falsch = rot, blau = Richtig):
...
A$ = CHR$(48 + D& - 7*(D&>9)) + A$ ' + statt -
M& = M& - 1
UNTIL ((N&=0) OR (N&=1)) AND (M&<=0)
Lösung zu SwR 9 "Das liebe Geld"
========================
Die korrekte Formel lautet: Falzlänge F = y/x * SQRT(x*x+y*y). Anbei für Interessierte der Lösungsansatz.
Gruss
Lösungsansatz:
Legt man Ecken aufeinander, die vorher diagonal gegenüber standen, bildet sich ein Falz, der mit der Diagonale einen rechten Winkel einschließt (Ausprobieren!). Bezeichnen wir diie Länge des Scheines mit x, die Breite (Höhe) mit y, dann erhält man die Länge der Diagonale - wie von Volkmar schon dargestellt - durch den Satz des Pythagoras:
Diagonale² = x²+y² bzw. D = SQRT(x*x+y*y).
Sagen wir mal, die linke untere Ecke des Scheines liegt im Koordinaten-Nullpunkt U(0,0). Der "Ort um den gefaltet wird" ist der Mittelpunkt M des Geldscheins -dessen Koordinaten liegen bei x/2 und y/2. Durch die Faltung sind zwei einander ähnliche, rechtwinkelige Dreiecke entstanden:
I) Ursprung, Halbe Höhe y/2, Mittelpunkt M;
II) Halbe Unterkante x/2, Punkt wo der Falz von unten beginnt, Mittelpunkt.
Ähnlichkeit der Dreiecke bedeutet, daß sich die halbe Diagonale gegenüber der halben x-Seitenlänge um den selben Faktor verlängert wie die halbe Falzlänge zur halben Höhe. Anders ausgedrückt:
Diagonale/2 : x/2 = F / 2 : y/2
Die 2 kann man nun überall kürzen ==> D/x = F/y ==> F=D*y/x , und wir erhalten die genannte Lösung.
Abt. Schon wieder Rätsel - SwR 10: "Mit Bällen abschießen"
==========================================
Auf einer ebenen Spielfläche stellen sich 14 Spieler in unterschiedlichen Abständen voneinander auf. Auf Kommando soll jeder der Spieler den ihm am nächsten stehenden mit einem leichten Ball abschießen. Nun die Frage:
Von wievielen Bällen kann ein Spieler da maximal getroffen werden?
Es geht um eine theoretisch begründete Lösung, nicht um simples Ausprobieren wie im nachfolgenden, eher sinnlosen Simulationsprogramm ...
WindowTitle "Abschießen: Versuch läuft ..."
Window 0,0-%maxx,%maxy':randomize
var xx&=width(%hwnd):var yy&=height(%hwnd):var S&=14
print "\n Wieviele Spieler? ";:input s&:case s&=0:s&=14
declare x&[s&],y&[s&],c&[s&],d!,d![s&],cc&,cmax&,i&,j&,cmaxbisher&,n&
repeat:inc n&:clear x&[],y&[],c&[]:x&[]=rnd(xx&):y&[]=rnd(yy&)
whileloop 1,s&-1:i&=&Loop:d![i&]=10^300:cc&=0
whileloop 2,s&:j&=&Loop:case j&=i&:continue
d!=sqr(x&[i&]-x&[j&])+sqr(y&[i&]-y&[j&])
if d!<d![i&]:d![i&]=d!:cc&=j&:endif
endwhile:c&[cc&]=c&[cc&]+1
endwhile
whileloop 1,s&:if cmax& < c&[&Loop]:cmax&=c&[&Loop]:endif:endwhile
if cmax&>cmaxbisher&:cmaxbisher&=cmax&:sound 1000,100:cls
print "\n Nach Versuchen bei",s&,"Spielern maximal ";
print cmax&,"Bälle gleichzeitig abgekriegt"
endif:locate 2,8:print n&
until 0
Alles anzeigen
Abt. Wie oben, aber in 3D
==================
Bei einer Weltraumschlacht sind 14 Raumpiraten mit ihren Schiffen bei der Beute angekommen und kämpfen jetzt - jeder gegen jeden - um den wertvollen Raumfrachter. Sie haben Laserschneidkanonen an Bord. Wieviele Schüsse muss der Energieschild wegstecken können, wenn die Bordcomputer als Ziel stets den nächsten Nachbarn wählen? Das auf 3D erweiterte Progrämmchen von Rätsel SwR10 könnte da einen ersten Eindruck vermitteln.
Gruss
P.S.: Eine theorische Begründung muss ich gescheiteren Menschen überlassen. Mir falllen als Praxisbeispiel nur molekulare Bindungen ein...
WindowTitle "Laser-Abschießen 3D: Versuch läuft ..."
Window 0,0-%maxx,%maxy':randomize
var xx&=width(%hwnd):var yy&=height(%hwnd):var S&=14
print "\n Wieviele Spieler? ";:input s&:case s&=0:s&=14
declare x&[s&],y&[s&],z&[s&],c&[s&],dd!,d![s&],cc&,cmax&,i&,j&,cmaxbisher&,n&
repeat:inc n&:clear x&[],y&[],z&[],c&[]:x&[]=rnd(xx&):y&[]=rnd(yy&):z&[]=rnd(yy&)
whileloop 1,s&-1:i&=&Loop:d![i&]=10^300:cc&=0
whileloop 2,s&:j&=&Loop:case j&=i&:continue
dd!=sqr(x&[i&]-x&[j&])+sqr(y&[i&]-y&[j&])+sqr(z&[i&]-z&[j&])
if dd!<d![i&]:d![i&]=dd!:cc&=j&:endif
endwhile:c&[cc&]=c&[cc&]+1
endwhile
whileloop 1,s&:if cmax& < c&[&Loop]:cmax&=c&[&Loop]:endif:endwhile
if cmax&>cmaxbisher&:cmaxbisher&=cmax&:sound 1000,100:cls
print "\n Nach Versuchen bei",s&,"Spielern in 3D maximal ";
print cmax&,"Laserschüsse gleichzeitig abgekriegt!"
endif:locate 2,8:print n&
until 0
Alles anzeigen
Theoretische Lösung zu SwR 10 "Mit Bällen abschießen"
--------------------------------------------------------------
Gesetzt den Fall, der Beschossene steht in der Mitte eines Kreises, den die gleichzeitig auf ihn ballernden Angreifer bilden: Wie wir vom ´Regelmäßigen Sechseck´ wissen, passen dann genau 6 Personen in diesen Kreis der "am nächsten Stehenden". Nur: Die stehen alle gleich weit weg, die Bedingung lautet aber "alle mit verschiedenen Abständen" (voneinander). Also hat einer dieser 6 Angreifer keinen Platz mehr und steht jemand anderem als dem Ziel im Mittelpunkt näher.
Die Lösung lautet also 6 - 1 = 5
P.S.: Im Falle "Laserschlacht im 3D-Raum" kamen bei ~500.000 simulierten Fällen und 14 Raumpiraten bisher nur 6 gleichzeitige Treffer raus. Ich denke aber, theoretisch geht da mehr ...
Abt. Weils schon egal ist: Das Gleiche in 4 Dimensionen
===================================
WindowTitle "\qMolekülbindung\q in 4 Dimensionen simulieren"
Windowstyle 24:Window 0,0-480,80':randomize
var xx&=1000:var yy&=1000:var zz&=1000:var uu&=1000:var S&=14
print "\n Wieviele Spieler? ";:input s&:case s&=0:s&=14
declare x&[s&],y&[s&],z&[s&],u&[s&]
declare c&[s&],dd!,d![s&],cc&,cmax&,i&,j&,cmaxbisher&,n&
repeat:inc n&:clear x&[],y&[],z&[],u&[], c&[]
x&[]=rnd(xx&):y&[]=rnd(yy&):z&[]=rnd(zz&):u&[]=rnd(uu&)
whileloop 1,s&-1:i&=&Loop:d![i&]=10^300:cc&=0
whileloop 2,s&:j&=&Loop:case j&=i&:continue
dd!=sqr(x&[i&]-x&[j&])+sqr(y&[i&]-y&[j&])+sqr(z&[i&]-z&[j&])+sqr(u&[i&]-u&[j&])
if dd!<d![i&]:d![i&]=dd!:cc&=j&:endif
endwhile:c&[cc&]=c&[cc&]+1
endwhile
whileloop 1,s&:if cmax& < c&[&Loop]:cmax&=c&[&Loop]:endif:endwhile
if cmax&>cmaxbisher&:cmaxbisher&=cmax&:sound 1000,100:cls
print "\n Nach Versuchen bei",s&,"Molekülen im 4D-Raum wurden\n bisher maximal ";
print cmax&,"Bindungen gleichzeitig eingegangen!"
endif:locate 2,8:print n&
until 0
Alles anzeigen
Abt. Empfehlenswerte Youtube-Links
-----------------------------------------
Prof. Richard Wolff erklärt Erstklässlern, wie es in den Ländern zu Budgetdefiziten kommt (Englisch). So klar, dass es weh tut!
Abt. Raumpiraten in 6 Dimensionen
---------------------------------------------
WindowTitle "\qMolekül-Schwerter\q in 6 Dimensionen simulieren"
Windowstyle 24:Window 0,0-480,80':
randomize
var xx&=1000:var yy&=1000:var zz&=1000:var uu&=1000:var vv&=1000:var ww&=1000:var S&=14
print "\n Wieviele Spieler? ";:input s&:case s&=0:s&=14
declare x&[s&],y&[s&],z&[s&],u&[s&],v&[s&],w&[s&]
declare c&[s&],dd!,d![s&],cc&,cmax&,i&,j&,cmaxbisher&,n&
repeat:inc n&:clear x&[],y&[],z&[],u&[],v&[],w&[], c&[]
x&[]=rnd(xx&):y&[]=rnd(yy&):z&[]=rnd(zz&):u&[]=rnd(uu&):v&[]=rnd(vv&):w&[]=rnd(ww&)
whileloop 1,s&-1:i&=&Loop:d![i&]=10^300:cc&=0
whileloop 2,s&:j&=&Loop:case j&=i&:continue
dd!=sqrt(sqr(x&[i&]-x&[j&])+sqr(y&[i&]-y&[j&])+sqr(z&[i&]-z&[j&])+\
sqr(u&[i&]-u&[j&])+sqr(v&[i&]-v&[j&])+sqr(w&[i&]-w&[j&]))
if dd!<d![i&]:d![i&]=dd!:cc&=j&:endif
endwhile:c&[cc&]=c&[cc&]+1
endwhile
whileloop 1,s&:if cmax& < c&[&Loop]:cmax&=c&[&Loop]:endif:endwhile
if cmax&>cmaxbisher&:cmaxbisher&=cmax&:sound 1000,100:cls
print "\n Nach Versuchen bei",s&,"Molekülschwerter im 6D-Raum wurden\n bisher maximal ";
print cmax&,"Hits gleichzeitig eingegangen!"
endif:locate 2,8:print n&
until 0
Alles anzeigen
... gibt auch nicht so viel mehr Nachbarn wie gedacht.
Gruss
Also warum sich in so vielen Dimensionen unter den Füßen abwerfen lassen, wenn die Treffer die gleichen sind.
Allerdings hatte ich früher in der Schule das empfinden, das ich doch erheblich mehr Treffer abbekam.... nur eine Gedächtnislücke?
Abt. Individualisierbares ROT-13
========================
Wenn man darauf achtet, daß die Zeichenkonversionstabelle 2 x 13 (=26 Buchstaben) oder 4*13 etc. etc. Zeichen lang ist, kann man die Zeichen, in die konvertiert wird so anordnen, daß bei zweimaliger Anwendunng der selben Routine wieder der Originaltext entsteht. Sonst braucht man halt eine Kodierroutine und eine Dekodierroutine, die den Zeichensatz um die gewählte Stellenanzahl x (Hier x=13) verschiebt. Für leichte Passwort-Obfuskation ist letzteres sogar besser. Va qvrfrz Fvaar5
Gruss
P.S.: Das Verfahren ist natürlich unsicher, weil nach Zeichenhäufigkeiten leicht knackbar.
WindowTitle "ROTx-Funktionen":Cls
var t$="The quick brown fox is jumping over the lazy dog."
var d$="Franz jagt im völlig verwahrlosten Taxi quer durch Bayern."
proc ROT13 :parameters t$
declare a$,b$,c$,i&,j&,flg&
a$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789%&#+-*/=!?~([])$"
b$="NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm+-*/=!?~([])$0123456789%&#"
whileloop len(t$):i&=&Loop:flg&=0
whileloop len(a$):j&=&Loop
if mid$(t$,i&,1)=mid$(a$,j&,1)
c$=c$+mid$(b$,j&,1):flg&=1:break
endif
endwhile
case flg&=0:c$=c$+mid$(t$,i&,1)
endwhile:return c$
endproc
print t$
print Rot13(t$)
print Rot13(Rot13(t$))
print
print d$
print Rot13(d$)
print Rot13(Rot13(d$))
print
waitinput
Alles anzeigen
Abt. Semi-Primzahlen K-ter Stufe berechnen
=================================
Es handelt sich um die Rosetta Code-Aufgabe "Almost prime". Als Vorlage wurde eine Lösung in GW-Basic genommen und versucht, möglichst wenig am Originalcode zu verändern.
Also: Zeilennummern weg, Declare der verwendeten Variablen, IF-Zeilen abschließen mit Endif oder zu Case machen, THEN durch ´:´ ersetzen. Weiters musste eine ProcEnde% Variable eingebaut werden, da XProfan ein hierachisch saubers RETURN, erst nach Abschluß aller While-Schleifen, verlangt.
Gruss
P.S.: GOSUB wurde durch eine Proc mit Globalen Variablen ohne Übergabeparameter ersetzt, was nicht unbedingt erforderlich gewesen wäre. Schade, dass ich Rosetta erst jetzt entdeckt habe: Viele schöne Algorithmen!
WindowTitle "Die ersten 10 Semiprimzahlen der Stufe K berechnen"
'(CL) CopyLeft 2018-06 by P.Specht, Wien - Ohne jede Garantie
'Q: https://rosettacode.org/wiki/Almost_prime#GW-BASIC
'INFO: Übersetzt mit möglichst wenig Änderungen nach XProfan-11
WindowStyle 24:Window 0,0-%maxx,%maxy:showmax
Print "\n Semi-Primzahlen sind Zahlen, die sich nur in K Primfaktoren"
print " zerlegen lassen. K = 1 ergibt die Primzahlen selbst.\n"
'Almost prime
declare K%,I%,C%,AN%,AK%
declare F%,II%,ISKPRIME%
Whileloop 15:k%=&Loop
PRINT "k = "; K%; ": ";
LET I% = 2
LET C% = 0
WHILE C% < 10 '<<< Grenze gemäß Rosettacode-Aufgabe "Almost prime"
LET AN% = I%: LET AK% = K%: GOSUB_G1000
IF ISKPRIME% <> 0 : PRINT I%,: LET C% = C% + 1 :endif
LET I% = I% + 1
WEND
PRINT
ENDWHILE 'K%
waitinput
END
' Check if n (AN%) is a k (AK%) prime
Proc GOSUB_G1000
var procende%=0
LET F% = 0
whileloop 2,AN%:II%=&Loop
WHILE AN% MOD II% = 0
:::'Im Original genügt hier ein einfaches RETURN ohne Procende%
:::'In XProfan ist einiger Aufwand für sauberes Schleifenverlassen nötig!
::: IF F% = AK% :LET ISKPRIME% = 0 ::: procende%=1:break :endif
LET F% = F% + 1
LET AN% = AN% \ II%
WEND
::: case Procende%=1:break
Endwhile 'II%
:::case Procende%=1:RETURN
LET ISKPRIME% = (F% = AK%)
RETURN
Endproc
Alles anzeigen
Zusatzaufgabe für Puristen: Das ganze flotter und in echtem XProfan-Code schreiben ...
Abt. Semiprimzahlen in Good Old XProfan
===========================
Etwas schneller, wenn auch noch nicht weltbewegend. Ein Fall für Asssembler?
Gruss
WINDOWTITLE "DIE ERSTEN N SEMI-PRIMZAHLEN DER STUFEN K.. BERECHNEN"
CLEARCLIP:DECLARE K%,I%,C%,AN%,AK%,F%,II%,ISKPRIME%,GRZ%,ENDE%,K1%,TM% : REPT:
CLS:PRINT "\n SEMI-PRIMZAHLEN AB WELCHER STUFE? ";:INPUT K%
IF K%=0:K%=6:K1%=6:GRZ%=16:GOTO "SKIP":ENDIF
PRINT " BIS ZU WELCHER STUFE? ";:INPUT K1%
PRINT "\n WIEVIELE SOLCHE ZAHLEN JEWEILS? ";:INPUT GRZ% : SKIP:
PRINT:FONT 2:TM%=&gettickcount
WHILELOOP K%,K1%:K%=&LOOP
PRINT " K=";K%; ": ";:PUTCLIP "\n"+str$(K%)+": "
I%=2:CLEAR C%
WHILE C%<GRZ%
AN%=I%:AK%=K%
CLEAR ENDE%,F%
WHILELOOP 2,AN%:II%=&LOOP
WHILENOT AN% MOD II%
IF F%=AK%:ISKPRIME%=0:ENDE%=1:BREAK:ENDIF
INC F%:AN%=AN%\II%
ENDWHILE:CASE ENDE%=1:BREAK
ENDWHILE
CASENOT ENDE%:ISKPRIME%=(F%=AK%)
IF ISKPRIME%:PRINT I%,:PUTCLIP str$(I%)+",":INC C%
ENDIF:INC I%
ENDWHILE:PRINT
ENDWHILE:TM%=&GetTickCount-TM%:FONT 0
Print "\n [Errechnet und ausgegebem in",TM%,"ms] ";
PRINT " OK, SIEHE ZWISCHENABLAGE! (ESC=ENDE)":SOUND 100,100
WAITINPUT:CASE %KEY<>27:GOTO "REPT"
END
Alles anzeigen
P.S.: Bench K=7 bis 9, jeweils die ersten 10 Semiprimes: 80 Sekunden (Compiler)
Abt. Semiprimzahlen in XPSE-XProfan
=======================
Hier einLink zur GeZIPten EXE des nachfolgenden XPSE-Enhanced XProfan Sourcecodes.
Achtung: Nur bis K=30 als sicher ausgetestet: K=30, 1.Wert in 32 s. KEINE GEWÄHR!
{$cletq}
WINDOWTITLE "DIE ERSTEN N SEMI-PRIMZAHLEN DER STUFEN K.. BERECHNEN"
CLEARCLIP
DECLARE K%,I%,C%,AN%,AK%,GRZ%,K1%,TM%
REPT:
CLS
PRINT "\n SEMI-PRIMZAHLEN AB WELCHER STUFE? ";
INPUT K%
IF K%=0
K%=6:K1%=6:GRZ%=16
GOTO "SKIP"
ENDIF
PRINT " BIS ZU WELCHER STUFE [MAX. 30]? ";
INPUT K1%
PRINT "\n WIEVIELE SOLCHE ZAHLEN JEWEILS? ";
INPUT GRZ%
SKIP:
PRINT
FONT 2
TM%=&gettickcount
WHILELOOP K%,K1%
K%=&LOOP
PRINT " K=";K%; ": ";
PUTCLIP "\n"+str$(K%)+": "
I%=2^k%
CLEAR C%
WHILE C%<GRZ%
IF ISKPRIME(i%,k%)
PRINT I%,
PUTCLIP str$(I%)+","
INC C%
ENDIF
INC I%
ENDWHILE
PRINT
ENDWHILE
TM%=&GetTickCount-TM%
FONT 0
Print "\n [Errechnet & ausgegeben in",TM%,"ms = ";(TM%+500)\1000,"s]"
PRINT "\n Ergebnisse nach Zwischenablage kopiert! Ende mit ESC"
SOUND 100,100
WAITINPUT
CASE %KEY<>27:GOTO "REPT"
END
nProc ISKPRIME :parameters AN&,AK&
declare II&,F&,ISKPRIME&,ENDE&
ENDE&=0
F&=0
WHILELOOP 2,AN&
II&=&LOOP
WHILENOT AN& MOD II&
IF F&=AK&
ISKPRIME&=0
ENDE&=1
BREAK
ENDIF
INC F&
AN& = AN& div II&
ENDWHILE
CASE ENDE&=1:BREAK
ENDWHILE
CASENOT ENDE&:ISKPRIME&=(F&=AK&)
RETURN ISKPRIME&
Endproc
Alles anzeigen
P.S.: Bench K=7 bis 9, jeweils die ersten 10 Semiprimes: 200 ms (450 x beschleuigt)
Abt. Lucas-Lehmer-Test
===============
Für sog. Mersenne-Zahlen, das sind Zahlen der Form (2^p - 1), haben die Herren Edouard Lucas (F) und Derrick Lehmer (USA) einen sicheren Primzahl-Test gefunden, der bei der Jagd nach immer größeren Primzahlen eine für die Zahlentheorie wichtige Rolle spielt. Allerdings werden die Zahlen um die es dabei geht immens groß!
Die derzeitige Rekordzahl lautet 277,232,917-1 mit 23,249,425 Dezimalstellen (Pace, Woltman, Kurowski, Blosser) mit der Freeware-Kooperative G I MPS (Stand 26. Dez. 2017).
Einen winzigen Ausschnitt davon können Programme mit Doppeltgenauen Floatingpoint-Mathepaketen darstellen (... eine Rosetta Code Aufgabe). Die Rechengrenze beträgt 94906265, weil dessen Quadrat die vorhanden 53 bits der Floatingpoint-Darstellung im PC bereits übersteigt, höher geht deshalb vorerst nix mehr... Man kann sich aber vage vorstellen, welchen Rechenaufwand führende Mathe-Institute in Sachen ´Jagd nach Mersenne-Primes´ treiben: LINK
Gruss
WindowTitle "Lukas-Lehmer-Test (Nur bis 2^47)":CLS:font 2
PRINT "\n sucht Mersenne-Zahlen M=2^p-1, die zugleich Primzahlen sind:\n"
Print " Musterlösung: M2,M3,M5,M7,M13,M17,M19,M31,M61,M89,M107,M127,...\n"
Declare mp!
Whileloop 2,47
Case Lucas_Lehmer(&Loop):PRINT " M";&Loop,tab(10);Bin$(mp!)
Endwhile
Waitinput
End
Proc Lucas_Lehmer
Parameters p&
Declare i&,sn!':Global mp!
case p& < 2:return 0
case p& = 2:return 1
casenot (p& AND 1):return 0
mp! = 2 ^ p& - 1 'Mersennezahl berechnen
sn! = 4
whileloop 3,p&
case sn!=0:break
case sn!>94906265:break
sn! = sn!^2 - 2
sn! = sn! - (mp! * Intf(sn! / mp!))
Endwhile
Return (sn! = 0)
EndProc
proc frac :parameters x!
var s!=(x!>0)-(x!<0)
x!=abs(x!)
x!=x!-round(x!,0)
case x!<0:x!=1+x!
return s!*x!
endproc
proc intf :parameters x!
var s!=(x!>0)-(x!<0)
x!=abs(x!)
x!=x!-frac(x!)
return s!*x!
endproc
Alles anzeigen
Abt. The Bottle Battle
==============
... eine weitere Rosetta Code-Aufgabe, zugegeben etwas lächerlich
Gruss
WindowTitle " T H E B O T T L E B A T T L E"
'http://rosettacode.org/wiki/99_Bottles_of_Beer
CLS:font 2:var nbr&=12:var W&=3000 'ms
declare a$,a1$,b$,b1$,c$,d$,d1$,e$,f$,f1$,f2$,g$,g1$,h$,h1$
a$="There are ":a1$="There is ":b$="Now there are ":b1$="Now there is "
c$="no more":d$="bottles of beer":d1$="bottle of beer":e$=" on the wall."
f$="And if one bottle ":f2$="And if this bottle ":f1$="And if no bottles "
g$="should accidentally fall,":g1$="can accidentally fall:"
h$="then take it up and pass it around!"
h1$="Then buy another "+str$(nbr&)+" bottles,\n\n and put it on the wall!"
Repeat:w&=w&-150:whileloop nbr&,0,-1
print "\n ";if(&Loop<11,if(&Loop=1,b1$,b$),a$);\
if(&Loop,&Loop,c$),if(&loop=1,d1$,d$);e$ :waitinput W&
print "\n ";if(&Loop,&loop,upper$(c$)),if(&Loop=1,d1$,d$);"!" :waitinput W&
print "\n ";if(&loop,if(&Loop=1,f2$,f$),f1$) :waitinput W&
print "\n ";if(&Loop=0,g1$,g$):waitinput W&
print "\n ";if(&Loop=0,h1$,h$):waitinput W&
print:endwhile:Until %key=27:End
Alles anzeigen
Abt. Primzahl-Prüfverfahren für 4-Byte Long-Variablen
==================================
Wieder eine Rosetta Code-Aufgabe!
Gruss
WindowTitle "Primprüfung nach der simplen Modulo-Methode"
'Einfachste Primalitätsprüfung bis max 2^32-1 (Long-Variable)
'https://rosettacode.org/wiki/Primality_by_trial_division
'Write a boolean function that tells whether a given integer is prime'
WindowStyle 24:Window 10,10 - 350,80:font 1
Proc prime :parameters n&
declare i&,max&,prime&
if n&=2: prime&=1
elseif (n&<=1) or ((n& mod 2)=0): prime&=0
else
prime&=1
i&=3:max&=sqrt(n&)
while i&<=max&
if (n& mod i&)=0
prime&=0
Break
endif
inc i&,2
endwhile
endif
return prime&
endproc
var cnt&=0
WhileLoop 2^31-100000,2^31-1
if prime(&Loop)
locate 2,4
inc cnt&
print cnt&;": ";&Loop,
endif
endwhile
print "\n ---":beep
Waitinput
End
Alles anzeigen
Abt. Rosetta Code mit Float-Primzahltest
==========================
... in purem XProfan natürlich ab 30. Zahl eher langsam.
Gruss
WindowTitle "Rosetta Code Aufgabe: Increment_loop_index_within_loop_body"
'https://rosettacode.org/wiki/Loops/Increment_loop_index_within_loop_body
'Write a loop which: starts the index variable at 42;
' At iteration time, increments the index by unity
'if the index is prime:
' displays the index and the prime (to the terminal)
' increments the index such that the new index is now that prime
'terminates the loop when 42 primes are shown
' OUTPUT:
'n = 1 43 'n = 2 89
'n = 3 179 'n = 4 359
'n = 5 719 'n = 6 1,439
'n = 7 2,879 'n = 8 5,779
'n = 9 11,579 'n = 10 23,159
'n = 11 46,327 'n = 12 92,657
'n = 13 185,323 'n = 14 370,661
'n = 15 741,337 'n = 16 1,482,707
'n = 17 2,965,421 'n = 18 5,930,887
'n = 19 11,861,791 'n = 20 23,723,597
'n = 21 47,447,201 'n = 22 94,894,427
'n = 23 189,788,857 'n = 24 379,577,741
'n = 25 759,155,483 'n = 26 1,518,310,967
'n = 27 3,036,621,941 'n = 28 6,073,243,889
'n = 29 12,146,487,779 'n = 30 24,292,975,649
'n = 31 48,585,951,311 'n = 32 97,171,902,629
'n = 33 194,343,805,267 'n = 34 388,687,610,539
'n = 35 777,375,221,081 'n = 36 1,554,750,442,183
'n = 37 3,109,500,884,389 'n = 38 6,219,001,768,781
'n = 39 12,438,003,537,571 'n = 40 24,876,007,075,181
'n = 41 49,752,014,150,467 'n = 42 99,504,028,301,131
Proc primes :parameters n!
declare max!,prime!',i&
if n!=2: prime!=2
elseif (n!<=1) or (remodf(n!,2)=0): prime!=0
else
prime!=n!
i!=3:max!=sqrt(n!)
while i!<=max!
if remodf(n!,i!)=0
prime!=0
Break
endif
i!=i!+2
endwhile
endif
return prime!
endproc
WindowStyle 24:CLS:font 1
declare cnt&,p!,i!,Loop!
var k!=43
Repeat
Loop!=k!
While Loop!<=(2^53-1)
p!=primes(Loop!)
if p!
inc cnt&
print cnt&;": ";tab(19-lg(p!+1));format$("#,##0",p!)
k!=k!+p!-1
BREAK
endif
k!=k!+1
Loop!=Loop!+1
endwhile
until cnt&>=42
print "\n ---":beep
Waitinput
End
proc floor :parameters x!
case abs(x!)<(10^-35):return 0
case x!>0:return intf(x!)
return (abs(x!-intf(x!)) < 10^-35)-intf(abs(x!-1))
endproc
proc remodf :parameters x!,y!
case abs(x!)<(10^-35):return 0
case abs(y!)<(10^-35):return x!
return ((x!>0)-(x!<0))*abs(x!-y!*floor(x!/y!))
endproc
proc frac :parameters x!
var s!=(x!>0)-(x!<0)
x!=abs(x!)
x!=x!-round(x!,0)
case x!<0:x!=1+x!
return s!*x!
endproc
proc intf :parameters x!
var s!=(x!>0)-(x!<0)
x!=abs(x!)
x!=x!-frac(x!)
return s!*x!
endproc
Alles anzeigen
Sie haben noch kein Benutzerkonto auf unserer Seite? Registrieren Sie sich kostenlos und nehmen Sie an unserer Community teil!