Italia
Fonte/ Codesnippets

Partitionierungen am Beispiel "Meterstab in Stücke hacken"

 

p.specht

In welche und wieviele verschiedene "Zerhackungs-Anordnungen" kann man einen Meßstab von z.B. 70 cm Länge hacken, vorausgesetzt die Schnitte sind äusserst dünn (Laser?) und alle Einzelteile müssen 1 cm oder ein Vielfaches davon lang sein? Dabei soll die physische Anordnung der Einzelstücke egal sein, zusammen müssen sie nur 70 cm ergeben.

Die Frage taucht u.a. in der Wellenphysik, in der Technischen Chemie, aber auch beim Packen von Standardprodukten in vorggegebene Schachteln auf. Die Herren Zoghbi und Stojmenovic konnten dazu 1998 Ihren ZS1-Algorithmus vorstellen, der immerhin viermal schneller als alle bisherigen war. In reinem XProfan braucht man naturalmente etwas länger als in Maschinencode, aber zu Demo-Zwecken reicht das nachstehende Machwerk durchaus. Die Antwort: 70 kann auf 4.087.967 Arten in Stücke gehackt plus einmal ganz gelassen werden.


Quellenangabe: Artikel aus "Fast Algorithms for Generating Integer Partitions. International Journal of Computer Mathematics, 70, 1998" 
WindowTitle "Algorithm ZS1: Erzeugung einer vollständigen, "+\
"revers-geordneten Partitionierung ohne Wiederholung"
'Q: Antoine Zoghbi, Ivan Stojmenovic: Fast Algorithms for Generating Integer Partitions
'   published in: "International Journal of Computer Mathematics, 70, 1998, 319-332."
'S: [url]https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.1287&rep=rep1&type=pdf[/url]
'T: Translation to XProfan 11.2a 2016-07ff by P.Specht, Vienna/Austria
'No Warranty whatsoever! Ohne jedwede Gewähr! Rechtslage ungeprüft.
WindowStyle 24:Window 0,0-%maxx,%maxy:font 2:randomize
declare z$,z&,tm&,cnt&,bench&:   Rept:
Cls:Print "\n  ZAHL, die partitioniert werden soll (0: Ende; Minuszahl: Nur Zeitmessung)? : ";
z$="":input z$:bench&=0:case val(z$)<0:bench&=1:z&=rnd(30):case z$>"":z&=abs(val(z$))

if z&=0:print "\n  Ergebnis: Leere Menge.\n\n  Programm wird beendet! ":beep:waitinput 4000:END:endif

    case bench&:print "\n  Messung corre ..."
    tm&=&GetTickCount
    cnt& = Algorithm_ZS1(z&,bench&)
    print "\n  ";cnt&;" Partitionen erzeugt."

    if bench& : tm&=&GetTickCount-tm&

        print "\n  Laufzeit per n = ";z&;": ";tm&;" [ms] bzw. ";tm&/1000;" [s] bzw. ";tm&/60000;" [min]"

    endif

    sound 2000,60
    waitinput
    Goto "Rept"
    END

    Proc Algorithm_ZS1 :parameters n&,bench&

        declare x&[n&],i&,m&,h&,r&,t&,cnt&

        whileloop n&

            x&[&loop]=1

        endwhile

        x&[1]=n&
        m&=1:h&=1
        cnt&=1
        casenot bench&:print "\n>>> ";x&[1]'show or do something useful

        while x&[1]<>1

            if x&[h&]=2'Easy case, applies often

                ' h is the index of the last part of partition which is greater than 1
                ' m is the number of parts.
                inc m&:x&[h&]=1:dec h&

            else

                r&=x&[h&]-1
                t&=m&-h&+1
                x&[h&]=r&

                while t&>=r&

                    inc h&
                    x&[h&]=r&
                    t&=t&-r&

                endwhile

                if t&=0

                    m&=h&

                else

                    m&=h&+1

                    if t&>1

                        inc h&:x&[h&]=t&

                    endif

                endif

            endif

            inc cnt&

            ifnot bench&:print "    ";:whileloop m&:print x&[&Loop],:endwhile:print:endif

                'or do something useful with the result line

            endwhile

            return cnt&

        EndProc

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




p.specht

