Dear Udo,
I will run your code tonight once. I just need the pictures and
will not run it again (only for further new pictures). So I don't mind
to much if it takes a long time.
Thank you!
Best wishes
Stephan
Quoting Udo und Susanne Krause <su.krause@XXXXXXX.ch>:
Hi all,
that should work, but let's make it step by step into a one-liner
and detect some unpleasant behavior of DrawPD[].
In[6]:= Head[AllKnots[12, NonAlternating]]
Out[6]= List
AllKnots[] is a List[], one can Select[] directly on it as usual
Select[AllKnots[12,
NonAlternating], (PositiveCrossings[#] == NegativeCrossings[#]) &]
In[7]:= Select[AllKnots[12, NonAlternating], (PositiveCrossings[#] ==
NegativeCrossings[#]) &] // Length
Out[7]= 107
and plot
In[5]:= GraphicsGrid[
ArrayReshape[
TimeConstrained[DrawPD[#, {Gap -> 0.025}], 20] & /@
Select[AllKnots[12,
NonAlternating], (PositiveCrossings[#] ==
NegativeCrossings[#]) &], {Ceiling[107/4], 4}]]
to reach at the result, a part of it is in the picture in the
appendix. As you see it has some $Aborted entries because the
TimeConstrained[] was not matched by DrawPD[] which is in a way
outrageous (first I run it without TimeConstrained[] and this 107
knot picture consumed more than 3.5 hours CPU time ... arrggghhhh).
One of the misbehaving knots under DrawPD[] is
In[8]:= (* das hat einen Fehler *)
DrawPD[Knot[12, NonAlternating, 873], {Gap -> 0.025}]
Out[8]= $Aborted
which has been aborted after minutes of running time by hand.
So, not to research knots, but the work of programmers, how much of
$Aborted one has to face here?
In[11]:= Length[
Select[TimeConstrained[DrawPD[#, {Gap -> 0.025}], 20] & /@
Select[AllKnots[12,
NonAlternating], (PositiveCrossings[#] ==
NegativeCrossings[#]) &], # === $Aborted &]]
Out[11]= 9
9 out of 107 is a 8.41% performance fail (at least). You could try
to get in touch with the package developers or find out how long it
takes to DrawPD[Knot[12, NonAlternating, 873], {Gap -> 0.025}].
In[14]:= DrawPD[Knot[12, NonAlternating, 873]]
During evaluation of In[14]:= KnotTheory::credits: DrawPD was
written by Emily Redelmeier at the University of Toronto in the
summers of 2003 and 2004.
Out[14]= $Aborted
Best regards
Udo.
On Fri, 27 Jul 2018 14:16:20 +0200, Peter via demug
<demug@XXXXXXX.ch> wrote:
Hallo Stephan,
versuchen Sie doch mal:
For[i = 1, i <= lo, i++,
Print@Show[DrawPD[out[[i]], {Gap -> 0.025}]]]
bzw.
For[i = 1, i <= lo, i++,
Print[Show[DrawPD[out[[i]], {Gap -> 0.025}]]]]
das sollte funktionieren
Grüße,
Peter
Am 27.07.2018 um 09:04 schrieb Stephan Rosebrock via demug:
...
and then
Show[DrawPD[out[[1]], {Gap -> 0.025}]]
Everything works fine. But
For[i = 1, i <= lo, i++,
Show[DrawPD[out[[i]], {Gap -> 0.025}]]]
shows no output at all. I don't understand that. Do you have an idea?
Best wishes
Stephan
_______________________________________________
DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
http://www.mathematica.ch/mailman/listinfo/demugArchiv:
http://www.mathematica.ch/archiv.html
*********************************************************
Dr. Stephan Rosebrock
Paedagogische Hochschule Karlsruhe
Bismarckstr. 10
76133 Karlsruhe
Deutschland / Germany
e-mail: rosebrock@XXXXXXX.de
Homepage: http://www.rosebrock.ph-karlsruhe.de/
Tel: 0721-925-4275
Fax: 0721-925-4249
*********************************************************
_______________________________________________
DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
http://www.mathematica.ch/mailman/listinfo/demug
Archiv: http://www.mathematica.ch/archiv.html
DMUG-Archiv, http://www.mathematica.ch/archiv.html