Hier die AUFSTEIGENDE Version der Partitionierungsmethode: Der ZS2-Algorithmus, nachgeliefert als Ergänzung zum obigen Beitrag.
WindowTitle "Algorithm ZS2: Erzeugung einer vollständigen, "+\
"AUFSTEIGEND geordneten Partitionierung ohne Wiederholung"
'Q: Antoine Zoghbi, Ivan Stojmenovic: Fast Algorithms for Generating Integer Partitions
'   published in: "International Journal of Computer Mathematics, 70, 1998, 319-332."
'S: https://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.1287&rep=rep1&type=pdf
'T: Translation to XProfan 11.2a 2016-07ff by P.Specht, Vienna/Austria
'No Warranty whatsoever! Ohne jedwede Gewähr!
'
'Test your results against "Partition Numbers" of https://oeis.org/A000041
'00>>> 1, 1, 2, 3, 5,   7, 11, 15, 22, 30,
'10>>> 42, 56, 77, 101, 135,   176, 231, 297, 385, 490,
'20>>> 627, 792, 1002, 1255, 1575,   1958, 2436, 3010, 3718, 4565,
'30>>> 5604, 6842, 8349, 10143, 12310,   14883, 17977, 21637, 26015, 31185,
'40>>> 37338, 44583, 53174, 63261, 75175,   89134, 105558, 124754, 147273,173525
'50>>> ...
WindowStyle 24:Window 0,0-%maxx,%maxy:randomize:font 2
declare z$,z&,tm&,cnt&,bench&:   Rept:
Cls:Print "\n  ZAHL, welche partitioniert werden soll (0: Ende; Minuszahl: Nur Zeitmessung)? : ";
z$="":input z$:bench&=0:case val(z$)<0:bench&=1:z&=rnd(30):case z$>"":z&=abs(val(z$))

if z&=0:print "\n  Ergebnis: Leere Menge.\n\n  Programm wird beendet! ":beep:waitinput 4000:END:endif

    case bench&:print "\n  Messung corre ..."
    tm&=&GetTickCount
    cnt& = Algorithm_ZS2(z&,bench&)
    tm&=&GetTickCount-tm&
    print "\n  ";cnt&;" Partitionen erzeugt."

    if bench&:print "\n  Laufzeit per n = ";z&;": ";tm&;" [ms] bzw. ";tm&/1000;" [s] bzw. ";tm&/60000;" [min]"

        endif :sound 2000,60:waitinput
        Goto "Rept"
        END

        Proc Algorithm_ZS2 :parameters n&,bench&

            declare x&[n&],i&,m&,h&,r&,j&,cnt&

            if n&=1:print "       ";1 :cnt&=1:goto "ZS2_exit":endif

                :whileloop n&:x&[&loop]=1:endwhile
                cnt&=1

                ifnot bench&:print "\n>>> ";:whileloop n&:print x&[&Loop],:endwhile:print

                endif'or do something useful with the result line

                x&[0]=-1:x&[1]=2:m&=n&-1:h&=1:inc cnt&

                ifnot bench&:print "    ";:whileloop m&:print x&[&Loop],:endwhile:print

                endif'or do something useful with the result line

                while x&[1]<>n&

                    if (m&-h&)>1

                        inc h&
                        x&[h&]=2
                        dec m&

                    else

                        j&=m&-2

                        While x&[j&]=x&[m&-1]

                            x&[j&]=1
                            dec j&

                        endwhile

                        h&=j&+1
                        x&[h&]=x&[m&-1]+1
                        r&=x&[m&]+x&[m&-1]*(m&-h&-1)
                        x&[m&]=1
                        case (m&-h&)>1:x&[m&-1]=1
                        m&=h&+r&-1

                    endif

                    inc cnt&

                    ifnot bench&:print "    ";:whileloop m&:print x&[&Loop],:endwhile:print:endif

                        'or do something useful with the result line

                    endwhile

                    ZS2_exit:
                    return cnt&

                EndProc

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




p.specht

Partitionen der Länge 1 bis max. M zählen
-----------------------------------------------------
Anbei ein rekursives Zählprogramm per die Anzahl möglicher Zerschnipselungen (="Partitionen") eines N Einheiten langen Stabes (="Anordnung von Elementen") in Teilstrecken der Länge von 1 bis maximal M (= "Klassen bis Klassengröße M").
WindowTitle "Teilungsmöglichkeiten zählen":WindowStyle 24:cls
Print "\n Dieses Programm zählt die möglichen Teilungen von N Elementen"
print "\n per zulässige Teilungsgrößen von 1 bis M Elementen.\n"
declare n&,m&,count!
nochmal:
clear n&,m&,count!
print "\n    Gesamtlänge N = ";:input n&
print "\n Max. Teillänge M = ";:input m&
print "\n Count ergibt ";format$("%g",Count_partitions(n&,m&));" mögliche Teilungen!\n"
waitinput:cls:goto "nochmal"

proc count_partitions :parameters n&,m&

    if n&=0:return 1

    elseif n&<0:return 0

    elseif m&=0:return 0

    else

        return count_partitions(n&-m&,m&)+count_partitions(n&,m&-1)

    endif

Endproc


Probe: count(6,4) sollte 9 ergeben:

6 = 2 + 4
6 = 1 + 1 + 4
6 = 3 + 3

6 = 1 + 2 + 3
6 = 1 + 1 + 1 + 3
6 = 2 + 2 + 2

6 = 1 + 1 + 2 + 2
6 = 1 + 1 + 1 + 1 + 2
6 = 1 + 1 + 1 + 1 + 1 + 1

... stimmt also!
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
24.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.944 Views

Untitledvor 0 min.
p.specht20.11.2021
Uwe Lang20.11.2021
Manfred Barei19.11.2021
Wilfried Friebe17.11.2021
Di più...

Themeninformationen

Dieses Thema hat 1 subscriber:

p.specht (3x)


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