diff options
Diffstat (limited to 'texmf-dist/scripts')
194 files changed, 0 insertions, 84202 deletions
diff --git a/texmf-dist/scripts/ketcindy/LICENSE.txt b/texmf-dist/scripts/ketcindy/LICENSE.txt deleted file mode 100644 index 505587ff..00000000 --- a/texmf-dist/scripts/ketcindy/LICENSE.txt +++ /dev/null @@ -1,14 +0,0 @@ -// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team
-//
-//This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation; either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see <http://www.gnu.org/licenses/>
diff --git a/texmf-dist/scripts/ketcindy/data/fontF/0Small.png b/texmf-dist/scripts/ketcindy/data/fontF/0Small.png Binary files differdeleted file mode 100644 index 8d491ce0..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/0Small.png +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/0Smalla-h.png b/texmf-dist/scripts/ketcindy/data/fontF/0Smalla-h.png Binary files differdeleted file mode 100644 index 4578fb1e..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/0Smalla-h.png +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/0Smalli-o.png b/texmf-dist/scripts/ketcindy/data/fontF/0Smalli-o.png Binary files differdeleted file mode 100644 index 812d3755..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/0Smalli-o.png +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/0Smallp-w.png b/texmf-dist/scripts/ketcindy/data/fontF/0Smallp-w.png Binary files differdeleted file mode 100644 index 29c6c446..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/0Smallp-w.png +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/0Smallxyz.png b/texmf-dist/scripts/ketcindy/data/fontF/0Smallxyz.png Binary files differdeleted file mode 100644 index a4e3a6a6..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/0Smallxyz.png +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/nsi.cdy b/texmf-dist/scripts/ketcindy/data/fontF/nsi.cdy Binary files differdeleted file mode 100644 index 53393398..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/nsi.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/nsi.txt b/texmf-dist/scripts/ketcindy/data/fontF/nsi.txt deleted file mode 100644 index 3492d65d..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/nsi.txt +++ /dev/null @@ -1,29 +0,0 @@ -nsin// -start// -[[2,0]]// -end// -nsi1k// -start// -[[-1.7646,1.9555],[-0.8458,1.7871],[-1.3206,-0.0046]]// -end// -nsi1c// -start// -[[-1.4431,3.395],[-0.5243,3.104]]// -end// -start// -[[-0.9837,1.3328],[-1.1521,0.664]]// -end// -nsi2k// -start// -[[-1.3206,-0.0046],[-0.9224,1.5114],[0.9152,1.4348],[1.7115,0.9601]]// -end// -nsi2c// -start// -[[-1.1776,0.5007],[-1.0449,1.0367]]// -end// -start// -[[-0.218,3.7166],[1.6962,3.104]]// -end// -start// -[[0.0919,-0.3982],[1.4206,-0.2037]]// -end//// diff --git a/texmf-dist/scripts/ketcindy/data/fontF/pcr.cdy b/texmf-dist/scripts/ketcindy/data/fontF/pcr.cdy Binary files differdeleted file mode 100644 index cc8891d0..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/pcr.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/pcr.txt b/texmf-dist/scripts/ketcindy/data/fontF/pcr.txt deleted file mode 100644 index 76c429b5..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/pcr.txt +++ /dev/null @@ -1,26 +0,0 @@ -pcrn// -start// -[[2,0]]// -end// -pcr1k// -start// -[[-1.4642,4.3617],[-1.4816,0.0001]]// -end// -pcr1c// -start// -[[-1.4642,3.0117],[-1.4642,1.5578]]// -end// -pcr2k// -start// -[[-1.7654,4.3962],[0.3658,4.3899],[0.3704,2.1982],[-1.4816,2.1982]]// -end// -pcr2c// -start// -[[-1.1236,4.3899],[0,4.3899]]// -end// -start// -[[1.8552,4.3638],[1.7769,2.2211]]// -end// -start// -[[0.0242,2.1982],[-0.72,2.1982]]// -end//// diff --git a/texmf-dist/scripts/ketcindy/data/fontF/qcr.cdy b/texmf-dist/scripts/ketcindy/data/fontF/qcr.cdy Binary files differdeleted file mode 100644 index ad28dd15..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/qcr.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/qcr.txt b/texmf-dist/scripts/ketcindy/data/fontF/qcr.txt deleted file mode 100644 index 58a390e9..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/qcr.txt +++ /dev/null @@ -1,23 +0,0 @@ -qcrn// -start// -[[2,0]]// -end// -qcr1k// -start// -[[0,0.1212],[0,4.5347],[0,0.1212]]// -end// -qcr1c// -start// -[[2.5616,0.1904],[2.527,4.5347]]// -end// -start// -[[-2.527,4.4828],[-2.527,0.1731]]// -end// -qcr2k// -start// -[[0,1],[2.1808,-0.1904]]// -end// -qcr2c// -start// -[[0.9866,0.9692],[1.402,-0.1731]]// -end//// diff --git a/texmf-dist/scripts/ketcindy/data/fontF/rcr.cdy b/texmf-dist/scripts/ketcindy/data/fontF/rcr.cdy Binary files differdeleted file mode 100644 index e5a02dd9..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/rcr.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/rcr.txt b/texmf-dist/scripts/ketcindy/data/fontF/rcr.txt deleted file mode 100644 index f668aba4..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/rcr.txt +++ /dev/null @@ -1,34 +0,0 @@ -rcrn// -start// -[[3,0]]// -end// -rcr1k// -start// -[[-1.5231,4.4135],[-1.5231,0]]// -end// -rcr1c// -start// -[[-1.5231,2.9424],[-1.5231,1.4712]]// -end// -rcr2k// -start// -[[-1.7827,4.4135],[0.6231,4.4135],[0.5885,2.3366],[-1.5231,2.3366]]// -end// -rcr2c// -start// -[[-0.9808,4.4135],[-0.1788,4.4135]]// -end// -start// -[[2.0943,4.4135],[2.025,2.3539]]// -end// -start// -[[-0.1038,2.3366],[-0.75,2.3366]]// -end// -rcr3k// -start// -[[-0.3981,2.3366],[1.8866,-0]]// -end// -rcr3c// -start// -[[1.2808,2.3193],[1.0731,1.2462]]// -end//// diff --git a/texmf-dist/scripts/ketcindy/data/fontF/tsi.cdy b/texmf-dist/scripts/ketcindy/data/fontF/tsi.cdy Binary files differdeleted file mode 100644 index 2fa6231c..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/tsi.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/tsi.txt b/texmf-dist/scripts/ketcindy/data/fontF/tsi.txt deleted file mode 100644 index 6a51e190..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/tsi.txt +++ /dev/null @@ -1,23 +0,0 @@ -tsin// -start// -[[2,0]]// -end// -tsi1k// -start// -[[-0.9341,2.8483],[0.9494,2.879]]// -end// -tsi1c// -start// -[[-0.3063,2.8585],[0.3216,2.8687]]// -end// -tsi2k// -start// -[[0.3828,4.2112],[-0.49,0.6125],[0.8422,0.9801]]// -end// -tsi2c// -start// -[[0.0919,3.0117],[-0.1991,1.8121]]// -end// -start// -[[-0.7044,-0.2144],[0.4594,-0.1072]]// -end//// diff --git a/texmf-dist/scripts/ketcindy/data/fontF/xsi.cdy b/texmf-dist/scripts/ketcindy/data/fontF/xsi.cdy Binary files differdeleted file mode 100644 index 428c783d..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/xsi.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/xsi.txt b/texmf-dist/scripts/ketcindy/data/fontF/xsi.txt deleted file mode 100644 index f16d04f0..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/xsi.txt +++ /dev/null @@ -1,26 +0,0 @@ -xsin// -start// -[[2,0]]// -end// -xsi1k// -start// -[[-1.2134,2.2311],[0.027,1.3889],[1.2521,0.6232]]// -end// -xsi1c// -start// -[[-0.9837,3.0734],[0.6855,3.4869]]// -end// -start// -[[-0.6468,-0.5866],[0.9765,-0.1118]]// -end// -xsi2k// -start// -[[1.6043,2.5527],[0.027,1.3889],[-1.5503,0.3935]]// -end// -xsi2c// -start// -[[1.4818,3.1193],[0.4864,3.2265]]// -end// -start// -[[-0.4324,-0.3722],[-1.489,-0.2037]]// -end//// diff --git a/texmf-dist/scripts/ketcindy/data/fontF/ysi.cdy b/texmf-dist/scripts/ketcindy/data/fontF/ysi.cdy Binary files differdeleted file mode 100644 index ff075329..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/ysi.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/ysi.txt b/texmf-dist/scripts/ketcindy/data/fontF/ysi.txt deleted file mode 100644 index 83f6b329..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/ysi.txt +++ /dev/null @@ -1,26 +0,0 @@ -ysin// -start// -[[2,0]]// -end// -ysi1k// -start// -[[-1.3052,2.1239],[-0.5549,1.4042],[1.0684,1.3889]]// -end// -ysi1c// -start// -[[-0.8458,3.2418],[0.2567,3.2572]]// -end// -start// -[[-1.198,-0.1272],[0.4099,-0.8316]]// -end// -ysi2k// -start// -[[1.4665,2.8284],[0.7008,-0.0506],[-1.244,-0.8316]]// -end// -ysi2c// -start// -[[1.1756,1.7462],[0.9152,0.7406]]// -end// -start// -[[0.2721,-1.6738],[-1.1981,-1.5666]]// -end//// diff --git a/texmf-dist/scripts/ketcindy/data/fontF/zsi.cdy b/texmf-dist/scripts/ketcindy/data/fontF/zsi.cdy Binary files differdeleted file mode 100644 index 3326d6ad..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/zsi.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/data/fontF/zsi.txt b/texmf-dist/scripts/ketcindy/data/fontF/zsi.txt deleted file mode 100644 index f62925cd..00000000 --- a/texmf-dist/scripts/ketcindy/data/fontF/zsi.txt +++ /dev/null @@ -1,28 +0,0 @@ -zsin// -start// -[[3,0]]// -end// -zsi1k// -start// -[[-0.8152,2.2618],[1.1756,2.6752]]// -end// -zsi1c// -start// -[[0.1802,3.7319],[0.2874,1.7564]]// -end// -zsi2k// -start// -[[1.3287,2.8896],[-1.3818,-0.02]]// -end// -zsi2c// -start// -[[0.5783,1.7564],[-0.7846,1.052]]// -end// -zsi3k// -start// -[[-1.1215,0.3629],[1.0684,0.8835]]// -end// -zsi3c// -start// -[[-0.5549,0.9754],[0.2108,-0.9388]]// -end//// diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/READMEj(kobayashi-suzuki).txt b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/READMEj(kobayashi-suzuki).txt deleted file mode 100644 index 897ac82f..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/READMEj(kobayashi-suzuki).txt +++ /dev/null @@ -1,116 +0,0 @@ -®–Ê“Ê‘½–Ê‘Ìi‚y-‘½–Ê‘Ìj‚ÌÀ•Wƒf[ƒ^‚ɂ‚¢‚Ä 1994”N6ŒŽ22“ú
-
-‚PD‚Í‚¶‚ß‚É
-
- ‚RŽŸŒ³ƒ†[ƒNƒŠƒbƒh‹óŠÔ‚Ì‘½–Ê‘Ì‚Ì’†‚ÅCg•Ó‚Ì’·‚³‚Ì“™‚µ‚¢³‘½ŠpŒ`‚ð–Ê
-‚É‚à‚“ʑ½ŠpŒ`h‚ÍC®–Ê“Ê‘½–Ê‘Ì(regular-faced convex polyhedron)‚ÆŒÄ
-‚΂ê‚Ä‚¢‚Ü‚·D®–Ê“Ê‘½–Ê‘Ì‚ÍC³‘½–Ê‘ÌC€³‘½–Ê‘ÌC³‘½Šp’ŒC³‘½Šp”½
-’Œ‚ðœ‚‚Æ 92 Ží—Þ‚µ‚©‘¶Ý‚µ‚Ü‚¹‚ñD‚±‚Ì‚±‚Æ‚ðØ–¾‚µ‚½Victor A.
-Zalgaller(1) ‚É‚¿‚È‚ñ‚ÅC®–Ê“Ê‘½–Ê‘Ì‚Í‚y-‘½–Ê‘Ì(Z-polyhedron)‚Æ‚àŒÄ‚Î
-‚ê‚Ä‚¢‚Ü‚·D
-
- ®–Ê“Ê‘½–Ê‘Ì‚Ì–ÍŒ^‚ÍCŽ†‚È‚Ç‚ÅŠÈ’P‚Éì‚邱‚Æ‚ª‚Å‚«‚Ü‚·‚ªC’¸“_‚ÌÀ•W
-‚ðŒvŽZ‚·‚邱‚Æ‚ª“‚C‚±‚ê‚܂ŃRƒ“ƒsƒ…[ƒ^‚É‚æ‚é•\Ž¦‚Í¢“ï‚Å‚µ‚½DŽ„
-‚½‚¿‚ÍC‘½–ʑ̂̃Oƒ‰ƒt•\Œ»‚ð—˜—p‚µ‚½ŒvŽZƒAƒ‹ƒSƒŠƒYƒ€‚ðlˆÄ‚µC’Tõ‚Æ”
-’lŒvŽZ‚É‚æ‚Á‚Ä‚·‚ׂĂ̮–Ê“Ê‘½ŠpŒ`‚Ì’¸“_‚̈ʒuÀ•W‚ð‹‚ß‚Ü‚µ‚½(2)D‚±
-‚ÌÀ•Wƒf[ƒ^‚Í‚³‚Ü‚´‚Ü‚È—p“r‚É—˜—p‚Å‚«‚é‚ÆŽv‚í‚ê‚Ü‚·‚Ì‚ÅC‚±‚±‚ÉŒöŠJ‚¢
-‚½‚µ‚Ü‚·D‚Ç‚¤‚¼‚¨–𗧂ĉº‚³‚¢D
-
- À•Wƒf[ƒ^‚ÍŽ©—R‚É”z•z‚µ‚Ä‚¢‚½‚¾‚¢‚Ä‚©‚Ü‚¢‚Ü‚¹‚ñD‚½‚¾‚µCƒf[ƒ^‚É‚Í
-•K‚¸‚±‚̃hƒLƒ…ƒƒ“ƒg‚ð“Y‚¦‚ĉº‚³‚¢D‚È‚¨CÀ•Wƒf[ƒ^‚Ì—˜—p‚ÉŠÖ‚µ‚Ä”¶
-‚µ‚½ˆêØ‚ÌáŠQ‚ɂ‚¢‚ÄÓ”C‚𕉂¢‚©‚Ë‚Ü‚·‚Ì‚ÅCŒä—¹³‰º‚³‚¢D
-
- “d‹C’ÊM‘åŠw î•ñHŠw‰È ¬—Ñ Œõ•v
- §182 “Œ‹ž“s’²•zŽs’²•zƒ–‹u1-5-1
- ‘—§—ðŽj–¯‘”Ž•¨ŠÙ î•ñŽ‘—¿Œ¤‹†•” —é–Ø ‘쎡
- §285 ç—tŒ§²‘qŽsé“à’¬117
- E-mail: suzuki@alp0.cs.uec.ac.jp
- suz-tak@tansei.cc.u-tokyo.ac.jp
-
-’F
-(1) Zalgaller,V.A.: Convex Polyhedra with Regular Faces(‰p–ó”Å),
-Consultants Bureau, 1969. (Œ´’˜‚Í Zalgaller,B.A.: Vypuklye
-Mnogogranniki c Pravil'nymi Granyami, Nauka Press, 1966.)
-(2) ¬—ÑŒõ•v, —é–ؑ쎡: ³‘½ŠpŒ`‚ð–Ê‚É‚à‚‚·‚ׂĂ̓ʑ½–Ê‘Ì‚Ì’¸“_À•W
-‚ÌŒvŽZ, “d‹C’ÊM‘åŠw‹I—v, Vol.5, No.2, pp.147-184(1992).
-
-
-‚QDƒf[ƒ^ƒtƒ@ƒCƒ‹‚ÌŽí—Þ
-
-‘½–ʑ̃f[ƒ^‚̓fƒBƒŒƒNƒgƒŠ data/ ‚É‚ ‚éD
-
-‚P‚‚̑½–ʑ̂ɂ‚«‚P‚‚̃tƒ@ƒCƒ‹‚ª‘Ήž‚·‚éDŠe‘½–ʑ̂̃tƒ@ƒCƒ‹–¼‚ðˆÈ‰º
-‚ÉŽ¦‚·Dƒtƒ@ƒCƒ‹–¼‚Æ‘½–Ê‘Ì‚Ì–¼Ì‚Ƃ̑Ήž‚ÍCƒtƒ@ƒCƒ‹ dnamej.tex ‚Ì•\‚P
-‚©‚ç•\‚R‚ðŽQÆ‚Ì‚±‚ÆD
-
-³‘½–Ê‘Ì(regular polyhedron): r01, r02, r03, r04, r05.
-(r02 = a03, r03 = p04)
-
-€³‘½–Ê‘Ì(semiregular polyhedron): s01, s02, s03, s04, s05, s06, s07,
-s08, s09, s10, s11, s12L, s12R, s13L, s13R.
-(s12 ‚Æ s13 ‚Í‚»‚ꂼ‚ꋾ‘œŠÖŒW‚É‚ ‚鑽–Ê‘Ì‚ª‘¶Ý‚·‚é‚Ì‚ÅC¶ŽèŒn‚ƉEŽè
-Œn‚ð‚»‚ê‚¼‚ê L, R ‚Å‹æ•Ê‚µ‚Ä‚¢‚éD)
-(n37 ‚Í s08 ‚Ì”P‚ꂽ‚à‚ÌDƒ~ƒ‰[‚Ì‘½–ʑ̂ƌĂ΂ê‚éD‚±‚ê‚ð s14 ‚Æ‚Ý‚È
-‚·ê‡‚ª‚ ‚éD)
-
-³‘½Šp’Œ(prism): p03, p04, p05, p06, p07, p08, p09, p10.
-
-³‘½Šp”½’Œ(antiprism): a03, a04, a05, a06, a07, a08, a09, a10.
-
-®–Ê“Ê‘½–Ê‘Ì(regular-faced convex polyhedron):
- iœ‚³‘½–Ê‘ÌC€³‘½–Ê‘ÌC³‘½Šp’ŒC³‘½Šp”½’Œj
-n01, n02, n03, n04, n05, n06, n07, n08, n09, n10, n11, n12, n13, n14,
-n15, n16, n17, n18, n19, n20, n21, n22, n23, n24, n25, n26, n27, n28,
-n29, n30, n31, n32, n33, n34, n35, n36, n37, n38, n39, n40, n41, n42,
-n43, n44L, n44R, n45L, n45R, n46L, n46R, n47L, n47R, n48L, n48R, n49,
-n50, n51, n52, n53, n54, n55, n56, n57, n58, n59, n60, n61, n62, n63,
-n64, n65, n66, n67, n68, n69, n70, n71, n72, n73, n74, n75, n76, n77,
-n78, n79, n80, n81, n82, n83, n84, n85, n86, n87, n88, n89, n90, n91,
-n92.
-(n44, n45, n46, n47, n48 ‚É‚Í‹¾‘œŠÖŒW‚É‚ ‚鑽–Ê‘Ì‚ª‘¶Ý‚·‚é‚Ì‚ÅC¶Žè
-Œn‚ƉEŽèŒn‚ð‚»‚ê‚¼‚ê L, R ‚Å‹æ•Ê‚µ‚Ä‚¢‚éD)
-
-
-‚RDƒf[ƒ^‚̃tƒH[ƒ}ƒbƒg
-
- ƒf[ƒ^‚͂‚¬‚Ì‚SŽí—ނ̃f[ƒ^‚©‚ç‚È‚éD
- E’¸“_‚É—×Ú‚·‚é’¸“_‚̃f[ƒ^
- E’¸“_‚ðˆÍ‚ޖʂ̃f[ƒ^
- E–Ê‚ð\¬‚·‚é’¸“_‚̃f[ƒ^
- E’¸“_‚ÌÀ•Wƒf[ƒ^
-
- ’¸“_C–ʂ͔Ԇ‚ÅŽ¯•Ê‚·‚éDn ŒÂ‚Ì’¸“_‚ª‚ ‚é‚Æ‚«‚Ì’¸“_”Ô†‚͈̔͂Í
-1 ”Ô‚©‚ç n ”Ô‚Ü‚Å‚Æ‚È‚éDm ŒÂ‚Ì–Ê‚ª‚ ‚é‚Æ‚«‚̖ʔԆ‚͈̔͂Í
-1 ”Ô‚©‚ç m ”Ô‚Ü‚Å‚Æ‚È‚éD
-
- ‹ï‘Ì“I‚É‚ÍC‚‚¬‚̂悤‚Ƀf[ƒ^‚ª‚È‚ç‚ñ‚Å‚¢‚éDƒf[ƒ^‚Í’¸“_À•W
-‚̃f[ƒ^‚¾‚¯ŽÀ”‚ÅC‚ ‚Æ‚Í®”‚Å‚ ‚é
-
- ’¸“_‚Ì”
- ’¸“_”Ô† ’¸“_‚É—×Ú‚·‚é’¸“_‚Ì” —×Ú‚·‚é’¸“_‚̔ԆDDD
- DDD
- i’¸“_‚Ì”‚¾‚¯‘±‚j
- DDD
- ’¸“_‚Ì”
- ’¸“_”Ô† ’¸“_‚É—×Ú‚·‚é–Ê‚Ì” —×Ú‚·‚é–ʂ̔ԆDDD
- DDD
- i’¸“_‚Ì”‚¾‚¯‘±‚j
- DDD
- –Ê‚Ì”
- –ʔԆ –Ê‚ð\¬‚·‚é’¸“_‚Ì” –Ê‚ð\¬‚·‚é’¸“_‚̔ԆDDD
- DDD
- i–Ê‚Ì”‚¾‚¯‘±‚j
- DDD
- ’¸“_‚Ì”
- ’¸“_”Ô† ’¸“_‚Ì‚wÀ•W ’¸“_‚Ì‚xÀ•W ’¸“_‚Ì‚yÀ•W
- DDD
- i’¸“_‚Ì”‚¾‚¯‘±‚j
- DDD
-
-
-‚SD‘½–ʑ̂̃n[ƒhƒRƒs[‚ɂ‚¢‚Ä
-
-Še‘½–ʑ̂̃n[ƒhƒRƒs[‚ð PBM Œ`Ž®‚Å‹L˜^‚µ‚½‚à‚Ì‚ªCƒfƒBƒŒƒNƒgƒŠ
-hardcopy/ ‚É‚ ‚éDƒtƒ@ƒCƒ‹–¼‚̑Ήž‚ÍÀ•Wƒf[ƒ^‚Æ“¯‚¶‚Å‚ ‚éD
-
-ˆÈãD
diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/READMEj(mitani).txt b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/READMEj(mitani).txt deleted file mode 100644 index 262fff5b..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/READMEj(mitani).txt +++ /dev/null @@ -1,7 +0,0 @@ -OBJŒ`Ž®‚ÌÀ•Wƒf[ƒ^‚ɂ‚¢‚Ä
-
-¬—ÑŽA—é–ØŽ‚ª¶¬‚µ‚½®–Ê“Ê‘½–Ê‘Ìi‚y-‘½–Ê‘Ìj‚ÌÀ•Wƒf[ƒ^‚ðOBJŒ`Ž®‚É•ÏX‚µ‚½‚à‚Ì‚Å‚·B
-ƒf[ƒ^‚Ì“à—e‚ɂ‚¢‚Ä‚ÍA‚±‚̃tƒ@ƒCƒ‹‚Æ“¯«‚³‚ê‚Ä‚¢‚éREADMEj(kobayashi-suzuki).txt‚ð‚²——‚‚¾‚³‚¢B
-
-2007”N8ŒŽ27“ú
-ŽO’Jƒ jmitani@gmail.com
diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a03.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a03.obj deleted file mode 100644 index 2259162a..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a03.obj +++ /dev/null @@ -1,14 +0,0 @@ -v -0.70710678 -0.40824829 0.57735027 -v 0.00000000 0.81649658 0.57735027 -v 0.70710678 -0.40824829 0.57735027 -v -0.00000000 -0.81649658 -0.57735027 -v -0.70710678 0.40824829 -0.57735027 -v 0.70710678 0.40824829 -0.57735027 -f 1 2 5 -f 1 5 4 -f 1 4 3 -f 1 3 2 -f 2 3 6 -f 2 6 5 -f 3 4 6 -f 4 5 6 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a04.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a04.obj deleted file mode 100644 index 552dd092..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a04.obj +++ /dev/null @@ -1,18 +0,0 @@ -v -0.60778126 -0.60778126 0.51108108 -v -0.60778126 0.60778126 0.51108108 -v 0.60778126 0.60778126 0.51108108 -v 0.60778126 -0.60778126 0.51108108 -v -0.00000000 -0.85953250 -0.51108108 -v -0.85953250 0.00000000 -0.51108108 -v 0.00000000 0.85953250 -0.51108108 -v 0.85953250 -0.00000000 -0.51108108 -f 1 2 6 -f 1 6 5 -f 1 5 4 -f 1 4 3 2 -f 2 3 7 -f 2 7 6 -f 3 4 8 -f 3 8 7 -f 4 5 8 -f 5 6 7 8 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a05.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a05.obj deleted file mode 100644 index 0ad84696..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a05.obj +++ /dev/null @@ -1,22 +0,0 @@ -v -0.52573111 -0.72360680 0.44721360 -v -0.85065081 0.27639320 0.44721360 -v 0.00000000 0.89442719 0.44721360 -v 0.85065081 0.27639320 0.44721360 -v 0.52573111 -0.72360680 0.44721360 -v -0.00000000 -0.89442719 -0.44721360 -v -0.85065081 -0.27639320 -0.44721360 -v -0.52573111 0.72360680 -0.44721360 -v 0.52573111 0.72360680 -0.44721360 -v 0.85065081 -0.27639320 -0.44721360 -f 1 2 7 -f 1 7 6 -f 1 6 5 -f 1 5 4 3 2 -f 2 3 8 -f 2 8 7 -f 3 4 9 -f 3 9 8 -f 4 5 10 -f 4 10 9 -f 5 6 10 -f 6 7 8 9 10 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a06.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a06.obj deleted file mode 100644 index fa5467aa..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a06.obj +++ /dev/null @@ -1,26 +0,0 @@ -v -0.45970084 -0.79622522 0.39331989 -v -0.91940169 0.00000000 0.39331989 -v -0.45970084 0.79622522 0.39331989 -v 0.45970084 0.79622522 0.39331989 -v 0.91940169 -0.00000000 0.39331989 -v 0.45970084 -0.79622522 0.39331989 -v -0.00000000 -0.91940169 -0.39331989 -v -0.79622522 -0.45970084 -0.39331989 -v -0.79622522 0.45970084 -0.39331989 -v 0.00000000 0.91940169 -0.39331989 -v 0.79622522 0.45970084 -0.39331989 -v 0.79622522 -0.45970084 -0.39331989 -f 1 2 8 -f 1 8 7 -f 1 7 6 -f 1 6 5 4 3 2 -f 2 3 9 -f 2 9 8 -f 3 4 10 -f 3 10 9 -f 4 5 11 -f 4 11 10 -f 5 6 12 -f 5 12 11 -f 6 7 12 -f 7 8 9 10 11 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a07.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a07.obj deleted file mode 100644 index 17d011c5..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a07.obj +++ /dev/null @@ -1,30 +0,0 @@ -v -0.40659420 -0.84430155 0.34905022 -v -0.91360887 -0.20852526 0.34905022 -v -0.73265743 0.58427480 0.34905022 -v 0.00000000 0.93710402 0.34905022 -v 0.73265743 0.58427480 0.34905022 -v 0.91360887 -0.20852526 0.34905022 -v 0.40659420 -0.84430155 0.34905022 -v -0.00000000 -0.93710402 -0.34905022 -v -0.73265743 -0.58427480 -0.34905022 -v -0.91360887 0.20852526 -0.34905022 -v -0.40659420 0.84430155 -0.34905022 -v 0.40659420 0.84430155 -0.34905022 -v 0.91360887 0.20852526 -0.34905022 -v 0.73265742 -0.58427480 -0.34905022 -f 1 2 9 -f 1 9 8 -f 1 8 7 -f 1 7 6 5 4 3 2 -f 2 3 10 -f 2 10 9 -f 3 4 11 -f 3 11 10 -f 4 5 12 -f 4 12 11 -f 5 6 13 -f 5 13 12 -f 6 7 14 -f 6 14 13 -f 7 8 14 -f 8 9 10 11 12 13 14 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a08.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a08.obj deleted file mode 100644 index 2235341d..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a08.obj +++ /dev/null @@ -1,34 +0,0 @@ -v -0.36349134 -0.87754573 0.31270999 -v -0.87754573 -0.36349134 0.31270999 -v -0.87754573 0.36349134 0.31270999 -v -0.36349134 0.87754573 0.31270999 -v 0.36349134 0.87754573 0.31270999 -v 0.87754573 0.36349134 0.31270999 -v 0.87754573 -0.36349134 0.31270999 -v 0.36349134 -0.87754573 0.31270999 -v -0.00000000 -0.94984865 -0.31270999 -v -0.67164442 -0.67164442 -0.31270999 -v -0.94984865 0.00000000 -0.31270999 -v -0.67164442 0.67164442 -0.31270999 -v 0.00000000 0.94984865 -0.31270999 -v 0.67164442 0.67164442 -0.31270999 -v 0.94984865 -0.00000000 -0.31270999 -v 0.67164442 -0.67164442 -0.31270999 -f 1 2 10 -f 1 10 9 -f 1 9 8 -f 1 8 7 6 5 4 3 2 -f 2 3 11 -f 2 11 10 -f 3 4 12 -f 3 12 11 -f 4 5 13 -f 4 13 12 -f 5 6 14 -f 5 14 13 -f 6 7 15 -f 6 15 14 -f 7 8 16 -f 7 16 15 -f 8 9 16 -f 9 10 11 12 13 14 15 16 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a09.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a09.obj deleted file mode 100644 index 79e22eca..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a09.obj +++ /dev/null @@ -1,38 +0,0 @@ -v -0.32807418 -0.90137641 0.28264447 -v -0.83071299 -0.47961237 0.28264447 -v -0.94465196 0.16656763 0.28264447 -v -0.61657778 0.73480878 0.28264447 -v 0.00000000 0.95922474 0.28264447 -v 0.61657778 0.73480878 0.28264447 -v 0.94465196 0.16656763 0.28264447 -v 0.83071299 -0.47961237 0.28264447 -v 0.32807418 -0.90137641 0.28264447 -v -0.00000000 -0.95922474 -0.28264447 -v -0.61657778 -0.73480878 -0.28264447 -v -0.94465196 -0.16656763 -0.28264447 -v -0.83071299 0.47961237 -0.28264447 -v -0.32807418 0.90137641 -0.28264447 -v 0.32807418 0.90137641 -0.28264447 -v 0.83071299 0.47961237 -0.28264447 -v 0.94465196 -0.16656763 -0.28264447 -v 0.61657778 -0.73480878 -0.28264447 -f 1 2 11 -f 1 11 10 -f 1 10 9 -f 1 9 8 7 6 5 4 3 2 -f 2 3 12 -f 2 12 11 -f 3 4 13 -f 3 13 12 -f 4 5 14 -f 4 14 13 -f 5 6 15 -f 5 15 14 -f 6 7 16 -f 6 16 15 -f 7 8 17 -f 7 17 16 -f 8 9 18 -f 8 18 17 -f 9 10 18 -f 10 11 12 13 14 15 16 17 18 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a10.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a10.obj deleted file mode 100644 index cc602ba2..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/a10.obj +++ /dev/null @@ -1,42 +0,0 @@ -v -0.29859575 -0.91898322 0.25750808 -v -0.78173382 -0.56796287 0.25750808 -v -0.96627614 0.00000000 0.25750808 -v -0.78173382 0.56796287 0.25750808 -v -0.29859575 0.91898322 0.25750808 -v 0.29859575 0.91898322 0.25750808 -v 0.78173382 0.56796287 0.25750808 -v 0.96627614 -0.00000000 0.25750808 -v 0.78173382 -0.56796287 0.25750808 -v 0.29859575 -0.91898322 0.25750808 -v -0.00000000 -0.96627614 -0.25750808 -v -0.56796287 -0.78173382 -0.25750808 -v -0.91898322 -0.29859575 -0.25750808 -v -0.91898322 0.29859575 -0.25750808 -v -0.56796287 0.78173382 -0.25750808 -v 0.00000000 0.96627615 -0.25750808 -v 0.56796287 0.78173382 -0.25750808 -v 0.91898322 0.29859575 -0.25750808 -v 0.91898322 -0.29859575 -0.25750808 -v 0.56796287 -0.78173382 -0.25750808 -f 1 2 12 -f 1 12 11 -f 1 11 10 -f 1 10 9 8 7 6 5 4 3 2 -f 2 3 13 -f 2 13 12 -f 3 4 14 -f 3 14 13 -f 4 5 15 -f 4 15 14 -f 5 6 16 -f 5 16 15 -f 6 7 17 -f 6 17 16 -f 7 8 18 -f 7 18 17 -f 8 9 19 -f 8 19 18 -f 9 10 20 -f 9 20 19 -f 10 11 20 -f 11 12 13 14 15 16 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n01.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n01.obj deleted file mode 100644 index 70574b60..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n01.obj +++ /dev/null @@ -1,10 +0,0 @@ -v -0.69337525 -0.69337525 0.19611614 -v -0.69337525 0.69337525 0.19611614 -v 0.69337525 0.69337525 0.19611614 -v 0.69337525 -0.69337525 0.19611614 -v 0.00000000 0.00000000 -0.78446454 -f 1 2 5 -f 1 5 4 -f 1 4 3 2 -f 2 3 5 -f 3 4 5 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n02.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n02.obj deleted file mode 100644 index e279a395..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n02.obj +++ /dev/null @@ -1,12 +0,0 @@ -v -0.58469160 -0.80475895 0.10246352 -v -0.94605088 0.30739056 0.10246352 -v 0.00000000 0.99473676 0.10246352 -v 0.94605088 0.30739056 0.10246352 -v 0.58469160 -0.80475895 0.10246352 -v 0.00000000 0.00000000 -0.51231761 -f 1 2 6 -f 1 6 5 -f 1 5 4 3 2 -f 2 3 6 -f 3 4 6 -f 4 5 6 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n03.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n03.obj deleted file mode 100644 index 72508077..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n03.obj +++ /dev/null @@ -1,17 +0,0 @@ -v -0.48245064 -0.83562902 0.26261287 -v -0.96490128 0.00000000 0.26261287 -v -0.48245064 0.83562902 0.26261287 -v 0.48245064 0.83562902 0.26261287 -v 0.96490128 -0.00000000 0.26261287 -v 0.48245064 -0.83562902 0.26261287 -v -0.48245064 -0.27854301 -0.52522573 -v 0.00000000 0.55708601 -0.52522573 -v 0.48245064 -0.27854301 -0.52522573 -f 1 2 7 -f 1 7 9 6 -f 1 6 5 4 3 2 -f 2 3 8 7 -f 3 4 8 -f 4 5 9 8 -f 5 6 9 -f 7 8 9 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n04.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n04.obj deleted file mode 100644 index 03abdf63..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n04.obj +++ /dev/null @@ -1,22 +0,0 @@ -v -0.37660445 -0.90920356 0.17753304 -v -0.90920356 -0.37660445 0.17753304 -v -0.90920356 0.37660445 0.17753304 -v -0.37660445 0.90920356 0.17753304 -v 0.37660445 0.90920356 0.17753304 -v 0.90920356 0.37660445 0.17753304 -v 0.90920356 -0.37660445 0.17753304 -v 0.37660445 -0.90920356 0.17753304 -v 0.00000000 -0.53259911 -0.35506608 -v -0.53259911 0.00000000 -0.35506608 -v 0.00000000 0.53259911 -0.35506608 -v 0.53259911 -0.00000000 -0.35506608 -f 1 2 10 9 -f 1 9 8 -f 1 8 7 6 5 4 3 2 -f 2 3 10 -f 3 4 11 10 -f 4 5 11 -f 5 6 12 11 -f 6 7 12 -f 7 8 9 12 -f 9 10 11 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n05.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n05.obj deleted file mode 100644 index 7e79daa2..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n05.obj +++ /dev/null @@ -1,27 +0,0 @@ -v -0.30722035 -0.94552702 0.10767686 -v -0.80431332 -0.58436784 0.10767686 -v -0.99418594 0.00000000 0.10767686 -v -0.80431332 0.58436784 0.10767686 -v -0.30722035 0.94552702 0.10767686 -v 0.30722035 0.94552702 0.10767686 -v 0.80431332 0.58436784 0.10767686 -v 0.99418594 -0.00000000 0.10767686 -v 0.80431332 -0.58436784 0.10767686 -v 0.30722035 -0.94552702 0.10767686 -v -0.30722035 -0.42285254 -0.21535373 -v -0.49709297 0.16151530 -0.21535373 -v 0.00000000 0.52267448 -0.21535373 -v 0.49709297 0.16151530 -0.21535373 -v 0.30722035 -0.42285254 -0.21535373 -f 1 2 11 -f 1 11 15 10 -f 1 10 9 8 7 6 5 4 3 2 -f 2 3 12 11 -f 3 4 12 -f 4 5 13 12 -f 5 6 13 -f 6 7 14 13 -f 7 8 14 -f 8 9 15 14 -f 9 10 15 -f 11 12 13 14 15 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n06.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n06.obj deleted file mode 100644 index f93e9b72..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n06.obj +++ /dev/null @@ -1,37 +0,0 @@ -v -0.29220218 -0.89930585 0.32537191 -v -0.76499524 -0.55580158 0.32537191 -v -0.94558612 0.00000000 0.32537191 -v -0.76499524 0.55580158 0.32537191 -v -0.29220218 0.89930585 0.32537191 -v 0.29220218 0.89930585 0.32537191 -v 0.76499524 0.55580158 0.32537191 -v 0.94558612 -0.00000000 0.32537191 -v 0.76499524 -0.55580158 0.32537191 -v 0.29220218 -0.89930585 0.32537191 -v 0.00000000 -0.80436360 -0.17175213 -v -0.76499524 -0.24856202 -0.17175213 -v -0.47279306 0.65074382 -0.17175213 -v 0.47279306 0.65074382 -0.17175213 -v 0.76499524 -0.24856202 -0.17175213 -v -0.29220218 -0.40218180 -0.47899169 -v -0.47279306 0.15361978 -0.47899169 -v 0.00000000 0.49712404 -0.47899169 -v 0.47279306 0.15361978 -0.47899169 -v 0.29220218 -0.40218180 -0.47899169 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 9 8 7 6 5 4 3 2 -f 2 3 12 -f 3 4 13 17 12 -f 4 5 13 -f 5 6 14 18 13 -f 6 7 14 -f 7 8 15 19 14 -f 8 9 15 -f 9 10 11 20 15 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n07.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n07.obj deleted file mode 100644 index 529d40b7..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n07.obj +++ /dev/null @@ -1,14 +0,0 @@ -v -0.44309521 -0.25582114 0.27642855 -v 0.00000000 0.51164228 0.27642855 -v 0.44309521 -0.25582114 0.27642855 -v -0.44309521 -0.25582114 -0.60976188 -v 0.00000000 0.51164228 -0.60976188 -v 0.44309521 -0.25582114 -0.60976188 -v -0.00000000 -0.00000000 1.00000000 -f 1 2 5 4 -f 1 4 6 3 -f 1 3 7 -f 1 7 2 -f 2 3 6 5 -f 2 7 3 -f 4 5 6 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n08.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n08.obj deleted file mode 100644 index 09205712..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n08.obj +++ /dev/null @@ -1,18 +0,0 @@ -v -0.34099026 -0.46599026 0.46599026 -v -0.34099026 0.46599026 0.46599026 -v 0.59099026 0.46599026 0.46599026 -v 0.59099026 -0.46599026 0.46599026 -v -0.34099026 -0.46599026 -0.46599026 -v -0.34099026 0.46599026 -0.46599026 -v 0.59099026 0.46599026 -0.46599026 -v 0.59099026 -0.46599026 -0.46599026 -v -1.00000000 0.00000000 -0.00000000 -f 1 5 8 4 -f 1 4 3 2 -f 1 2 9 -f 1 9 5 -f 2 3 7 6 -f 2 6 9 -f 3 4 8 7 -f 5 6 7 8 -f 5 9 6 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n09.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n09.obj deleted file mode 100644 index e7b7c9a7..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n09.obj +++ /dev/null @@ -1,22 +0,0 @@ -v -0.48211943 -0.66358047 0.39220581 -v -0.78008563 0.25346519 0.39220581 -v -0.00000000 0.82023057 0.39220581 -v 0.78008563 0.25346519 0.39220581 -v 0.48211943 -0.66358047 0.39220581 -v -0.48211943 -0.66358047 -0.57203305 -v -0.78008563 0.25346519 -0.57203305 -v 0.00000000 0.82023057 -0.57203305 -v 0.78008563 0.25346519 -0.57203305 -v 0.48211943 -0.66358047 -0.57203305 -v 0.00000000 0.00000000 0.89913619 -f 1 2 7 6 -f 1 6 10 5 -f 1 5 11 -f 1 11 2 -f 2 3 8 7 -f 2 11 3 -f 3 4 9 8 -f 3 11 4 -f 4 5 10 9 -f 4 11 5 -f 6 7 8 9 10 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n10.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n10.obj deleted file mode 100644 index 012f40ee..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n10.obj +++ /dev/null @@ -1,22 +0,0 @@ -v -0.49886702 -0.49886702 0.29449549 -v -0.49886702 0.49886702 0.29449549 -v 0.49886702 0.49886702 0.29449549 -v 0.49886702 -0.49886702 0.29449549 -v 0.00000000 -0.70550451 -0.54449549 -v -0.70550451 0.00000000 -0.54449549 -v 0.00000000 0.70550451 -0.54449549 -v 0.70550451 -0.00000000 -0.54449549 -v 0.00000000 0.00000000 1.00000000 -f 1 2 6 -f 1 6 5 -f 1 5 4 -f 1 4 9 -f 1 9 2 -f 2 3 7 -f 2 7 6 -f 2 9 3 -f 3 4 8 -f 3 8 7 -f 3 9 4 -f 4 5 8 -f 5 6 7 8 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n11.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n11.obj deleted file mode 100644 index 291356f8..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n11.obj +++ /dev/null @@ -1,27 +0,0 @@ -v -0.50365704 -0.69322445 0.34134421 -v -0.81493421 0.26478818 0.34134421 -v -0.00000000 0.85687254 0.34134421 -v 0.81493421 0.26478818 0.34134421 -v 0.50365704 -0.69322445 0.34134421 -v 0.00000000 -0.85687254 -0.51552833 -v -0.81493421 -0.26478818 -0.51552833 -v -0.50365704 0.69322444 -0.51552833 -v 0.50365704 0.69322444 -0.51552833 -v 0.81493421 -0.26478818 -0.51552833 -v 0.00000000 0.00000000 0.87092056 -f 1 2 7 -f 1 7 6 -f 1 6 5 -f 1 5 11 -f 1 11 2 -f 2 3 8 -f 2 8 7 -f 2 11 3 -f 3 4 9 -f 3 9 8 -f 3 11 4 -f 4 5 10 -f 4 10 9 -f 4 11 5 -f 5 6 10 -f 6 7 8 9 10 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n12.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n12.obj deleted file mode 100644 index 4513f468..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n12.obj +++ /dev/null @@ -1,11 +0,0 @@ -v -0.61237244 -0.35355339 0.00000000 -v 0.61237244 -0.35355339 0.00000000 -v 0.00000000 0.00000000 -1.00000000 -v 0.00000000 0.70710678 0.00000000 -v 0.00000000 0.00000000 1.00000000 -f 1 4 3 -f 1 3 2 -f 1 2 5 -f 1 5 4 -f 2 3 4 -f 2 4 5 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n13.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n13.obj deleted file mode 100644 index ba77013e..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n13.obj +++ /dev/null @@ -1,17 +0,0 @@ -v -0.58778525 -0.80901699 0.00000000 -v -0.95105652 0.30901699 0.00000000 -v -0.00000000 1.00000000 0.00000000 -v 0.95105652 0.30901699 0.00000000 -v 0.58778525 -0.80901699 0.00000000 -v 0.00000000 0.00000000 -0.61803399 -v 0.00000000 0.00000000 0.61803399 -f 1 2 6 -f 1 6 5 -f 1 5 7 -f 1 7 2 -f 2 3 6 -f 2 7 3 -f 3 4 6 -f 3 7 4 -f 4 5 6 -f 4 7 5 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n14.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n14.obj deleted file mode 100644 index 066ad4d0..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n14.obj +++ /dev/null @@ -1,17 +0,0 @@ -v -0.37979590 -0.21927526 0.37979590 -v 0.00000000 0.43855053 0.37979590 -v 0.37979590 -0.21927526 0.37979590 -v -0.37979590 -0.21927526 -0.37979590 -v 0.00000000 0.43855053 -0.37979590 -v 0.37979590 -0.21927526 -0.37979590 -v -0.00000000 -0.00000000 1.00000000 -v -0.00000000 0.00000000 -1.00000000 -f 1 2 5 4 -f 1 4 6 3 -f 1 3 7 -f 1 7 2 -f 2 3 6 5 -f 2 7 3 -f 4 5 8 -f 4 8 6 -f 5 6 8 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n15.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n15.obj deleted file mode 100644 index cce594a8..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n15.obj +++ /dev/null @@ -1,22 +0,0 @@ -v -0.41421356 -0.41421356 0.41421356 -v -0.41421356 0.41421356 0.41421356 -v 0.41421356 0.41421356 0.41421356 -v 0.41421356 -0.41421356 0.41421356 -v -0.41421356 -0.41421356 -0.41421356 -v -0.41421356 0.41421356 -0.41421356 -v 0.41421356 0.41421356 -0.41421356 -v 0.41421356 -0.41421356 -0.41421356 -v -1.00000000 0.00000000 -0.00000000 -v 1.00000000 -0.00000000 -0.00000000 -f 1 5 8 4 -f 1 4 3 2 -f 1 2 9 -f 1 9 5 -f 2 3 7 6 -f 2 6 9 -f 3 4 10 -f 3 10 7 -f 4 8 10 -f 5 6 7 8 -f 5 9 6 -f 7 10 8 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n16.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n16.obj deleted file mode 100644 index 5222ab17..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n16.obj +++ /dev/null @@ -1,27 +0,0 @@ -v -0.48745718 -0.67092726 0.48745718 -v -0.78872229 0.25627141 0.48745718 -v -0.00000000 0.82931170 0.48745718 -v 0.78872229 0.25627141 0.48745718 -v 0.48745718 -0.67092726 0.48745718 -v -0.48745718 -0.67092726 -0.48745718 -v -0.78872229 0.25627141 -0.48745718 -v 0.00000000 0.82931170 -0.48745718 -v 0.78872229 0.25627141 -0.48745718 -v 0.48745718 -0.67092726 -0.48745718 -v 0.00000000 0.00000000 1.00000000 -v 0.00000000 0.00000000 -1.00000000 -f 1 2 7 6 -f 1 6 10 5 -f 1 5 11 -f 1 11 2 -f 2 3 8 7 -f 2 11 3 -f 3 4 9 8 -f 3 11 4 -f 4 5 10 9 -f 4 11 5 -f 6 7 12 -f 6 12 10 -f 7 8 12 -f 8 9 12 -f 9 10 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n17.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n17.obj deleted file mode 100644 index 5bafb396..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n17.obj +++ /dev/null @@ -1,26 +0,0 @@ -v -0.44343735 -0.44343735 0.37288488 -v -0.44343735 0.44343735 0.37288488 -v 0.44343735 0.44343735 0.37288488 -v 0.44343735 -0.44343735 0.37288488 -v 0.00000000 -0.62711512 -0.37288488 -v -0.62711512 0.00000000 -0.37288488 -v 0.00000000 0.62711512 -0.37288488 -v 0.62711512 -0.00000000 -0.37288488 -v 0.00000000 0.00000000 1.00000000 -v 0.00000000 0.00000000 -1.00000000 -f 1 2 6 -f 1 6 5 -f 1 5 4 -f 1 4 9 -f 1 9 2 -f 2 3 7 -f 2 7 6 -f 2 9 3 -f 3 4 8 -f 3 8 7 -f 3 9 4 -f 4 5 8 -f 5 6 10 -f 5 10 8 -f 6 7 10 -f 7 8 10 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n18.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n18.obj deleted file mode 100644 index 11416d75..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n18.obj +++ /dev/null @@ -1,29 +0,0 @@ -v -0.39744851 -0.68840102 0.18815267 -v -0.79489703 0.00000000 0.18815267 -v -0.39744851 0.68840102 0.18815267 -v 0.39744851 0.68840102 0.18815267 -v 0.79489703 0.00000000 0.18815267 -v 0.39744851 -0.68840102 0.18815267 -v -0.39744851 -0.68840102 -0.60674436 -v -0.79489703 0.00000000 -0.60674436 -v -0.39744851 0.68840102 -0.60674436 -v 0.39744851 0.68840102 -0.60674436 -v 0.79489703 -0.00000000 -0.60674436 -v 0.39744851 -0.68840102 -0.60674436 -v 0.00000000 -0.45893401 0.83718338 -v 0.39744851 0.22946701 0.83718338 -v -0.39744851 0.22946701 0.83718338 -f 1 2 8 7 -f 1 7 12 6 -f 1 6 13 -f 1 13 15 2 -f 2 3 9 8 -f 2 15 3 -f 3 4 10 9 -f 3 15 14 4 -f 4 5 11 10 -f 4 14 5 -f 5 6 12 11 -f 5 14 13 6 -f 7 8 9 10 11 12 -f 13 14 15 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n19.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n19.obj deleted file mode 100644 index 6942d041..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n19.obj +++ /dev/null @@ -1,38 +0,0 @@ -v -0.33282985 -0.80352235 0.17212538 -v -0.80352235 -0.33282985 0.17212538 -v -0.80352235 0.33282985 0.17212538 -v -0.33282985 0.80352235 0.17212538 -v 0.33282985 0.80352235 0.17212538 -v 0.80352235 0.33282985 0.17212538 -v 0.80352235 -0.33282985 0.17212538 -v 0.33282985 -0.80352235 0.17212538 -v -0.33282985 -0.80352235 -0.49353432 -v -0.80352235 -0.33282985 -0.49353432 -v -0.80352235 0.33282985 -0.49353432 -v -0.33282985 0.80352235 -0.49353432 -v 0.33282985 0.80352235 -0.49353432 -v 0.80352235 0.33282985 -0.49353432 -v 0.80352235 -0.33282985 -0.49353432 -v 0.33282985 -0.80352235 -0.49353432 -v -0.33282985 -0.33282985 0.64281788 -v 0.33282985 -0.33282985 0.64281788 -v 0.33282985 0.33282985 0.64281788 -v -0.33282985 0.33282985 0.64281788 -f 1 2 10 9 -f 1 9 16 8 -f 1 8 18 17 -f 1 17 2 -f 2 3 11 10 -f 2 17 20 3 -f 3 4 12 11 -f 3 20 4 -f 4 5 13 12 -f 4 20 19 5 -f 5 6 14 13 -f 5 19 6 -f 6 7 15 14 -f 6 19 18 7 -f 7 8 16 15 -f 7 18 8 -f 9 10 11 12 13 14 15 16 -f 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n20.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n20.obj deleted file mode 100644 index 48711e26..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n20.obj +++ /dev/null @@ -1,47 +0,0 @@ -v -0.28328429 -0.87185940 -0.16705489 -v -0.74164790 -0.53883874 -0.16705489 -v -0.91672723 0.00000000 -0.16705489 -v -0.74164790 0.53883874 -0.16705489 -v -0.28328429 0.87185940 -0.16705489 -v 0.28328429 0.87185940 -0.16705489 -v 0.74164790 0.53883874 -0.16705489 -v 0.91672722 0.00000000 -0.16705489 -v 0.74164790 -0.53883874 -0.16705489 -v 0.28328429 -0.87185940 -0.16705489 -v -0.28328429 -0.38990738 -0.46491762 -v -0.45836361 0.14893137 -0.46491762 -v 0.00000000 0.48195202 -0.46491762 -v 0.45836361 0.14893137 -0.46491762 -v 0.28328429 -0.38990738 -0.46491762 -v -0.28328429 -0.87185940 0.39951370 -v 0.28328429 -0.87185940 0.39951370 -v 0.74164790 -0.53883874 0.39951370 -v 0.91672722 0.00000000 0.39951370 -v 0.74164790 0.53883874 0.39951370 -v 0.28328429 0.87185940 0.39951370 -v -0.28328429 0.87185940 0.39951370 -v -0.74164790 0.53883874 0.39951370 -v -0.91672723 0.00000000 0.39951370 -v -0.74164790 -0.53883874 0.39951370 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 16 -f 1 16 25 2 -f 2 3 12 11 -f 2 25 24 3 -f 3 4 12 -f 3 24 23 4 -f 4 5 13 12 -f 4 23 22 5 -f 5 6 13 -f 5 22 21 6 -f 6 7 14 13 -f 6 21 20 7 -f 7 8 14 -f 7 20 19 8 -f 8 9 15 14 -f 8 19 18 9 -f 9 10 15 -f 9 18 17 10 -f 11 12 13 14 15 -f 16 17 18 19 20 21 22 23 24 25 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n21.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n21.obj deleted file mode 100644 index be39dcb0..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n21.obj +++ /dev/null @@ -1,57 +0,0 @@ -v -0.26010839 -0.80053131 0.01968437 -v -0.68097260 -0.49475556 0.01968437 -v -0.84172843 0.00000000 0.01968437 -v -0.68097260 0.49475556 0.01968437 -v -0.26010839 0.80053131 0.01968437 -v 0.26010839 0.80053131 0.01968437 -v 0.68097260 0.49475556 0.01968437 -v 0.84172843 0.00000000 0.01968437 -v 0.68097260 -0.49475556 0.01968437 -v 0.26010839 -0.80053131 0.01968437 -v 0.00000000 -0.71601697 -0.42283845 -v -0.68097260 -0.22126141 -0.42283845 -v -0.42086421 0.57926990 -0.42283845 -v 0.42086421 0.57926990 -0.42283845 -v 0.68097260 -0.22126141 -0.42283845 -v -0.26010839 -0.35800848 -0.69633260 -v -0.42086421 0.13674707 -0.69633260 -v 0.00000000 0.44252282 -0.69633260 -v 0.42086421 0.13674707 -0.69633260 -v 0.26010839 -0.35800848 -0.69633260 -v -0.26010839 -0.80053131 0.53990115 -v 0.26010839 -0.80053131 0.53990115 -v 0.68097260 -0.49475556 0.53990115 -v 0.84172843 0.00000000 0.53990115 -v 0.68097260 0.49475556 0.53990115 -v 0.26010839 0.80053131 0.53990115 -v -0.26010839 0.80053131 0.53990115 -v -0.68097260 0.49475556 0.53990115 -v -0.84172843 0.00000000 0.53990115 -v -0.68097260 -0.49475556 0.53990115 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 22 21 -f 1 21 30 2 -f 2 3 12 -f 2 30 29 3 -f 3 4 13 17 12 -f 3 29 28 4 -f 4 5 13 -f 4 28 27 5 -f 5 6 14 18 13 -f 5 27 26 6 -f 6 7 14 -f 6 26 25 7 -f 7 8 15 19 14 -f 7 25 24 8 -f 8 9 15 -f 8 24 23 9 -f 9 10 11 20 15 -f 9 23 22 10 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 -f 21 22 23 24 25 26 27 28 29 30 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n22.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n22.obj deleted file mode 100644 index 1dfec909..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n22.obj +++ /dev/null @@ -1,35 +0,0 @@ -v -0.41410547 -0.71725171 0.14820052 -v -0.82821094 0.00000000 0.14820052 -v -0.41410547 0.71725171 0.14820052 -v 0.41410547 0.71725171 0.14820052 -v 0.82821094 0.00000000 0.14820052 -v 0.41410547 -0.71725171 0.14820052 -v 0.00000000 -0.82821094 -0.56041649 -v -0.71725171 -0.41410547 -0.56041649 -v -0.71725171 0.41410547 -0.56041649 -v 0.00000000 0.82821094 -0.56041649 -v 0.71725171 0.41410547 -0.56041649 -v 0.71725171 -0.41410547 -0.56041649 -v 0.00000000 -0.47816781 0.82443193 -v 0.41410547 0.23908390 0.82443193 -v -0.41410547 0.23908390 0.82443193 -f 1 2 8 -f 1 8 7 -f 1 7 6 -f 1 6 13 -f 1 13 15 2 -f 2 3 9 -f 2 9 8 -f 2 15 3 -f 3 4 10 -f 3 10 9 -f 3 15 14 4 -f 4 5 11 -f 4 11 10 -f 4 14 5 -f 5 6 12 -f 5 12 11 -f 5 14 13 6 -f 6 7 12 -f 7 8 9 10 11 12 -f 13 14 15 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n23.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n23.obj deleted file mode 100644 index a7c786ce..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n23.obj +++ /dev/null @@ -1,46 +0,0 @@ -v -0.34182948 -0.82524936 0.13857553 -v -0.82524936 -0.34182948 0.13857553 -v -0.82524936 0.34182948 0.13857553 -v -0.34182948 0.82524936 0.13857553 -v 0.34182948 0.82524936 0.13857553 -v 0.82524936 0.34182948 0.13857553 -v 0.82524936 -0.34182948 0.13857553 -v 0.34182948 -0.82524936 0.13857553 -v 0.00000000 -0.89324347 -0.44957324 -v -0.63161852 -0.63161852 -0.44957324 -v -0.89324347 0.00000000 -0.44957324 -v -0.63161852 0.63161852 -0.44957324 -v 0.00000000 0.89324347 -0.44957324 -v 0.63161852 0.63161852 -0.44957324 -v 0.89324347 -0.00000000 -0.44957324 -v 0.63161852 -0.63161852 -0.44957324 -v -0.34182948 -0.34182948 0.62199542 -v 0.34182948 -0.34182948 0.62199542 -v 0.34182948 0.34182948 0.62199542 -v -0.34182948 0.34182948 0.62199542 -f 1 2 10 -f 1 10 9 -f 1 9 8 -f 1 8 18 17 -f 1 17 2 -f 2 3 11 -f 2 11 10 -f 2 17 20 3 -f 3 4 12 -f 3 12 11 -f 3 20 4 -f 4 5 13 -f 4 13 12 -f 4 20 19 5 -f 5 6 14 -f 5 14 13 -f 5 19 6 -f 6 7 15 -f 6 15 14 -f 6 19 18 7 -f 7 8 16 -f 7 16 15 -f 7 18 8 -f 8 9 16 -f 9 10 11 12 13 14 15 16 -f 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n24.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n24.obj deleted file mode 100644 index 95d5834f..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n24.obj +++ /dev/null @@ -1,57 +0,0 @@ -v -0.28840390 -0.88761595 -0.13832577 -v -0.75505123 -0.54857683 -0.13832577 -v -0.93329464 0.00000000 -0.13832577 -v -0.75505123 0.54857683 -0.13832577 -v -0.28840391 0.88761595 -0.13832577 -v 0.28840390 0.88761595 -0.13832577 -v 0.75505122 0.54857683 -0.13832577 -v 0.93329464 0.00000000 -0.13832577 -v 0.75505123 -0.54857683 -0.13832577 -v 0.28840391 -0.88761595 -0.13832577 -v -0.28840390 -0.39695392 -0.44157158 -v -0.46664732 0.15162291 -0.44157158 -v 0.00000000 0.49066203 -0.44157158 -v 0.46664732 0.15162291 -0.44157158 -v 0.28840391 -0.39695392 -0.44157158 -v -0.54857683 -0.75505123 0.35911156 -v 0.00000000 -0.93329464 0.35911156 -v 0.54857683 -0.75505123 0.35911156 -v 0.88761595 -0.28840391 0.35911156 -v 0.88761595 0.28840390 0.35911156 -v 0.54857683 0.75505123 0.35911156 -v -0.00000000 0.93329464 0.35911156 -v -0.54857683 0.75505123 0.35911156 -v -0.88761595 0.28840390 0.35911156 -v -0.88761595 -0.28840391 0.35911156 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 -f 1 17 16 -f 1 16 2 -f 2 3 12 11 -f 2 16 25 -f 2 25 3 -f 3 4 12 -f 3 25 24 -f 3 24 4 -f 4 5 13 12 -f 4 24 23 -f 4 23 5 -f 5 6 13 -f 5 23 22 -f 5 22 6 -f 6 7 14 13 -f 6 22 21 -f 6 21 7 -f 7 8 14 -f 7 21 20 -f 7 20 8 -f 8 9 15 14 -f 8 20 19 -f 8 19 9 -f 9 10 15 -f 9 19 18 -f 9 18 10 -f 10 18 17 -f 11 12 13 14 15 -f 16 17 18 19 20 21 22 23 24 25 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n25.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n25.obj deleted file mode 100644 index e3048519..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n25.obj +++ /dev/null @@ -1,67 +0,0 @@ -v -0.26676074 -0.82100515 0.04465919 -v -0.69838870 -0.50740909 0.04465919 -v -0.86325590 0.00000000 0.04465919 -v -0.69838870 0.50740909 0.04465919 -v -0.26676075 0.82100515 0.04465919 -v 0.26676074 0.82100515 0.04465919 -v 0.69838870 0.50740909 0.04465919 -v 0.86325590 0.00000000 0.04465919 -v 0.69838870 -0.50740909 0.04465919 -v 0.26676074 -0.82100515 0.04465919 -v 0.00000000 -0.73432933 -0.40918129 -v -0.69838870 -0.22692024 -0.40918129 -v -0.43162795 0.59408491 -0.40918129 -v 0.43162795 0.59408491 -0.40918129 -v 0.69838870 -0.22692024 -0.40918129 -v -0.26676074 -0.36716467 -0.68967014 -v -0.43162795 0.14024442 -0.68967014 -v 0.00000000 0.45384049 -0.68967014 -v 0.43162795 0.14024442 -0.68967014 -v 0.26676074 -0.36716467 -0.68967014 -v -0.50740909 -0.69838870 0.50476653 -v 0.00000000 -0.86325590 0.50476653 -v 0.50740909 -0.69838870 0.50476653 -v 0.82100515 -0.26676074 0.50476653 -v 0.82100515 0.26676074 0.50476653 -v 0.50740909 0.69838870 0.50476653 -v -0.00000000 0.86325590 0.50476653 -v -0.50740909 0.69838870 0.50476653 -v -0.82100515 0.26676074 0.50476653 -v -0.82100515 -0.26676074 0.50476653 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 22 -f 1 22 21 -f 1 21 2 -f 2 3 12 -f 2 21 30 -f 2 30 3 -f 3 4 13 17 12 -f 3 30 29 -f 3 29 4 -f 4 5 13 -f 4 29 28 -f 4 28 5 -f 5 6 14 18 13 -f 5 28 27 -f 5 27 6 -f 6 7 14 -f 6 27 26 -f 6 26 7 -f 7 8 15 19 14 -f 7 26 25 -f 7 25 8 -f 8 9 15 -f 8 25 24 -f 8 24 9 -f 9 10 11 20 15 -f 9 24 23 -f 9 23 10 -f 10 23 22 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 -f 21 22 23 24 25 26 27 28 29 30 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n26.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n26.obj deleted file mode 100644 index 3eb6d8d7..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n26.obj +++ /dev/null @@ -1,16 +0,0 @@ -v -0.25000000 -0.43301270 0.50000000 -v 0.25000000 0.43301270 0.50000000 -v 0.75000000 -0.43301270 0.50000000 -v -0.25000000 -0.43301270 -0.50000000 -v 0.25000000 0.43301270 -0.50000000 -v 0.75000000 -0.43301270 -0.50000000 -v -1.00000000 0.00000000 -0.00000000 -v -0.50000000 0.86602540 0.00000000 -f 1 4 6 3 -f 1 3 2 -f 1 2 8 7 -f 1 7 4 -f 2 3 6 5 -f 2 5 8 -f 4 5 6 -f 4 7 8 5 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n27.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n27.obj deleted file mode 100644 index 41a03100..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n27.obj +++ /dev/null @@ -1,26 +0,0 @@ -v -0.50000000 -0.86602540 0.00000000 -v -1.00000000 0.00000000 0.00000000 -v -0.50000000 0.86602540 0.00000000 -v 0.50000000 0.86602540 0.00000000 -v 1.00000000 -0.00000000 0.00000000 -v 0.50000000 -0.86602540 0.00000000 -v -0.50000000 -0.28867513 -0.81649658 -v 0.00000000 0.57735027 -0.81649658 -v 0.50000000 -0.28867513 -0.81649658 -v -0.50000000 -0.28867513 0.81649658 -v 0.50000000 -0.28867513 0.81649658 -v 0.00000000 0.57735027 0.81649658 -f 1 2 7 -f 1 7 9 6 -f 1 6 11 10 -f 1 10 2 -f 2 3 8 7 -f 2 10 12 3 -f 3 4 8 -f 3 12 4 -f 4 5 9 8 -f 4 12 11 5 -f 5 6 9 -f 5 11 6 -f 7 8 9 -f 10 11 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n28.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n28.obj deleted file mode 100644 index 8d1f142f..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n28.obj +++ /dev/null @@ -1,34 +0,0 @@ -v -0.38268343 -0.92387953 -0.00000000 -v -0.92387953 -0.38268343 -0.00000000 -v -0.92387953 0.38268343 -0.00000000 -v -0.38268343 0.92387953 -0.00000000 -v 0.38268343 0.92387953 -0.00000000 -v 0.92387953 0.38268343 -0.00000000 -v 0.92387953 -0.38268343 -0.00000000 -v 0.38268343 -0.92387953 -0.00000000 -v -0.00000000 -0.54119610 -0.54119610 -v -0.54119610 0.00000000 -0.54119610 -v 0.00000000 0.54119610 -0.54119610 -v 0.54119610 -0.00000000 -0.54119610 -v -0.54119610 0.00000000 0.54119610 -v 0.00000000 -0.54119610 0.54119610 -v 0.54119610 -0.00000000 0.54119610 -v -0.00000000 0.54119610 0.54119610 -f 1 2 10 9 -f 1 9 8 -f 1 8 14 -f 1 14 13 2 -f 2 3 10 -f 2 13 3 -f 3 4 11 10 -f 3 13 16 4 -f 4 5 11 -f 4 16 5 -f 5 6 12 11 -f 5 16 15 6 -f 6 7 12 -f 6 15 7 -f 7 8 9 12 -f 7 15 14 8 -f 9 10 11 12 -f 13 14 15 16 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n29.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n29.obj deleted file mode 100644 index ef7fd148..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n29.obj +++ /dev/null @@ -1,34 +0,0 @@ -v -0.38268343 -0.92387953 -0.00000000 -v -0.92387953 -0.38268343 -0.00000000 -v -0.92387953 0.38268343 -0.00000000 -v -0.38268343 0.92387953 -0.00000000 -v 0.38268343 0.92387953 -0.00000000 -v 0.92387953 0.38268343 -0.00000000 -v 0.92387953 -0.38268343 -0.00000000 -v 0.38268343 -0.92387953 -0.00000000 -v 0.00000000 -0.54119610 -0.54119610 -v -0.54119610 0.00000000 -0.54119610 -v 0.00000000 0.54119610 -0.54119610 -v 0.54119610 -0.00000000 -0.54119610 -v -0.38268343 -0.38268343 0.54119610 -v 0.38268343 -0.38268343 0.54119610 -v 0.38268343 0.38268343 0.54119610 -v -0.38268343 0.38268343 0.54119610 -f 1 2 10 9 -f 1 9 8 -f 1 8 14 13 -f 1 13 2 -f 2 3 10 -f 2 13 16 3 -f 3 4 11 10 -f 3 16 4 -f 4 5 11 -f 4 16 15 5 -f 5 6 12 11 -f 5 15 6 -f 6 7 12 -f 6 15 14 7 -f 7 8 9 12 -f 7 14 8 -f 9 10 11 12 -f 13 14 15 16 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n30.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n30.obj deleted file mode 100644 index 565d361a..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n30.obj +++ /dev/null @@ -1,42 +0,0 @@ -v -0.30901699 -0.95105652 0.00000000 -v -0.80901699 -0.58778525 0.00000000 -v -1.00000000 0.00000000 0.00000000 -v -0.80901699 0.58778525 0.00000000 -v -0.30901699 0.95105652 0.00000000 -v 0.30901699 0.95105652 0.00000000 -v 0.80901699 0.58778525 0.00000000 -v 1.00000000 -0.00000000 0.00000000 -v 0.80901699 -0.58778525 0.00000000 -v 0.30901699 -0.95105652 0.00000000 -v -0.30901699 -0.42532540 -0.32491970 -v -0.50000000 0.16245985 -0.32491970 -v 0.00000000 0.52573111 -0.32491970 -v 0.50000000 0.16245985 -0.32491970 -v 0.30901699 -0.42532540 -0.32491970 -v -0.30901699 -0.42532540 0.32491970 -v 0.30901699 -0.42532540 0.32491970 -v 0.50000000 0.16245985 0.32491970 -v -0.00000000 0.52573111 0.32491970 -v -0.50000000 0.16245985 0.32491970 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 16 -f 1 16 2 -f 2 3 12 11 -f 2 16 20 3 -f 3 4 12 -f 3 20 4 -f 4 5 13 12 -f 4 20 19 5 -f 5 6 13 -f 5 19 6 -f 6 7 14 13 -f 6 19 18 7 -f 7 8 14 -f 7 18 8 -f 8 9 15 14 -f 8 18 17 9 -f 9 10 15 -f 9 17 10 -f 11 12 13 14 15 -f 16 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n31.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n31.obj deleted file mode 100644 index 2bc879c4..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n31.obj +++ /dev/null @@ -1,42 +0,0 @@ -v -0.30901699 -0.95105652 -0.00000000 -v -0.80901699 -0.58778525 -0.00000000 -v -1.00000000 -0.00000000 -0.00000000 -v -0.80901699 0.58778525 -0.00000000 -v -0.30901700 0.95105652 -0.00000000 -v 0.30901699 0.95105652 -0.00000000 -v 0.80901699 0.58778525 -0.00000000 -v 1.00000000 -0.00000000 -0.00000000 -v 0.80901699 -0.58778525 -0.00000000 -v 0.30901699 -0.95105652 -0.00000000 -v -0.30901699 -0.42532540 -0.32491970 -v -0.50000000 0.16245985 -0.32491970 -v 0.00000000 0.52573111 -0.32491970 -v 0.50000000 0.16245985 -0.32491970 -v 0.30901699 -0.42532540 -0.32491970 -v 0.00000000 -0.52573111 0.32491970 -v 0.50000000 -0.16245985 0.32491970 -v 0.30901699 0.42532540 0.32491970 -v -0.30901699 0.42532540 0.32491970 -v -0.50000000 -0.16245985 0.32491970 -f 1 2 11 -f 1 11 15 10 -f 1 10 16 -f 1 16 20 2 -f 2 3 12 11 -f 2 20 3 -f 3 4 12 -f 3 20 19 4 -f 4 5 13 12 -f 4 19 5 -f 5 6 13 -f 5 19 18 6 -f 6 7 14 13 -f 6 18 7 -f 7 8 14 -f 7 18 17 8 -f 8 9 15 14 -f 8 17 9 -f 9 10 15 -f 9 17 16 10 -f 11 12 13 14 15 -f 16 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n32.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n32.obj deleted file mode 100644 index 39d12437..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n32.obj +++ /dev/null @@ -1,52 +0,0 @@ -v -0.30240276 -0.93070001 -0.20579132 -v -0.79170071 -0.57520424 -0.20579132 -v -0.97859590 -0.00000000 -0.20579132 -v -0.79170071 0.57520424 -0.20579132 -v -0.30240276 0.93070001 -0.20579132 -v 0.30240276 0.93070001 -0.20579132 -v 0.79170071 0.57520424 -0.20579132 -v 0.97859590 -0.00000000 -0.20579132 -v 0.79170071 -0.57520424 -0.20579132 -v 0.30240276 -0.93070001 -0.20579132 -v -0.30240276 -0.41622170 -0.52375640 -v -0.48929795 0.15898254 -0.52375641 -v 0.00000000 0.51447831 -0.52375641 -v 0.48929795 0.15898254 -0.52375641 -v 0.30240276 -0.41622170 -0.52375640 -v -0.48929795 -0.67346085 0.30868699 -v 0.48929795 -0.67346085 0.30868699 -v 0.79170071 0.25723915 0.30868699 -v -0.00000000 0.83244339 0.30868699 -v -0.79170071 0.25723915 0.30868699 -v 0.00000000 -0.51447831 0.62665207 -v 0.48929795 -0.15898254 0.62665207 -v 0.30240276 0.41622170 0.62665207 -v -0.30240276 0.41622170 0.62665207 -v -0.48929795 -0.15898254 0.62665207 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 21 16 -f 1 16 2 -f 2 3 12 11 -f 2 16 25 20 3 -f 3 4 12 -f 3 20 4 -f 4 5 13 12 -f 4 20 24 19 5 -f 5 6 13 -f 5 19 6 -f 6 7 14 13 -f 6 19 23 18 7 -f 7 8 14 -f 7 18 8 -f 8 9 15 14 -f 8 18 22 17 9 -f 9 10 15 -f 9 17 10 -f 11 12 13 14 15 -f 16 21 25 -f 17 22 21 -f 18 23 22 -f 19 24 23 -f 20 25 24 -f 21 22 23 24 25 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n33.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n33.obj deleted file mode 100644 index 4fb6508f..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n33.obj +++ /dev/null @@ -1,52 +0,0 @@ -v -0.30240276 -0.93070001 -0.20579132 -v -0.79170071 -0.57520424 -0.20579132 -v -0.97859590 0.00000000 -0.20579132 -v -0.79170071 0.57520424 -0.20579132 -v -0.30240276 0.93070001 -0.20579132 -v 0.30240276 0.93070001 -0.20579132 -v 0.79170071 0.57520424 -0.20579132 -v 0.97859590 -0.00000000 -0.20579132 -v 0.79170071 -0.57520424 -0.20579132 -v 0.30240276 -0.93070001 -0.20579132 -v -0.30240276 -0.41622170 -0.52375641 -v -0.48929795 0.15898254 -0.52375641 -v 0.00000000 0.51447831 -0.52375641 -v 0.48929795 0.15898254 -0.52375641 -v 0.30240276 -0.41622170 -0.52375641 -v -0.79170071 -0.25723915 0.30868699 -v 0.00000000 -0.83244339 0.30868699 -v 0.79170071 -0.25723915 0.30868699 -v 0.48929795 0.67346085 0.30868699 -v -0.48929795 0.67346085 0.30868699 -v -0.30240276 -0.41622170 0.62665207 -v 0.30240276 -0.41622170 0.62665207 -v 0.48929795 0.15898254 0.62665207 -v -0.00000000 0.51447831 0.62665207 -v -0.48929795 0.15898254 0.62665207 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 -f 1 17 21 16 2 -f 2 3 12 11 -f 2 16 3 -f 3 4 12 -f 3 16 25 20 4 -f 4 5 13 12 -f 4 20 5 -f 5 6 13 -f 5 20 24 19 6 -f 6 7 14 13 -f 6 19 7 -f 7 8 14 -f 7 19 23 18 8 -f 8 9 15 14 -f 8 18 9 -f 9 10 15 -f 9 18 22 17 10 -f 11 12 13 14 15 -f 16 21 25 -f 17 22 21 -f 18 23 22 -f 19 24 23 -f 20 25 24 -f 21 22 23 24 25 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n34.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n34.obj deleted file mode 100644 index eea5439f..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n34.obj +++ /dev/null @@ -1,62 +0,0 @@ -v -0.30901699 -0.95105652 0.00000000 -v -0.80901699 -0.58778525 0.00000000 -v -1.00000000 0.00000000 0.00000000 -v -0.80901699 0.58778525 0.00000000 -v -0.30901699 0.95105652 0.00000000 -v 0.30901699 0.95105652 0.00000000 -v 0.80901699 0.58778525 0.00000000 -v 1.00000000 -0.00000000 0.00000000 -v 0.80901699 -0.58778525 0.00000000 -v 0.30901699 -0.95105652 0.00000000 -v -0.00000000 -0.85065081 -0.52573111 -v -0.80901699 -0.26286556 -0.52573111 -v -0.50000000 0.68819096 -0.52573111 -v 0.50000000 0.68819096 -0.52573111 -v 0.80901699 -0.26286556 -0.52573111 -v -0.30901699 -0.42532540 -0.85065081 -v -0.50000000 0.16245985 -0.85065081 -v 0.00000000 0.52573111 -0.85065081 -v 0.50000000 0.16245985 -0.85065081 -v 0.30901699 -0.42532540 -0.85065081 -v -0.80901699 -0.26286556 0.52573111 -v 0.00000000 -0.85065081 0.52573111 -v 0.80901699 -0.26286556 0.52573111 -v 0.50000000 0.68819096 0.52573111 -v -0.50000000 0.68819096 0.52573111 -v -0.30901699 -0.42532540 0.85065081 -v 0.30901699 -0.42532540 0.85065081 -v 0.50000000 0.16245985 0.85065081 -v -0.00000000 0.52573111 0.85065081 -v -0.50000000 0.16245985 0.85065081 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 22 -f 1 22 26 21 2 -f 2 3 12 -f 2 21 3 -f 3 4 13 17 12 -f 3 21 30 25 4 -f 4 5 13 -f 4 25 5 -f 5 6 14 18 13 -f 5 25 29 24 6 -f 6 7 14 -f 6 24 7 -f 7 8 15 19 14 -f 7 24 28 23 8 -f 8 9 15 -f 8 23 9 -f 9 10 11 20 15 -f 9 23 27 22 10 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 -f 21 26 30 -f 22 27 26 -f 23 28 27 -f 24 29 28 -f 25 30 29 -f 26 27 28 29 30 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n35.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n35.obj deleted file mode 100644 index ed3b9efc..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n35.obj +++ /dev/null @@ -1,38 +0,0 @@ -v -0.34781848 -0.60243929 0.34781848 -v -0.69563697 0.00000000 0.34781848 -v -0.34781848 0.60243929 0.34781848 -v 0.34781848 0.60243929 0.34781848 -v 0.69563697 0.00000000 0.34781848 -v 0.34781848 -0.60243929 0.34781848 -v -0.34781848 -0.60243929 -0.34781848 -v -0.69563697 0.00000000 -0.34781848 -v -0.34781848 0.60243929 -0.34781848 -v 0.34781848 0.60243929 -0.34781848 -v 0.69563697 -0.00000000 -0.34781848 -v 0.34781848 -0.60243929 -0.34781848 -v 0.00000000 -0.40162619 0.91580369 -v 0.34781848 0.20081310 0.91580369 -v -0.34781848 0.20081310 0.91580369 -v -0.34781848 0.20081310 -0.91580369 -v 0.34781848 0.20081310 -0.91580369 -v 0.00000000 -0.40162619 -0.91580369 -f 1 2 8 7 -f 1 7 12 6 -f 1 6 13 -f 1 13 15 2 -f 2 3 9 8 -f 2 15 3 -f 3 4 10 9 -f 3 15 14 4 -f 4 5 11 10 -f 4 14 5 -f 5 6 12 11 -f 5 14 13 6 -f 7 8 16 18 -f 7 18 12 -f 8 9 16 -f 9 10 17 16 -f 10 11 17 -f 11 12 18 17 -f 13 14 15 -f 16 17 18 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n36.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n36.obj deleted file mode 100644 index 977ef5c4..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n36.obj +++ /dev/null @@ -1,38 +0,0 @@ -v -0.34781848 -0.60243929 0.34781848 -v -0.69563697 0.00000000 0.34781848 -v -0.34781848 0.60243929 0.34781848 -v 0.34781848 0.60243929 0.34781848 -v 0.69563697 0.00000000 0.34781848 -v 0.34781848 -0.60243929 0.34781848 -v -0.34781848 -0.60243929 -0.34781848 -v -0.69563697 0.00000000 -0.34781848 -v -0.34781848 0.60243929 -0.34781848 -v 0.34781848 0.60243929 -0.34781848 -v 0.69563697 -0.00000000 -0.34781848 -v 0.34781848 -0.60243929 -0.34781848 -v 0.00000000 -0.40162619 0.91580369 -v 0.34781848 0.20081310 0.91580369 -v -0.34781848 0.20081310 0.91580369 -v -0.34781848 -0.20081310 -0.91580369 -v -0.00000000 0.40162619 -0.91580369 -v 0.34781848 -0.20081310 -0.91580369 -f 1 2 8 7 -f 1 7 12 6 -f 1 6 13 -f 1 13 15 2 -f 2 3 9 8 -f 2 15 3 -f 3 4 10 9 -f 3 15 14 4 -f 4 5 11 10 -f 4 14 5 -f 5 6 12 11 -f 5 14 13 6 -f 7 8 16 -f 7 16 18 12 -f 8 9 17 16 -f 9 10 17 -f 10 11 18 17 -f 11 12 18 -f 13 14 15 -f 16 17 18 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n37.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n37.obj deleted file mode 100644 index 69c08490..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n37.obj +++ /dev/null @@ -1,50 +0,0 @@ -v -0.35740674 -0.86285621 0.35740674 -v -0.86285621 -0.35740674 0.35740674 -v -0.86285621 0.35740674 0.35740674 -v -0.35740674 0.86285621 0.35740674 -v 0.35740674 0.86285621 0.35740674 -v 0.86285621 0.35740674 0.35740674 -v 0.86285621 -0.35740674 0.35740674 -v 0.35740674 -0.86285621 0.35740674 -v -0.35740674 -0.86285621 -0.35740674 -v -0.86285621 -0.35740674 -0.35740674 -v -0.86285621 0.35740674 -0.35740674 -v -0.35740674 0.86285621 -0.35740674 -v 0.35740674 0.86285621 -0.35740674 -v 0.86285621 0.35740674 -0.35740674 -v 0.86285621 -0.35740674 -0.35740674 -v 0.35740674 -0.86285621 -0.35740674 -v -0.35740674 -0.35740674 0.86285621 -v 0.35740674 -0.35740674 0.86285621 -v 0.35740674 0.35740674 0.86285621 -v -0.35740674 0.35740674 0.86285621 -v 0.00000000 -0.50544946 -0.86285621 -v -0.50544946 -0.00000000 -0.86285621 -v 0.00000000 0.50544946 -0.86285621 -v 0.50544946 -0.00000000 -0.86285621 -f 1 2 10 9 -f 1 9 16 8 -f 1 8 18 17 -f 1 17 2 -f 2 3 11 10 -f 2 17 20 3 -f 3 4 12 11 -f 3 20 4 -f 4 5 13 12 -f 4 20 19 5 -f 5 6 14 13 -f 5 19 6 -f 6 7 15 14 -f 6 19 18 7 -f 7 8 16 15 -f 7 18 8 -f 9 10 22 21 -f 9 21 16 -f 10 11 22 -f 11 12 23 22 -f 12 13 23 -f 13 14 24 23 -f 14 15 24 -f 15 16 21 24 -f 17 18 19 20 -f 21 22 23 24 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n38.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n38.obj deleted file mode 100644 index fd528ea3..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n38.obj +++ /dev/null @@ -1,62 +0,0 @@ -v -0.29524181 -0.90866085 -0.29524181 -v -0.77295309 -0.56158329 -0.29524181 -v -0.95542256 0.00000000 -0.29524181 -v -0.77295309 0.56158329 -0.29524181 -v -0.29524181 0.90866085 -0.29524181 -v 0.29524181 0.90866085 -0.29524181 -v 0.77295309 0.56158329 -0.29524181 -v 0.95542256 0.00000000 -0.29524181 -v 0.77295309 -0.56158329 -0.29524181 -v 0.29524181 -0.90866085 -0.29524181 -v -0.29524181 -0.40636549 -0.60567742 -v -0.47771128 0.15521780 -0.60567742 -v 0.00000000 0.50229537 -0.60567742 -v 0.47771128 0.15521780 -0.60567742 -v 0.29524181 -0.40636549 -0.60567742 -v -0.29524181 -0.90866085 0.29524181 -v 0.29524181 -0.90866085 0.29524181 -v 0.77295309 -0.56158329 0.29524181 -v 0.95542256 -0.00000000 0.29524181 -v 0.77295309 0.56158329 0.29524181 -v 0.29524181 0.90866085 0.29524181 -v -0.29524181 0.90866085 0.29524181 -v -0.77295309 0.56158329 0.29524181 -v -0.95542256 0.00000000 0.29524181 -v -0.77295309 -0.56158329 0.29524181 -v -0.29524181 -0.40636549 0.60567742 -v 0.29524181 -0.40636549 0.60567742 -v 0.47771128 0.15521780 0.60567742 -v 0.00000000 0.50229537 0.60567742 -v -0.47771128 0.15521780 0.60567742 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 16 -f 1 16 25 2 -f 2 3 12 11 -f 2 25 24 3 -f 3 4 12 -f 3 24 23 4 -f 4 5 13 12 -f 4 23 22 5 -f 5 6 13 -f 5 22 21 6 -f 6 7 14 13 -f 6 21 20 7 -f 7 8 14 -f 7 20 19 8 -f 8 9 15 14 -f 8 19 18 9 -f 9 10 15 -f 9 18 17 10 -f 11 12 13 14 15 -f 16 17 27 26 -f 16 26 25 -f 17 18 27 -f 18 19 28 27 -f 19 20 28 -f 20 21 29 28 -f 21 22 29 -f 22 23 30 29 -f 23 24 30 -f 24 25 26 30 -f 26 27 28 29 30 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n39.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n39.obj deleted file mode 100644 index 5cb96de7..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n39.obj +++ /dev/null @@ -1,62 +0,0 @@ -v -0.29524181 -0.90866085 -0.29524181 -v -0.77295309 -0.56158329 -0.29524181 -v -0.95542256 -0.00000000 -0.29524181 -v -0.77295309 0.56158329 -0.29524181 -v -0.29524181 0.90866085 -0.29524181 -v 0.29524181 0.90866085 -0.29524181 -v 0.77295309 0.56158329 -0.29524181 -v 0.95542256 -0.00000000 -0.29524181 -v 0.77295309 -0.56158329 -0.29524181 -v 0.29524181 -0.90866085 -0.29524181 -v -0.29524181 -0.40636549 -0.60567742 -v -0.47771128 0.15521780 -0.60567742 -v 0.00000000 0.50229537 -0.60567742 -v 0.47771128 0.15521780 -0.60567742 -v 0.29524181 -0.40636549 -0.60567742 -v -0.29524181 -0.90866085 0.29524181 -v 0.29524181 -0.90866085 0.29524181 -v 0.77295309 -0.56158329 0.29524181 -v 0.95542256 0.00000000 0.29524181 -v 0.77295309 0.56158329 0.29524181 -v 0.29524181 0.90866085 0.29524181 -v -0.29524181 0.90866085 0.29524181 -v -0.77295309 0.56158329 0.29524181 -v -0.95542256 0.00000000 0.29524181 -v -0.77295309 -0.56158329 0.29524181 -v 0.00000000 -0.50229537 0.60567742 -v 0.47771128 -0.15521780 0.60567742 -v 0.29524181 0.40636549 0.60567742 -v -0.29524181 0.40636549 0.60567742 -v -0.47771128 -0.15521780 0.60567742 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 16 -f 1 16 25 2 -f 2 3 12 11 -f 2 25 24 3 -f 3 4 12 -f 3 24 23 4 -f 4 5 13 12 -f 4 23 22 5 -f 5 6 13 -f 5 22 21 6 -f 6 7 14 13 -f 6 21 20 7 -f 7 8 14 -f 7 20 19 8 -f 8 9 15 14 -f 8 19 18 9 -f 9 10 15 -f 9 18 17 10 -f 11 12 13 14 15 -f 16 17 26 -f 16 26 30 25 -f 17 18 27 26 -f 18 19 27 -f 19 20 28 27 -f 20 21 28 -f 21 22 29 28 -f 22 23 29 -f 23 24 30 29 -f 24 25 30 -f 26 27 28 29 30 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n40.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n40.obj deleted file mode 100644 index c1b57f02..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n40.obj +++ /dev/null @@ -1,72 +0,0 @@ -v -0.27602000 -0.84950220 -0.44962093 -v -0.72262973 -0.52502123 -0.44962093 -v -0.89321947 -0.00000000 -0.44962093 -v -0.72262973 0.52502123 -0.44962093 -v -0.27602000 0.84950220 -0.44962093 -v 0.27601999 0.84950220 -0.44962093 -v 0.72262973 0.52502123 -0.44962093 -v 0.89321947 -0.00000000 -0.44962093 -v 0.72262973 -0.52502123 -0.44962093 -v 0.27602000 -0.84950220 -0.44962093 -v -0.27602000 -0.37990893 -0.73984553 -v -0.44660973 0.14511230 -0.73984553 -v 0.00000000 0.46959326 -0.73984553 -v 0.44660974 0.14511230 -0.73984553 -v 0.27602000 -0.37990893 -0.73984553 -v -0.27602000 -0.84950220 0.10241906 -v 0.27602000 -0.84950220 0.10241906 -v 0.72262973 -0.52502123 0.10241906 -v 0.89321947 -0.00000000 0.10241906 -v 0.72262973 0.52502123 0.10241906 -v 0.27601999 0.84950220 0.10241906 -v -0.27602000 0.84950220 0.10241906 -v -0.72262973 0.52502123 0.10241906 -v -0.89321947 -0.00000000 0.10241906 -v -0.72262973 -0.52502123 0.10241906 -v -0.44660973 -0.61470556 0.57201233 -v 0.44660974 -0.61470556 0.57201233 -v 0.72262973 0.23479663 0.57201233 -v -0.00000000 0.75981786 0.57201233 -v -0.72262973 0.23479663 0.57201233 -v 0.00000000 -0.46959326 0.86223693 -v 0.44660973 -0.14511230 0.86223693 -v 0.27602000 0.37990893 0.86223693 -v -0.27602000 0.37990893 0.86223693 -v -0.44660973 -0.14511230 0.86223693 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 16 -f 1 16 25 2 -f 2 3 12 11 -f 2 25 24 3 -f 3 4 12 -f 3 24 23 4 -f 4 5 13 12 -f 4 23 22 5 -f 5 6 13 -f 5 22 21 6 -f 6 7 14 13 -f 6 21 20 7 -f 7 8 14 -f 7 20 19 8 -f 8 9 15 14 -f 8 19 18 9 -f 9 10 15 -f 9 18 17 10 -f 11 12 13 14 15 -f 16 17 27 31 26 -f 16 26 25 -f 17 18 27 -f 18 19 28 32 27 -f 19 20 28 -f 20 21 29 33 28 -f 21 22 29 -f 22 23 30 34 29 -f 23 24 30 -f 24 25 26 35 30 -f 26 31 35 -f 27 32 31 -f 28 33 32 -f 29 34 33 -f 30 35 34 -f 31 32 33 34 35 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n41.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n41.obj deleted file mode 100644 index 3adcc5a7..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n41.obj +++ /dev/null @@ -1,72 +0,0 @@ -v -0.27602000 -0.84950220 -0.44962093 -v -0.72262973 -0.52502123 -0.44962093 -v -0.89321947 0.00000000 -0.44962093 -v -0.72262973 0.52502123 -0.44962093 -v -0.27602000 0.84950220 -0.44962093 -v 0.27601999 0.84950220 -0.44962093 -v 0.72262973 0.52502123 -0.44962093 -v 0.89321947 0.00000000 -0.44962093 -v 0.72262973 -0.52502123 -0.44962093 -v 0.27602000 -0.84950220 -0.44962093 -v -0.27602000 -0.37990893 -0.73984553 -v -0.44660973 0.14511230 -0.73984553 -v 0.00000000 0.46959326 -0.73984553 -v 0.44660973 0.14511230 -0.73984553 -v 0.27602000 -0.37990893 -0.73984553 -v -0.27602000 -0.84950220 0.10241906 -v 0.27602000 -0.84950220 0.10241906 -v 0.72262973 -0.52502123 0.10241906 -v 0.89321947 -0.00000000 0.10241906 -v 0.72262973 0.52502123 0.10241906 -v 0.27602000 0.84950220 0.10241906 -v -0.27602000 0.84950220 0.10241906 -v -0.72262973 0.52502123 0.10241906 -v -0.89321947 -0.00000000 0.10241906 -v -0.72262973 -0.52502123 0.10241906 -v -0.72262973 -0.23479663 0.57201233 -v 0.00000000 -0.75981786 0.57201233 -v 0.72262973 -0.23479663 0.57201233 -v 0.44660973 0.61470556 0.57201233 -v -0.44660973 0.61470556 0.57201233 -v -0.27602000 -0.37990893 0.86223693 -v 0.27602000 -0.37990893 0.86223693 -v 0.44660973 0.14511230 0.86223693 -v 0.00000000 0.46959326 0.86223693 -v -0.44660973 0.14511230 0.86223693 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 16 -f 1 16 25 2 -f 2 3 12 11 -f 2 25 24 3 -f 3 4 12 -f 3 24 23 4 -f 4 5 13 12 -f 4 23 22 5 -f 5 6 13 -f 5 22 21 6 -f 6 7 14 13 -f 6 21 20 7 -f 7 8 14 -f 7 20 19 8 -f 8 9 15 14 -f 8 19 18 9 -f 9 10 15 -f 9 18 17 10 -f 11 12 13 14 15 -f 16 17 27 -f 16 27 31 26 25 -f 17 18 28 32 27 -f 18 19 28 -f 19 20 29 33 28 -f 20 21 29 -f 21 22 30 34 29 -f 22 23 30 -f 23 24 26 35 30 -f 24 25 26 -f 26 31 35 -f 27 32 31 -f 28 33 32 -f 29 34 33 -f 30 35 34 -f 31 32 33 34 35 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n42.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n42.obj deleted file mode 100644 index 414d704a..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n42.obj +++ /dev/null @@ -1,82 +0,0 @@ -v -0.24269512 -0.74693876 -0.24269512 -v -0.63538406 -0.46163354 -0.24269512 -v -0.78537789 0.00000000 -0.24269512 -v -0.63538406 0.46163354 -0.24269512 -v -0.24269512 0.74693876 -0.24269512 -v 0.24269512 0.74693876 -0.24269512 -v 0.63538406 0.46163354 -0.24269512 -v 0.78537789 0.00000000 -0.24269512 -v 0.63538406 -0.46163354 -0.24269512 -v 0.24269512 -0.74693876 -0.24269512 -v 0.00000000 -0.66808234 -0.65559271 -v -0.63538406 -0.20644880 -0.65559271 -v -0.39268895 0.54048997 -0.65559271 -v 0.39268895 0.54048997 -0.65559271 -v 0.63538406 -0.20644880 -0.65559271 -v -0.24269512 -0.33404117 -0.91077746 -v -0.39268895 0.12759237 -0.91077746 -v 0.00000000 0.41289759 -0.91077746 -v 0.39268895 0.12759237 -0.91077746 -v 0.24269512 -0.33404117 -0.91077746 -v -0.24269512 -0.74693876 0.24269512 -v 0.24269512 -0.74693876 0.24269512 -v 0.63538406 -0.46163354 0.24269512 -v 0.78537789 -0.00000000 0.24269512 -v 0.63538406 0.46163354 0.24269512 -v 0.24269512 0.74693876 0.24269512 -v -0.24269512 0.74693876 0.24269512 -v -0.63538406 0.46163354 0.24269512 -v -0.78537789 0.00000000 0.24269512 -v -0.63538406 -0.46163354 0.24269512 -v -0.63538406 -0.20644880 0.65559271 -v 0.00000000 -0.66808234 0.65559271 -v 0.63538406 -0.20644880 0.65559271 -v 0.39268895 0.54048997 0.65559271 -v -0.39268895 0.54048997 0.65559271 -v -0.24269512 -0.33404117 0.91077746 -v 0.24269512 -0.33404117 0.91077746 -v 0.39268895 0.12759237 0.91077746 -v 0.00000000 0.41289759 0.91077746 -v -0.39268895 0.12759237 0.91077746 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 22 21 -f 1 21 30 2 -f 2 3 12 -f 2 30 29 3 -f 3 4 13 17 12 -f 3 29 28 4 -f 4 5 13 -f 4 28 27 5 -f 5 6 14 18 13 -f 5 27 26 6 -f 6 7 14 -f 6 26 25 7 -f 7 8 15 19 14 -f 7 25 24 8 -f 8 9 15 -f 8 24 23 9 -f 9 10 11 20 15 -f 9 23 22 10 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 -f 21 22 32 -f 21 32 36 31 30 -f 22 23 33 37 32 -f 23 24 33 -f 24 25 34 38 33 -f 25 26 34 -f 26 27 35 39 34 -f 27 28 35 -f 28 29 31 40 35 -f 29 30 31 -f 31 36 40 -f 32 37 36 -f 33 38 37 -f 34 39 38 -f 35 40 39 -f 36 37 38 39 40 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n43.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n43.obj deleted file mode 100644 index 15b86180..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n43.obj +++ /dev/null @@ -1,82 +0,0 @@ -v -0.24269512 -0.74693876 -0.24269512 -v -0.63538406 -0.46163354 -0.24269512 -v -0.78537789 -0.00000000 -0.24269512 -v -0.63538406 0.46163354 -0.24269512 -v -0.24269512 0.74693876 -0.24269512 -v 0.24269512 0.74693876 -0.24269512 -v 0.63538406 0.46163354 -0.24269512 -v 0.78537789 -0.00000000 -0.24269512 -v 0.63538406 -0.46163354 -0.24269512 -v 0.24269512 -0.74693876 -0.24269512 -v 0.00000000 -0.66808234 -0.65559271 -v -0.63538406 -0.20644880 -0.65559271 -v -0.39268895 0.54048997 -0.65559271 -v 0.39268895 0.54048997 -0.65559271 -v 0.63538406 -0.20644880 -0.65559271 -v -0.24269512 -0.33404117 -0.91077746 -v -0.39268895 0.12759237 -0.91077746 -v 0.00000000 0.41289759 -0.91077746 -v 0.39268895 0.12759237 -0.91077746 -v 0.24269512 -0.33404117 -0.91077746 -v -0.24269512 -0.74693876 0.24269512 -v 0.24269512 -0.74693876 0.24269512 -v 0.63538406 -0.46163354 0.24269512 -v 0.78537789 0.00000000 0.24269512 -v 0.63538406 0.46163354 0.24269512 -v 0.24269512 0.74693876 0.24269512 -v -0.24269512 0.74693876 0.24269512 -v -0.63538406 0.46163354 0.24269512 -v -0.78537789 0.00000000 0.24269512 -v -0.63538406 -0.46163354 0.24269512 -v -0.39268895 -0.54048997 0.65559271 -v 0.39268895 -0.54048997 0.65559271 -v 0.63538406 0.20644880 0.65559271 -v -0.00000000 0.66808234 0.65559271 -v -0.63538406 0.20644880 0.65559271 -v 0.00000000 -0.41289759 0.91077746 -v 0.39268895 -0.12759237 0.91077746 -v 0.24269512 0.33404117 0.91077746 -v -0.24269512 0.33404117 0.91077746 -v -0.39268895 -0.12759237 0.91077746 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 22 21 -f 1 21 30 2 -f 2 3 12 -f 2 30 29 3 -f 3 4 13 17 12 -f 3 29 28 4 -f 4 5 13 -f 4 28 27 5 -f 5 6 14 18 13 -f 5 27 26 6 -f 6 7 14 -f 6 26 25 7 -f 7 8 15 19 14 -f 7 25 24 8 -f 8 9 15 -f 8 24 23 9 -f 9 10 11 20 15 -f 9 23 22 10 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 -f 21 22 32 36 31 -f 21 31 30 -f 22 23 32 -f 23 24 33 37 32 -f 24 25 33 -f 25 26 34 38 33 -f 26 27 34 -f 27 28 35 39 34 -f 28 29 35 -f 29 30 31 40 35 -f 31 36 40 -f 32 37 36 -f 33 38 37 -f 34 39 38 -f 35 40 39 -f 36 37 38 39 40 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n44L.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n44L.obj deleted file mode 100644 index a118aec6..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n44L.obj +++ /dev/null @@ -1,44 +0,0 @@ -v -0.36450673 -0.63134418 0.31187184 -v -0.72901347 0.00000000 0.31187184 -v -0.36450673 0.63134418 0.31187184 -v 0.36450673 0.63134418 0.31187184 -v 0.72901347 0.00000000 0.31187184 -v 0.36450673 -0.63134418 0.31187184 -v 0.00000000 -0.72901347 -0.31187184 -v -0.63134418 -0.36450673 -0.31187184 -v -0.63134418 0.36450673 -0.31187184 -v -0.00000000 0.72901347 -0.31187184 -v 0.63134418 0.36450673 -0.31187184 -v 0.63134418 -0.36450673 -0.31187184 -v 0.00000000 -0.42089612 0.90710884 -v 0.36450673 0.21044806 0.90710884 -v -0.36450673 0.21044806 0.90710884 -v 0.21044806 -0.36450673 -0.90710884 -v -0.42089612 0.00000000 -0.90710884 -v 0.21044806 0.36450673 -0.90710884 -f 1 2 8 -f 1 8 7 -f 1 7 6 -f 1 6 13 -f 1 13 15 2 -f 2 3 9 -f 2 9 8 -f 2 15 3 -f 3 4 10 -f 3 10 9 -f 3 15 14 4 -f 4 5 11 -f 4 11 10 -f 4 14 5 -f 5 6 12 -f 5 12 11 -f 5 14 13 6 -f 6 7 12 -f 7 8 17 16 -f 7 16 12 -f 8 9 17 -f 9 10 18 17 -f 10 11 18 -f 11 12 16 18 -f 13 14 15 -f 16 17 18 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n44R.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n44R.obj deleted file mode 100644 index d29c2764..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n44R.obj +++ /dev/null @@ -1,44 +0,0 @@ -v -0.36450673 -0.63134418 0.31187184 -v -0.72901347 0.00000000 0.31187184 -v -0.36450673 0.63134418 0.31187184 -v 0.36450673 0.63134418 0.31187184 -v 0.72901347 0.00000000 0.31187184 -v 0.36450673 -0.63134418 0.31187184 -v 0.00000000 -0.72901347 -0.31187184 -v -0.63134418 -0.36450673 -0.31187184 -v -0.63134418 0.36450673 -0.31187184 -v 0.00000000 0.72901347 -0.31187184 -v 0.63134418 0.36450673 -0.31187184 -v 0.63134418 -0.36450673 -0.31187184 -v 0.00000000 -0.42089612 0.90710884 -v 0.36450673 0.21044806 0.90710884 -v -0.36450673 0.21044806 0.90710884 -v -0.21044806 -0.36450673 -0.90710884 -v -0.21044806 0.36450673 -0.90710884 -v 0.42089612 -0.00000000 -0.90710884 -f 1 2 8 -f 1 8 7 -f 1 7 6 -f 1 6 13 -f 1 13 15 2 -f 2 3 9 -f 2 9 8 -f 2 15 3 -f 3 4 10 -f 3 10 9 -f 3 15 14 4 -f 4 5 11 -f 4 11 10 -f 4 14 5 -f 5 6 12 -f 5 12 11 -f 5 14 13 6 -f 6 7 12 -f 7 8 16 -f 7 16 18 12 -f 8 9 17 16 -f 9 10 17 -f 10 11 18 17 -f 11 12 18 -f 13 14 15 -f 16 17 18 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n45L.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n45L.obj deleted file mode 100644 index 79c06df1..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n45L.obj +++ /dev/null @@ -1,58 +0,0 @@ -v -0.36349134 -0.87754573 0.31270999 -v -0.87754573 -0.36349134 0.31270999 -v -0.87754573 0.36349134 0.31270999 -v -0.36349134 0.87754573 0.31270999 -v 0.36349134 0.87754573 0.31270999 -v 0.87754573 0.36349134 0.31270999 -v 0.87754573 -0.36349134 0.31270999 -v 0.36349134 -0.87754573 0.31270999 -v 0.00000000 -0.94984865 -0.31270999 -v -0.67164442 -0.67164442 -0.31270999 -v -0.94984865 -0.00000000 -0.31270999 -v -0.67164442 0.67164442 -0.31270999 -v 0.00000000 0.94984865 -0.31270999 -v 0.67164442 0.67164442 -0.31270999 -v 0.94984865 -0.00000000 -0.31270999 -v 0.67164442 -0.67164442 -0.31270999 -v -0.36349134 -0.36349134 0.82676438 -v 0.36349134 -0.36349134 0.82676438 -v 0.36349134 0.36349134 0.82676438 -v -0.36349134 0.36349134 0.82676438 -v 0.47492433 -0.19672010 -0.82676438 -v -0.19672010 -0.47492433 -0.82676438 -v -0.47492433 0.19672010 -0.82676438 -v 0.19672010 0.47492433 -0.82676438 -f 1 2 10 -f 1 10 9 -f 1 9 8 -f 1 8 18 17 -f 1 17 2 -f 2 3 11 -f 2 11 10 -f 2 17 20 3 -f 3 4 12 -f 3 12 11 -f 3 20 4 -f 4 5 13 -f 4 13 12 -f 4 20 19 5 -f 5 6 14 -f 5 14 13 -f 5 19 6 -f 6 7 15 -f 6 15 14 -f 6 19 18 7 -f 7 8 16 -f 7 16 15 -f 7 18 8 -f 8 9 16 -f 9 10 22 -f 9 22 21 16 -f 10 11 23 22 -f 11 12 23 -f 12 13 24 23 -f 13 14 24 -f 14 15 21 24 -f 15 16 21 -f 17 18 19 20 -f 21 22 23 24 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n45R.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n45R.obj deleted file mode 100644 index 5b7ea3ed..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n45R.obj +++ /dev/null @@ -1,58 +0,0 @@ -v -0.36349134 -0.87754573 0.31270999 -v -0.87754573 -0.36349134 0.31270999 -v -0.87754573 0.36349134 0.31270999 -v -0.36349134 0.87754573 0.31270999 -v 0.36349134 0.87754573 0.31270999 -v 0.87754573 0.36349134 0.31270999 -v 0.87754573 -0.36349134 0.31270999 -v 0.36349134 -0.87754573 0.31270999 -v 0.00000000 -0.94984865 -0.31270999 -v -0.67164442 -0.67164442 -0.31270999 -v -0.94984865 -0.00000000 -0.31270999 -v -0.67164442 0.67164442 -0.31270999 -v 0.00000000 0.94984865 -0.31270999 -v 0.67164442 0.67164442 -0.31270999 -v 0.94984865 -0.00000000 -0.31270999 -v 0.67164442 -0.67164442 -0.31270999 -v -0.36349134 -0.36349134 0.82676438 -v 0.36349134 -0.36349134 0.82676438 -v 0.36349134 0.36349134 0.82676438 -v -0.36349134 0.36349134 0.82676438 -v 0.19672010 -0.47492433 -0.82676438 -v -0.47492433 -0.19672010 -0.82676438 -v -0.19672010 0.47492433 -0.82676438 -v 0.47492433 0.19672010 -0.82676438 -f 1 2 10 -f 1 10 9 -f 1 9 8 -f 1 8 18 17 -f 1 17 2 -f 2 3 11 -f 2 11 10 -f 2 17 20 3 -f 3 4 12 -f 3 12 11 -f 3 20 4 -f 4 5 13 -f 4 13 12 -f 4 20 19 5 -f 5 6 14 -f 5 14 13 -f 5 19 6 -f 6 7 15 -f 6 15 14 -f 6 19 18 7 -f 7 8 16 -f 7 16 15 -f 7 18 8 -f 8 9 16 -f 9 10 22 21 -f 9 21 16 -f 10 11 22 -f 11 12 23 22 -f 12 13 23 -f 13 14 24 23 -f 14 15 24 -f 15 16 21 24 -f 17 18 19 20 -f 21 22 23 24 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n46L.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n46L.obj deleted file mode 100644 index c36513d3..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n46L.obj +++ /dev/null @@ -1,72 +0,0 @@ -v -0.29859575 -0.91898322 -0.25750808 -v -0.78173382 -0.56796287 -0.25750808 -v -0.96627614 0.00000000 -0.25750808 -v -0.78173382 0.56796287 -0.25750808 -v -0.29859575 0.91898322 -0.25750808 -v 0.29859575 0.91898322 -0.25750808 -v 0.78173382 0.56796287 -0.25750808 -v 0.96627614 0.00000000 -0.25750808 -v 0.78173382 -0.56796287 -0.25750808 -v 0.29859575 -0.91898322 -0.25750808 -v -0.29859575 -0.41098179 -0.57147023 -v -0.48313807 0.15698108 -0.57147023 -v 0.00000000 0.50800143 -0.57147023 -v 0.48313807 0.15698108 -0.57147023 -v 0.29859575 -0.41098179 -0.57147023 -v -0.56796287 -0.78173382 0.25750808 -v 0.00000000 -0.96627614 0.25750808 -v 0.56796287 -0.78173382 0.25750808 -v 0.91898322 -0.29859575 0.25750808 -v 0.91898322 0.29859575 0.25750808 -v 0.56796287 0.78173382 0.25750808 -v -0.00000000 0.96627614 0.25750808 -v -0.56796287 0.78173382 0.25750808 -v -0.91898322 0.29859575 0.25750808 -v -0.91898322 -0.29859575 0.25750808 -v -0.41098179 -0.29859575 0.57147023 -v 0.15698108 -0.48313807 0.57147023 -v 0.50800143 -0.00000000 0.57147023 -v 0.15698107 0.48313807 0.57147023 -v -0.41098179 0.29859575 0.57147023 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 -f 1 17 16 -f 1 16 2 -f 2 3 12 11 -f 2 16 25 -f 2 25 3 -f 3 4 12 -f 3 25 24 -f 3 24 4 -f 4 5 13 12 -f 4 24 23 -f 4 23 5 -f 5 6 13 -f 5 23 22 -f 5 22 6 -f 6 7 14 13 -f 6 22 21 -f 6 21 7 -f 7 8 14 -f 7 21 20 -f 7 20 8 -f 8 9 15 14 -f 8 20 19 -f 8 19 9 -f 9 10 15 -f 9 19 18 -f 9 18 10 -f 10 18 17 -f 11 12 13 14 15 -f 16 17 27 26 -f 16 26 25 -f 17 18 27 -f 18 19 28 27 -f 19 20 28 -f 20 21 29 28 -f 21 22 29 -f 22 23 30 29 -f 23 24 30 -f 24 25 26 30 -f 26 27 28 29 30 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n46R.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n46R.obj deleted file mode 100644 index ce2cc058..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n46R.obj +++ /dev/null @@ -1,72 +0,0 @@ -v -0.29859575 -0.91898322 -0.25750808 -v -0.78173382 -0.56796287 -0.25750808 -v -0.96627614 0.00000000 -0.25750808 -v -0.78173382 0.56796287 -0.25750808 -v -0.29859575 0.91898322 -0.25750808 -v 0.29859575 0.91898322 -0.25750808 -v 0.78173382 0.56796287 -0.25750808 -v 0.96627614 0.00000000 -0.25750808 -v 0.78173382 -0.56796287 -0.25750808 -v 0.29859575 -0.91898322 -0.25750808 -v -0.29859575 -0.41098179 -0.57147023 -v -0.48313807 0.15698108 -0.57147023 -v 0.00000000 0.50800143 -0.57147023 -v 0.48313807 0.15698108 -0.57147023 -v 0.29859575 -0.41098179 -0.57147023 -v -0.56796287 -0.78173382 0.25750808 -v 0.00000000 -0.96627614 0.25750808 -v 0.56796287 -0.78173382 0.25750808 -v 0.91898322 -0.29859575 0.25750808 -v 0.91898322 0.29859575 0.25750808 -v 0.56796286 0.78173382 0.25750808 -v -0.00000000 0.96627614 0.25750808 -v -0.56796287 0.78173382 0.25750808 -v -0.91898322 0.29859575 0.25750808 -v -0.91898322 -0.29859575 0.25750808 -v -0.15698107 -0.48313807 0.57147023 -v 0.41098179 -0.29859575 0.57147023 -v 0.41098179 0.29859575 0.57147023 -v -0.15698108 0.48313807 0.57147023 -v -0.50800143 0.00000000 0.57147023 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 -f 1 17 16 -f 1 16 2 -f 2 3 12 11 -f 2 16 25 -f 2 25 3 -f 3 4 12 -f 3 25 24 -f 3 24 4 -f 4 5 13 12 -f 4 24 23 -f 4 23 5 -f 5 6 13 -f 5 23 22 -f 5 22 6 -f 6 7 14 13 -f 6 22 21 -f 6 21 7 -f 7 8 14 -f 7 21 20 -f 7 20 8 -f 8 9 15 14 -f 8 20 19 -f 8 19 9 -f 9 10 15 -f 9 19 18 -f 9 18 10 -f 10 18 17 -f 11 12 13 14 15 -f 16 17 26 -f 16 26 30 25 -f 17 18 27 26 -f 18 19 27 -f 19 20 28 27 -f 20 21 28 -f 21 22 29 28 -f 22 23 29 -f 23 24 30 29 -f 24 25 30 -f 26 27 28 29 30 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n47L.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n47L.obj deleted file mode 100644 index e2fa72f6..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n47L.obj +++ /dev/null @@ -1,82 +0,0 @@ -v -0.28129438 -0.86573510 -0.41397609 -v -0.73643826 -0.53505372 -0.41397609 -v -0.91028775 0.00000000 -0.41397609 -v -0.73643826 0.53505372 -0.41397609 -v -0.28129439 0.86573510 -0.41397609 -v 0.28129438 0.86573510 -0.41397609 -v 0.73643826 0.53505372 -0.41397609 -v 0.91028775 0.00000000 -0.41397609 -v 0.73643826 -0.53505372 -0.41397609 -v 0.28129439 -0.86573510 -0.41397609 -v -0.28129438 -0.38716851 -0.70974651 -v -0.45514388 0.14788521 -0.70974651 -v 0.00000000 0.47856659 -0.70974651 -v 0.45514388 0.14788521 -0.70974651 -v 0.28129439 -0.38716851 -0.70974651 -v -0.53505372 -0.73643826 0.07119878 -v 0.00000000 -0.91028775 0.07119878 -v 0.53505372 -0.73643826 0.07119878 -v 0.86573510 -0.28129439 0.07119878 -v 0.86573510 0.28129438 0.07119877 -v 0.53505371 0.73643826 0.07119877 -v -0.00000000 0.91028775 0.07119877 -v -0.53505372 0.73643826 0.07119877 -v -0.86573510 0.28129439 0.07119878 -v -0.86573510 -0.28129439 0.07119878 -v -0.77433701 0.00000000 0.54976537 -v -0.23928330 -0.73643826 0.54976537 -v 0.62645180 -0.45514388 0.54976537 -v 0.62645180 0.45514388 0.54976537 -v -0.23928330 0.73643826 0.54976537 -v -0.38716851 -0.28129439 0.84553579 -v 0.14788521 -0.45514388 0.84553579 -v 0.47856659 -0.00000000 0.84553579 -v 0.14788521 0.45514388 0.84553579 -v -0.38716851 0.28129439 0.84553579 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 -f 1 17 16 -f 1 16 2 -f 2 3 12 11 -f 2 16 25 -f 2 25 3 -f 3 4 12 -f 3 25 24 -f 3 24 4 -f 4 5 13 12 -f 4 24 23 -f 4 23 5 -f 5 6 13 -f 5 23 22 -f 5 22 6 -f 6 7 14 13 -f 6 22 21 -f 6 21 7 -f 7 8 14 -f 7 21 20 -f 7 20 8 -f 8 9 15 14 -f 8 20 19 -f 8 19 9 -f 9 10 15 -f 9 19 18 -f 9 18 10 -f 10 18 17 -f 11 12 13 14 15 -f 16 17 27 -f 16 27 31 26 25 -f 17 18 28 32 27 -f 18 19 28 -f 19 20 29 33 28 -f 20 21 29 -f 21 22 30 34 29 -f 22 23 30 -f 23 24 26 35 30 -f 24 25 26 -f 26 31 35 -f 27 32 31 -f 28 33 32 -f 29 34 33 -f 30 35 34 -f 31 32 33 34 35 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n47R.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n47R.obj deleted file mode 100644 index 2ab53743..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n47R.obj +++ /dev/null @@ -1,82 +0,0 @@ -v -0.28129438 -0.86573510 -0.41397609 -v -0.73643826 -0.53505372 -0.41397609 -v -0.91028775 0.00000000 -0.41397609 -v -0.73643826 0.53505372 -0.41397609 -v -0.28129439 0.86573510 -0.41397609 -v 0.28129438 0.86573510 -0.41397609 -v 0.73643826 0.53505372 -0.41397609 -v 0.91028775 0.00000000 -0.41397609 -v 0.73643826 -0.53505372 -0.41397609 -v 0.28129439 -0.86573510 -0.41397609 -v -0.28129438 -0.38716851 -0.70974651 -v -0.45514387 0.14788521 -0.70974651 -v 0.00000000 0.47856659 -0.70974651 -v 0.45514388 0.14788521 -0.70974651 -v 0.28129439 -0.38716851 -0.70974651 -v -0.53505372 -0.73643826 0.07119878 -v 0.00000000 -0.91028775 0.07119878 -v 0.53505372 -0.73643826 0.07119878 -v 0.86573510 -0.28129439 0.07119878 -v 0.86573510 0.28129439 0.07119877 -v 0.53505371 0.73643826 0.07119877 -v -0.00000000 0.91028775 0.07119877 -v -0.53505372 0.73643826 0.07119877 -v -0.86573510 0.28129439 0.07119878 -v -0.86573510 -0.28129439 0.07119878 -v -0.62645180 -0.45514388 0.54976537 -v 0.23928330 -0.73643826 0.54976537 -v 0.77433701 -0.00000000 0.54976537 -v 0.23928329 0.73643826 0.54976537 -v -0.62645180 0.45514388 0.54976537 -v -0.14788521 -0.45514388 0.84553579 -v 0.38716851 -0.28129439 0.84553579 -v 0.38716850 0.28129439 0.84553579 -v -0.14788521 0.45514388 0.84553579 -v -0.47856659 0.00000000 0.84553579 -f 1 2 11 -f 1 11 15 10 -f 1 10 17 -f 1 17 16 -f 1 16 2 -f 2 3 12 11 -f 2 16 25 -f 2 25 3 -f 3 4 12 -f 3 25 24 -f 3 24 4 -f 4 5 13 12 -f 4 24 23 -f 4 23 5 -f 5 6 13 -f 5 23 22 -f 5 22 6 -f 6 7 14 13 -f 6 22 21 -f 6 21 7 -f 7 8 14 -f 7 21 20 -f 7 20 8 -f 8 9 15 14 -f 8 20 19 -f 8 19 9 -f 9 10 15 -f 9 19 18 -f 9 18 10 -f 10 18 17 -f 11 12 13 14 15 -f 16 17 27 31 26 -f 16 26 25 -f 17 18 27 -f 18 19 28 32 27 -f 19 20 28 -f 20 21 29 33 28 -f 21 22 29 -f 22 23 30 34 29 -f 23 24 30 -f 24 25 26 35 30 -f 26 31 35 -f 27 32 31 -f 28 33 32 -f 29 34 33 -f 30 35 34 -f 31 32 33 34 35 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n48L.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n48L.obj deleted file mode 100644 index b2c4ece1..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n48L.obj +++ /dev/null @@ -1,92 +0,0 @@ -v -0.25028317 -0.77029241 -0.21584346 -v -0.65524986 -0.47606689 -0.21584346 -v -0.80993337 0.00000000 -0.21584346 -v -0.65524986 0.47606689 -0.21584346 -v -0.25028318 0.77029241 -0.21584346 -v 0.25028317 0.77029241 -0.21584346 -v 0.65524986 0.47606689 -0.21584346 -v 0.80993337 0.00000000 -0.21584346 -v 0.65524986 -0.47606689 -0.21584346 -v 0.25028318 -0.77029241 -0.21584346 -v 0.00000000 -0.68897047 -0.64165063 -v -0.65524986 -0.21290358 -0.64165063 -v -0.40496668 0.55738882 -0.64165063 -v 0.40496668 0.55738882 -0.64165063 -v 0.65524986 -0.21290358 -0.64165063 -v -0.25028317 -0.34448524 -0.90481393 -v -0.40496668 0.13158165 -0.90481393 -v 0.00000000 0.42580717 -0.90481393 -v 0.40496668 0.13158165 -0.90481393 -v 0.25028318 -0.34448524 -0.90481393 -v -0.47606689 -0.65524986 0.21584346 -v 0.00000000 -0.80993337 0.21584346 -v 0.47606689 -0.65524986 0.21584346 -v 0.77029241 -0.25028318 0.21584346 -v 0.77029241 0.25028317 0.21584346 -v 0.47606689 0.65524986 0.21584346 -v -0.00000000 0.80993337 0.21584346 -v -0.47606689 0.65524986 0.21584346 -v -0.77029241 0.25028317 0.21584346 -v -0.77029241 -0.25028317 0.21584346 -v -0.68897047 0.00000000 0.64165063 -v -0.21290358 -0.65524986 0.64165063 -v 0.55738882 -0.40496668 0.64165063 -v 0.55738882 0.40496668 0.64165063 -v -0.21290359 0.65524986 0.64165063 -v -0.34448524 -0.25028317 0.90481393 -v 0.13158165 -0.40496668 0.90481393 -v 0.42580717 -0.00000000 0.90481393 -v 0.13158165 0.40496668 0.90481393 -v -0.34448524 0.25028317 0.90481393 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 22 -f 1 22 21 -f 1 21 2 -f 2 3 12 -f 2 21 30 -f 2 30 3 -f 3 4 13 17 12 -f 3 30 29 -f 3 29 4 -f 4 5 13 -f 4 29 28 -f 4 28 5 -f 5 6 14 18 13 -f 5 28 27 -f 5 27 6 -f 6 7 14 -f 6 27 26 -f 6 26 7 -f 7 8 15 19 14 -f 7 26 25 -f 7 25 8 -f 8 9 15 -f 8 25 24 -f 8 24 9 -f 9 10 11 20 15 -f 9 24 23 -f 9 23 10 -f 10 23 22 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 -f 21 22 32 -f 21 32 36 31 30 -f 22 23 33 37 32 -f 23 24 33 -f 24 25 34 38 33 -f 25 26 34 -f 26 27 35 39 34 -f 27 28 35 -f 28 29 31 40 35 -f 29 30 31 -f 31 36 40 -f 32 37 36 -f 33 38 37 -f 34 39 38 -f 35 40 39 -f 36 37 38 39 40 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n48R.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n48R.obj deleted file mode 100644 index 004d8254..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n48R.obj +++ /dev/null @@ -1,92 +0,0 @@ -v -0.25028317 -0.77029241 -0.21584346 -v -0.65524986 -0.47606689 -0.21584346 -v -0.80993337 0.00000000 -0.21584346 -v -0.65524986 0.47606689 -0.21584346 -v -0.25028317 0.77029241 -0.21584346 -v 0.25028317 0.77029241 -0.21584346 -v 0.65524986 0.47606689 -0.21584346 -v 0.80993337 0.00000000 -0.21584346 -v 0.65524986 -0.47606689 -0.21584346 -v 0.25028318 -0.77029241 -0.21584346 -v 0.00000000 -0.68897047 -0.64165063 -v -0.65524986 -0.21290358 -0.64165063 -v -0.40496668 0.55738882 -0.64165063 -v 0.40496668 0.55738882 -0.64165063 -v 0.65524986 -0.21290359 -0.64165063 -v -0.25028317 -0.34448524 -0.90481393 -v -0.40496668 0.13158165 -0.90481393 -v 0.00000000 0.42580717 -0.90481393 -v 0.40496668 0.13158165 -0.90481393 -v 0.25028318 -0.34448524 -0.90481393 -v -0.47606689 -0.65524986 0.21584346 -v 0.00000000 -0.80993337 0.21584346 -v 0.47606689 -0.65524986 0.21584346 -v 0.77029241 -0.25028317 0.21584346 -v 0.77029240 0.25028317 0.21584346 -v 0.47606689 0.65524986 0.21584346 -v -0.00000000 0.80993337 0.21584346 -v -0.47606689 0.65524986 0.21584346 -v -0.77029241 0.25028317 0.21584346 -v -0.77029241 -0.25028317 0.21584346 -v -0.55738882 -0.40496668 0.64165063 -v 0.21290359 -0.65524986 0.64165063 -v 0.68897047 -0.00000000 0.64165063 -v 0.21290358 0.65524986 0.64165063 -v -0.55738882 0.40496668 0.64165063 -v -0.13158165 -0.40496668 0.90481393 -v 0.34448524 -0.25028317 0.90481393 -v 0.34448524 0.25028317 0.90481393 -v -0.13158165 0.40496668 0.90481393 -v -0.42580717 0.00000000 0.90481393 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 22 -f 1 22 21 -f 1 21 2 -f 2 3 12 -f 2 21 30 -f 2 30 3 -f 3 4 13 17 12 -f 3 30 29 -f 3 29 4 -f 4 5 13 -f 4 29 28 -f 4 28 5 -f 5 6 14 18 13 -f 5 28 27 -f 5 27 6 -f 6 7 14 -f 6 27 26 -f 6 26 7 -f 7 8 15 19 14 -f 7 26 25 -f 7 25 8 -f 8 9 15 -f 8 25 24 -f 8 24 9 -f 9 10 11 20 15 -f 9 24 23 -f 9 23 10 -f 10 23 22 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 -f 21 22 32 36 31 -f 21 31 30 -f 22 23 32 -f 23 24 33 37 32 -f 24 25 33 -f 25 26 34 38 33 -f 26 27 34 -f 27 28 35 39 34 -f 28 29 35 -f 29 30 31 40 35 -f 31 36 40 -f 32 37 36 -f 33 38 37 -f 34 39 38 -f 35 40 39 -f 36 37 38 39 40 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n49.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n49.obj deleted file mode 100644 index 6cedb9f8..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n49.obj +++ /dev/null @@ -1,15 +0,0 @@ -v -0.43001399 -0.41061161 0.57060708 -v 0.14059309 0.57770884 0.57060708 -v 0.71120016 -0.41061161 0.57060708 -v -0.43001399 -0.41061161 -0.57060708 -v 0.14059309 0.57770884 -0.57060708 -v 0.71120016 -0.41061161 -0.57060708 -v -0.84355854 0.48702875 -0.00000000 -f 1 4 6 3 -f 1 3 2 -f 1 2 7 -f 1 7 4 -f 2 3 6 5 -f 2 5 7 -f 4 5 6 -f 4 7 5 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n50.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n50.obj deleted file mode 100644 index f7c4ccbc..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n50.obj +++ /dev/null @@ -1,19 +0,0 @@ -v -0.53205720 -0.43963661 0.53205720 -v 0.00000000 0.48191351 0.53205720 -v 0.53205720 -0.43963661 0.53205720 -v -0.53205720 -0.43963661 -0.53205720 -v 0.00000000 0.48191351 -0.53205720 -v 0.53205720 -0.43963661 -0.53205720 -v -0.91766294 0.39735971 -0.00000000 -v 0.91766294 0.39735971 -0.00000000 -f 1 4 6 3 -f 1 3 2 -f 1 2 7 -f 1 7 4 -f 2 5 7 -f 2 3 8 -f 2 8 5 -f 3 6 8 -f 4 5 6 -f 4 7 5 -f 5 8 6 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n51.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n51.obj deleted file mode 100644 index 86483d6d..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n51.obj +++ /dev/null @@ -1,23 +0,0 @@ -v -0.50211798 -0.28989795 0.50211798 -v 0.00000000 0.57979590 0.50211798 -v 0.50211798 -0.28989795 0.50211798 -v -0.50211798 -0.28989795 -0.50211798 -v 0.00000000 0.57979590 -0.50211798 -v 0.50211798 -0.28989795 -0.50211798 -v -0.86602540 0.50000000 -0.00000000 -v 0.86602540 0.50000000 -0.00000000 -v -0.00000000 -1.00000000 -0.00000000 -f 1 3 2 -f 1 2 7 -f 1 7 4 -f 1 4 9 -f 1 9 3 -f 2 5 7 -f 2 3 8 -f 2 8 5 -f 3 6 8 -f 3 9 6 -f 4 7 5 -f 4 5 6 -f 4 6 9 -f 5 8 6 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n52.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n52.obj deleted file mode 100644 index 8e67dd58..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n52.obj +++ /dev/null @@ -1,21 +0,0 @@ -v -0.29907545 -0.51164204 0.39418110 -v -0.54269277 0.23813497 0.39418110 -v 0.09510565 0.70152264 0.39418110 -v 0.73290407 0.23813497 0.39418110 -v 0.48928675 -0.51164204 0.39418110 -v -0.29907545 -0.51164204 -0.39418110 -v -0.54269277 0.23813497 -0.39418110 -v 0.09510565 0.70152264 -0.39418110 -v 0.73290407 0.23813497 -0.39418110 -v 0.48928675 -0.51164204 -0.39418110 -v -0.95105652 -0.30901699 -0.00000000 -f 1 6 10 5 -f 1 5 4 3 2 -f 1 2 11 -f 1 11 6 -f 2 3 8 7 -f 2 7 11 -f 3 4 9 8 -f 4 5 10 9 -f 6 7 8 9 10 -f 6 11 7 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n53.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n53.obj deleted file mode 100644 index cd266e99..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n53.obj +++ /dev/null @@ -1,25 +0,0 @@ -v -0.33296747 -0.54286675 0.36369162 -v -0.55774125 0.14891583 0.36369162 -v 0.03072416 0.57646097 0.36369162 -v 0.61918957 0.14891583 0.36369162 -v 0.39441578 -0.54286675 0.36369162 -v -0.33296747 -0.54286675 -0.36369162 -v -0.55774125 0.14891583 -0.36369162 -v 0.03072416 0.57646097 -0.36369162 -v 0.61918957 0.14891583 -0.36369162 -v 0.39441578 -0.54286675 -0.36369162 -v -0.93451851 -0.35591453 -0.00000000 -v 0.62727693 0.77879628 -0.00000000 -f 1 6 10 5 -f 1 5 4 3 2 -f 1 2 11 -f 1 11 6 -f 2 3 8 7 -f 2 7 11 -f 3 4 12 -f 3 12 8 -f 4 5 10 9 -f 4 9 12 -f 6 7 8 9 10 -f 6 11 7 -f 8 12 9 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n54.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n54.obj deleted file mode 100644 index 4377b1ff..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n54.obj +++ /dev/null @@ -1,24 +0,0 @@ -v -0.27215490 -0.55471945 0.34432368 -v -0.61647858 0.04166667 0.34432368 -v -0.27215490 0.63805278 0.34432368 -v 0.41649247 0.63805278 0.34432368 -v 0.76081615 0.04166667 0.34432368 -v 0.41649247 -0.55471945 0.34432368 -v -0.27215490 -0.55471945 -0.34432368 -v -0.61647858 0.04166667 -0.34432368 -v -0.27215490 0.63805278 -0.34432368 -v 0.41649247 0.63805278 -0.34432368 -v 0.76081615 0.04166667 -0.34432368 -v 0.41649247 -0.55471945 -0.34432368 -v -0.86602540 -0.50000000 -0.00000000 -f 1 7 12 6 -f 1 6 5 4 3 2 -f 1 2 13 -f 1 13 7 -f 2 3 9 8 -f 2 8 13 -f 3 4 10 9 -f 4 5 11 10 -f 5 6 12 11 -f 7 8 9 10 11 12 -f 7 13 8 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n55.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n55.obj deleted file mode 100644 index cfde17fe..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n55.obj +++ /dev/null @@ -1,28 +0,0 @@ -v -0.31783725 -0.55051026 0.31783725 -v -0.63567449 0.00000000 0.31783725 -v -0.31783725 0.55051026 0.31783725 -v 0.31783725 0.55051026 0.31783725 -v 0.63567449 -0.00000000 0.31783725 -v 0.31783725 -0.55051026 0.31783725 -v -0.31783725 -0.55051026 -0.31783725 -v -0.63567449 0.00000000 -0.31783725 -v -0.31783725 0.55051026 -0.31783725 -v 0.31783725 0.55051026 -0.31783725 -v 0.63567449 -0.00000000 -0.31783725 -v 0.31783725 -0.55051026 -0.31783725 -v -0.86602540 -0.50000000 -0.00000000 -v 0.86602540 0.50000000 0.00000000 -f 1 7 12 6 -f 1 6 5 4 3 2 -f 1 2 13 -f 1 13 7 -f 2 3 9 8 -f 2 8 13 -f 3 4 10 9 -f 4 5 14 -f 4 14 10 -f 5 6 12 11 -f 5 11 14 -f 7 8 9 10 11 12 -f 7 13 8 -f 10 14 11 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n56.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n56.obj deleted file mode 100644 index 7bae7915..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n56.obj +++ /dev/null @@ -1,28 +0,0 @@ -v -0.26491443 -0.60668951 0.32893287 -v -0.59384731 -0.03696106 0.32893287 -v -0.26491443 0.53276739 0.32893287 -v 0.39295131 0.53276739 0.32893287 -v 0.72188419 -0.03696106 0.32893287 -v 0.39295131 -0.60668951 0.32893287 -v -0.26491443 -0.60668951 -0.32893287 -v -0.59384731 -0.03696106 -0.32893287 -v -0.26491443 0.53276739 -0.32893287 -v 0.39295131 0.53276739 -0.32893287 -v 0.72188419 -0.03696106 -0.32893287 -v 0.39295131 -0.60668951 -0.32893287 -v -0.83223972 -0.55441595 -0.00000000 -v 0.06401844 0.99794872 -0.00000000 -f 1 7 12 6 -f 1 6 5 4 3 2 -f 1 2 13 -f 1 13 7 -f 2 3 9 8 -f 2 8 13 -f 3 4 14 -f 3 14 9 -f 4 5 11 10 -f 4 10 14 -f 5 6 12 11 -f 7 8 9 10 11 12 -f 7 13 8 -f 9 14 10 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n57.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n57.obj deleted file mode 100644 index 036ae2e3..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n57.obj +++ /dev/null @@ -1,32 +0,0 @@ -v -0.31783725 -0.55051026 0.31783725 -v -0.63567449 0.00000000 0.31783725 -v -0.31783725 0.55051026 0.31783725 -v 0.31783725 0.55051026 0.31783725 -v 0.63567449 -0.00000000 0.31783725 -v 0.31783725 -0.55051026 0.31783725 -v -0.31783725 -0.55051026 -0.31783725 -v -0.63567449 0.00000000 -0.31783725 -v -0.31783725 0.55051026 -0.31783725 -v 0.31783725 0.55051026 -0.31783725 -v 0.63567449 -0.00000000 -0.31783725 -v 0.31783725 -0.55051026 -0.31783725 -v -0.86602540 -0.50000000 -0.00000000 -v 0.00000000 1.00000000 -0.00000000 -v 0.86602540 -0.50000000 -0.00000000 -f 1 7 12 6 -f 1 6 5 4 3 2 -f 1 2 13 -f 1 13 7 -f 2 3 9 8 -f 2 8 13 -f 3 4 14 -f 3 14 9 -f 4 5 11 10 -f 4 10 14 -f 5 6 15 -f 5 15 11 -f 6 12 15 -f 7 8 9 10 11 12 -f 7 13 8 -f 9 14 10 -f 11 15 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n58.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n58.obj deleted file mode 100644 index a7350853..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n58.obj +++ /dev/null @@ -1,37 +0,0 @@ -v -0.32026891 -0.44081234 0.66324934 -v 0.32026891 -0.44081234 0.66324934 -v 0.51820598 -0.71324934 0.11837533 -v 0.00000000 -0.88162467 -0.21837533 -v -0.51820598 -0.71324934 0.11837533 -v -0.51820598 0.16837533 0.66324934 -v 0.51820598 0.16837533 0.66324934 -v 0.83847489 -0.27243701 -0.21837533 -v -0.00000000 -0.54487401 -0.76324934 -v -0.83847489 -0.27243701 -0.21837533 -v -0.83847489 0.27243701 0.11837533 -v -0.00000000 0.54487401 0.66324934 -v 0.83847489 0.27243701 0.11837533 -v 0.51820598 -0.16837533 -0.76324934 -v -0.51820598 -0.16837533 -0.76324934 -v -0.51820598 0.71324934 -0.21837533 -v 0.00000000 0.88162467 0.11837533 -v 0.51820598 0.71324934 -0.21837533 -v 0.32026891 0.44081234 -0.76324934 -v -0.32026891 0.44081234 -0.76324934 -v 0.00000000 0.00000000 1.00000000 -f 1 6 11 10 5 -f 1 5 4 3 2 -f 1 2 21 -f 1 21 6 -f 2 3 8 13 7 -f 2 7 21 -f 3 4 9 14 8 -f 4 5 10 15 9 -f 6 12 17 16 11 -f 6 21 12 -f 7 13 18 17 12 -f 7 12 21 -f 8 14 19 18 13 -f 9 15 20 19 14 -f 10 11 16 20 15 -f 16 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n59.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n59.obj deleted file mode 100644 index 9981d0b4..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n59.obj +++ /dev/null @@ -1,42 +0,0 @@ -v -0.30501801 -0.41982127 0.67928509 -v 0.30501801 -0.41982127 0.67928509 -v 0.49352950 -0.67928509 0.16035746 -v 0.00000000 -0.83964254 -0.16035746 -v -0.49352950 -0.67928509 0.16035746 -v -0.49352950 0.16035746 0.67928509 -v 0.49352950 0.16035746 0.67928509 -v 0.79854751 -0.25946382 -0.16035746 -v -0.00000000 -0.51892763 -0.67928509 -v -0.79854751 -0.25946382 -0.16035746 -v -0.79854751 0.25946382 0.16035746 -v -0.00000000 0.51892763 0.67928509 -v 0.79854751 0.25946382 0.16035746 -v 0.49352950 -0.16035746 -0.67928509 -v -0.49352950 -0.16035746 -0.67928509 -v -0.49352950 0.67928509 -0.16035746 -v 0.00000000 0.83964254 0.16035746 -v 0.49352950 0.67928509 -0.16035746 -v 0.30501801 0.41982127 -0.67928509 -v -0.30501801 0.41982127 -0.67928509 -v 0.00000000 0.00000000 1.00000000 -v -0.00000000 0.00000000 -1.00000000 -f 1 6 11 10 5 -f 1 5 4 3 2 -f 1 2 21 -f 1 21 6 -f 2 3 8 13 7 -f 2 7 21 -f 3 4 9 14 8 -f 4 5 10 15 9 -f 6 12 17 16 11 -f 6 21 12 -f 7 13 18 17 12 -f 7 12 21 -f 8 14 19 18 13 -f 9 15 22 -f 9 22 14 -f 10 11 16 20 15 -f 14 22 19 -f 15 20 22 -f 16 17 18 19 20 -f 19 22 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n60.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n60.obj deleted file mode 100644 index 27819bd4..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n60.obj +++ /dev/null @@ -1,42 +0,0 @@ -v -0.35223599 -0.44314381 0.67043614 -v 0.27297981 -0.44314381 0.67043614 -v 0.46618212 -0.70906397 0.13859581 -v -0.03962809 -0.87341167 -0.19009959 -v -0.54543830 -0.70906397 0.13859581 -v -0.54543830 0.15147175 0.67043614 -v 0.46618212 0.15147175 0.67043614 -v 0.77879002 -0.27879611 -0.19009959 -v -0.03962809 -0.54471627 -0.72193992 -v -0.85804620 -0.27879611 -0.19009959 -v -0.85804620 0.25304422 0.13859581 -v -0.03962809 0.51896438 0.67043614 -v 0.77879002 0.25304422 0.13859581 -v 0.46618212 -0.17722365 -0.72193992 -v -0.54543830 -0.17722365 -0.72193992 -v -0.54543830 0.68331208 -0.19009959 -v -0.03962809 0.84765978 0.13859581 -v 0.46618212 0.68331208 -0.19009959 -v 0.27297981 0.41739192 -0.72193992 -v -0.35223599 0.41739192 -0.72193992 -v -0.03962809 -0.01287595 0.99913154 -v 0.83218983 0.27039487 -0.48409369 -f 1 6 11 10 5 -f 1 5 4 3 2 -f 1 2 21 -f 1 21 6 -f 2 3 8 13 7 -f 2 7 21 -f 3 4 9 14 8 -f 4 5 10 15 9 -f 6 12 17 16 11 -f 6 21 12 -f 7 13 18 17 12 -f 7 12 21 -f 8 14 22 -f 8 22 13 -f 9 15 20 19 14 -f 10 11 16 20 15 -f 13 22 18 -f 14 19 22 -f 16 17 18 19 20 -f 18 22 19 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n61.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n61.obj deleted file mode 100644 index 9668c496..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n61.obj +++ /dev/null @@ -1,47 +0,0 @@ -v -0.32052320 -0.40210626 0.67760869 -v 0.29214730 -0.40210626 0.67760869 -v 0.48147290 -0.66269059 0.15644003 -v -0.01418795 -0.82374057 -0.16565992 -v -0.50984880 -0.66269059 0.15644003 -v -0.50984880 0.18057801 0.67760869 -v 0.48147290 0.18057801 0.67760869 -v 0.78780815 -0.24105629 -0.16565992 -v -0.01418795 -0.50164062 -0.68682858 -v -0.81618406 -0.24105629 -0.16565992 -v -0.81618406 0.28011237 0.15644003 -v -0.01418795 0.54069670 0.67760869 -v 0.78780815 0.28011237 0.15644003 -v 0.48147290 -0.14152193 -0.68682858 -v -0.50984880 -0.14152193 -0.68682858 -v -0.50984880 0.70174667 -0.16565992 -v -0.01418795 0.86279665 0.15644003 -v 0.48147290 0.70174667 -0.16565992 -v 0.29214730 0.44116234 -0.68682858 -v -0.32052320 0.44116234 -0.68682858 -v -0.01418795 0.01952804 0.99970864 -v 0.84013646 0.29711487 -0.45375487 -v -0.54218948 -0.70720371 -0.45375487 -f 1 6 11 10 5 -f 1 5 4 3 2 -f 1 2 21 -f 1 21 6 -f 2 3 8 13 7 -f 2 7 21 -f 3 4 9 14 8 -f 4 5 23 -f 4 23 9 -f 5 10 23 -f 6 12 17 16 11 -f 6 21 12 -f 7 13 18 17 12 -f 7 12 21 -f 8 14 22 -f 8 22 13 -f 9 15 20 19 14 -f 9 23 15 -f 10 11 16 20 15 -f 10 15 23 -f 13 22 18 -f 14 19 22 -f 16 17 18 19 20 -f 18 22 19 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n62.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n62.obj deleted file mode 100644 index 270b879b..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n62.obj +++ /dev/null @@ -1,22 +0,0 @@ -v -0.48194883 -0.71402076 0.32797613 -v 0.00000000 -0.87061543 -0.49196420 -v 0.00000000 -0.05067510 -0.99871519 -v -0.48194883 0.61267056 -0.49196420 -v -0.77980959 0.20270040 0.32797613 -v 0.48194883 -0.71402076 0.32797613 -v 0.77980959 0.20270040 0.32797613 -v 0.48194883 0.61267056 -0.49196420 -v -0.00000000 0.76926523 0.32797613 -v 0.00000000 -0.05067510 0.83472713 -f 1 5 4 3 2 -f 1 2 6 -f 1 6 10 -f 1 10 5 -f 2 3 8 7 6 -f 3 4 8 -f 4 5 9 -f 4 9 8 -f 5 10 9 -f 6 7 10 -f 7 8 9 -f 7 9 10 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n63.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n63.obj deleted file mode 100644 index ee44b2b3..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n63.obj +++ /dev/null @@ -1,17 +0,0 @@ -v -0.50051680 -0.74737722 0.43693274 -v 0.00000000 -0.91000499 -0.41459730 -v -0.00000000 -0.05847495 -0.94087181 -v -0.50051680 0.63042733 -0.41459730 -v -0.80985320 0.20466231 0.43693274 -v 0.50051680 -0.74737722 0.43693274 -v 0.80985320 0.20466231 0.43693274 -v 0.50051680 0.63042733 -0.41459730 -v 0.00000000 0.79305510 0.43693274 -f 1 2 6 -f 1 6 7 9 5 -f 1 5 4 3 2 -f 2 3 8 7 6 -f 3 4 8 -f 4 5 9 -f 4 9 8 -f 7 8 9 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n64.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n64.obj deleted file mode 100644 index f1aadc5c..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n64.obj +++ /dev/null @@ -1,20 +0,0 @@ -v -0.34047064 -0.39925597 0.27637473 -v 0.00000000 -0.50988159 -0.30286852 -v -0.00000000 0.06936166 -0.66086054 -v -0.34047064 0.53797929 -0.30286852 -v -0.55089306 0.24835767 0.27637473 -v 0.34047064 -0.39925597 0.27637473 -v 0.55089306 0.24835767 0.27637473 -v 0.34047064 0.53797929 -0.30286852 -v 0.00000000 0.64860491 0.27637473 -v 0.00000000 -0.98224695 0.18759247 -f 1 6 7 9 5 -f 1 5 4 3 2 -f 1 2 10 -f 1 10 6 -f 2 3 8 7 6 -f 2 6 10 -f 3 4 8 -f 4 5 9 -f 4 9 8 -f 7 8 9 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n65.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n65.obj deleted file mode 100644 index e5e0ba78..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n65.obj +++ /dev/null @@ -1,29 +0,0 @@ -v -0.35007002 -0.41770024 0.49544036 -v -0.70014004 0.18863882 0.49544036 -v -0.35007002 0.79497788 0.49544036 -v 0.35007002 0.79497788 0.49544036 -v 0.70014004 0.18863882 0.49544036 -v 0.35007002 -0.41770024 0.49544036 -v -0.70014004 -0.21558722 -0.07622159 -v 0.00000000 0.99709090 -0.07622159 -v 0.70014004 -0.21558722 -0.07622159 -v -0.35007002 -0.01347420 -0.64788354 -v 0.00000000 0.59286486 -0.64788354 -v 0.35007002 -0.01347420 -0.64788354 -v -0.00000000 -0.88929729 0.11433239 -v -0.35007002 -0.68718427 -0.45732956 -v 0.35007002 -0.68718427 -0.45732956 -f 1 6 5 4 3 2 -f 1 2 7 -f 1 7 14 13 -f 1 13 6 -f 2 3 8 11 10 7 -f 3 4 8 -f 4 5 9 12 11 8 -f 5 6 9 -f 6 13 15 9 -f 7 10 14 -f 9 15 12 -f 10 11 12 -f 10 12 15 14 -f 13 14 15 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n66.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n66.obj deleted file mode 100644 index 8bcd109e..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n66.obj +++ /dev/null @@ -1,50 +0,0 @@ -v -0.15528707 -0.51338206 0.61130639 -v -0.51338206 -0.15528707 0.61130639 -v -0.51338206 0.35113572 0.61130639 -v -0.15528707 0.70923071 0.61130639 -v 0.35113572 0.70923071 0.61130639 -v 0.70923071 0.35113572 0.61130639 -v 0.70923071 -0.15528707 0.61130639 -v 0.35113572 -0.51338206 0.61130639 -v 0.09792433 -0.76659346 0.25321140 -v -0.76659346 0.09792433 0.25321140 -v 0.09792433 0.96244211 0.25321140 -v 0.96244211 0.09792433 0.25321140 -v 0.09792433 -0.76659346 -0.25321140 -v -0.76659346 0.09792433 -0.25321140 -v 0.09792433 0.96244211 -0.25321140 -v 0.96244211 0.09792433 -0.25321140 -v -0.15528707 -0.51338206 -0.61130639 -v -0.51338206 -0.15528707 -0.61130639 -v -0.51338206 0.35113572 -0.61130639 -v -0.15528707 0.70923071 -0.61130639 -v 0.35113572 0.70923071 -0.61130639 -v 0.70923071 0.35113572 -0.61130639 -v 0.70923071 -0.15528707 -0.61130639 -v 0.35113572 -0.51338206 -0.61130639 -v -0.33433456 -0.84075736 0.00000000 -v -0.58754596 -0.58754596 0.35809499 -v -0.84075736 -0.33433456 0.00000000 -v -0.58754596 -0.58754596 -0.35809499 -f 1 9 8 -f 1 8 7 6 5 4 3 2 -f 1 2 26 -f 1 26 25 9 -f 2 3 10 -f 2 10 27 26 -f 3 4 11 15 20 19 14 10 -f 4 5 11 -f 5 6 12 16 22 21 15 11 -f 6 7 12 -f 7 8 9 13 24 23 16 12 -f 9 25 13 -f 10 14 27 -f 13 17 24 -f 13 25 28 17 -f 14 19 18 -f 14 18 28 27 -f 15 21 20 -f 16 23 22 -f 17 18 19 20 21 22 23 24 -f 17 28 18 -f 25 26 27 28 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n67.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n67.obj deleted file mode 100644 index 58572003..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n67.obj +++ /dev/null @@ -1,62 +0,0 @@ -v -0.24502111 -0.59153329 0.59153329 -v -0.59153329 -0.24502111 0.59153329 -v -0.59153329 0.24502111 0.59153329 -v -0.24502111 0.59153329 0.59153329 -v 0.24502111 0.59153329 0.59153329 -v 0.59153329 0.24502111 0.59153329 -v 0.59153329 -0.24502111 0.59153329 -v 0.24502111 -0.59153329 0.59153329 -v 0.00000000 -0.83655440 0.24502111 -v -0.83655441 0.00000000 0.24502111 -v 0.00000000 0.83655440 0.24502111 -v 0.83655441 -0.00000000 0.24502111 -v -0.00000000 -0.83655440 -0.24502111 -v -0.83655441 0.00000000 -0.24502111 -v 0.00000000 0.83655440 -0.24502111 -v 0.83655441 -0.00000000 -0.24502111 -v -0.24502111 -0.59153329 -0.59153329 -v -0.59153329 -0.24502111 -0.59153329 -v -0.59153329 0.24502111 -0.59153329 -v -0.24502111 0.59153329 -0.59153329 -v 0.24502111 0.59153329 -0.59153329 -v 0.59153329 0.24502111 -0.59153329 -v 0.59153329 -0.24502111 -0.59153329 -v 0.24502111 -0.59153329 -0.59153329 -v -0.41827720 -0.90831943 -0.00000000 -v -0.66329831 -0.66329831 0.34651218 -v -0.90831943 -0.41827720 0.00000000 -v -0.66329832 -0.66329831 -0.34651218 -v 0.41827720 0.90831943 -0.00000000 -v 0.66329831 0.66329831 0.34651218 -v 0.90831943 0.41827720 0.00000000 -v 0.66329831 0.66329831 -0.34651218 -f 1 9 8 -f 1 8 7 6 5 4 3 2 -f 1 2 26 -f 1 26 25 9 -f 2 3 10 -f 2 10 27 26 -f 3 4 11 15 20 19 14 10 -f 4 5 11 -f 5 6 30 -f 5 30 29 11 -f 6 7 12 -f 6 12 31 30 -f 7 8 9 13 24 23 16 12 -f 9 25 13 -f 10 14 27 -f 11 29 15 -f 12 16 31 -f 13 17 24 -f 13 25 28 17 -f 14 19 18 -f 14 18 28 27 -f 15 21 20 -f 15 29 32 21 -f 16 23 22 -f 16 22 32 31 -f 17 18 19 20 21 22 23 24 -f 17 28 18 -f 21 32 22 -f 25 26 27 28 -f 29 30 31 32 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n68.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n68.obj deleted file mode 100644 index fbf46178..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n68.obj +++ /dev/null @@ -1,107 +0,0 @@ -v -0.15790394 -0.48597835 0.71307107 -v -0.41339788 -0.30035114 0.71307107 -v -0.51098788 0.00000000 0.71307107 -v -0.41339788 0.30035114 0.71307107 -v -0.15790394 0.48597835 0.71307107 -v 0.15790394 0.48597835 0.71307107 -v 0.41339788 0.30035114 0.71307107 -v 0.51098788 0.00000000 0.71307107 -v 0.41339788 -0.30035114 0.71307107 -v 0.15790394 -0.48597835 0.71307107 -v -0.00000000 -0.70331448 0.54704104 -v -0.00000000 -0.86934451 0.27839881 -v 0.15790394 -0.92065061 0.00975659 -v 0.41339788 -0.83763559 -0.15627344 -v 0.66889182 -0.65200838 -0.15627344 -v 0.82679576 -0.43467225 0.00975659 -v 0.82679576 -0.26864223 0.27839881 -v 0.66889182 -0.21733613 0.54704104 -v -0.15790394 -0.92065061 0.00975659 -v -0.41339788 -0.83763559 -0.15627344 -v -0.66889182 -0.65200838 -0.15627344 -v -0.82679576 -0.43467225 0.00975659 -v -0.82679576 -0.26864223 0.27839881 -v -0.66889182 -0.21733613 0.54704104 -v -0.92438576 -0.13432111 0.00975659 -v -0.92438576 0.13432111 -0.15627344 -v -0.82679576 0.43467225 -0.15627344 -v -0.66889182 0.65200838 0.00975659 -v -0.51098788 0.70331448 0.27839881 -v -0.41339788 0.56899337 0.54704104 -v -0.41339788 0.83763559 0.00975659 -v -0.15790394 0.92065061 -0.15627344 -v 0.15790394 0.92065060 -0.15627344 -v 0.41339788 0.83763559 0.00975659 -v 0.51098788 0.70331448 0.27839881 -v 0.41339788 0.56899337 0.54704104 -v 0.66889182 0.65200838 0.00975659 -v 0.82679576 0.43467225 -0.15627344 -v 0.92438576 0.13432111 -0.15627344 -v 0.92438576 -0.13432111 0.00975659 -v 0.51098788 -0.70331448 -0.42491566 -v 0.41339788 -0.56899337 -0.69355789 -v 0.15790394 -0.48597835 -0.85958792 -v -0.15790394 -0.48597835 -0.85958792 -v -0.41339788 -0.56899337 -0.69355789 -v -0.51098788 -0.70331448 -0.42491566 -v -0.41339788 -0.30035114 -0.85958792 -v -0.51098788 0.00000000 -0.85958792 -v -0.66889182 0.21733613 -0.69355789 -v -0.82679576 0.26864223 -0.42491566 -v -0.41339788 0.30035114 -0.85958792 -v -0.15790394 0.48597835 -0.85958792 -v 0.00000000 0.70331448 -0.69355789 -v 0.00000000 0.86934451 -0.42491566 -v 0.15790394 0.48597835 -0.85958792 -v 0.41339788 0.30035114 -0.85958792 -v 0.66889182 0.21733613 -0.69355789 -v 0.82679576 0.26864223 -0.42491566 -v 0.51098788 -0.00000000 -0.85958792 -v 0.41339788 -0.30035114 -0.85958792 -v -0.15790394 -0.21733613 0.87910109 -v 0.15790394 -0.21733613 0.87910109 -v 0.25549394 0.08301501 0.87910109 -v 0.00000000 0.26864223 0.87910109 -v -0.25549394 0.08301501 0.87910109 -f 1 2 24 23 22 21 20 19 12 11 -f 1 11 10 -f 1 10 62 61 -f 1 61 2 -f 2 3 24 -f 2 61 65 3 -f 3 4 30 29 28 27 26 25 23 24 -f 3 65 4 -f 4 5 30 -f 4 65 64 5 -f 5 6 36 35 34 33 32 31 29 30 -f 5 64 6 -f 6 7 36 -f 6 64 63 7 -f 7 8 18 17 40 39 38 37 35 36 -f 7 63 8 -f 8 9 18 -f 8 63 62 9 -f 9 10 11 12 13 14 15 16 17 18 -f 9 62 10 -f 12 19 13 -f 13 19 20 46 45 44 43 42 41 14 -f 14 41 15 -f 15 41 42 60 59 57 58 39 40 16 -f 16 40 17 -f 20 21 46 -f 21 22 25 26 50 49 48 47 45 46 -f 22 23 25 -f 26 27 50 -f 27 28 31 32 54 53 52 51 49 50 -f 28 29 31 -f 32 33 54 -f 33 34 37 38 58 57 56 55 53 54 -f 34 35 37 -f 38 39 58 -f 42 43 60 -f 43 44 47 48 51 52 55 56 59 60 -f 44 45 47 -f 48 49 51 -f 52 53 55 -f 56 57 59 -f 61 62 63 64 65 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n69.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n69.obj deleted file mode 100644 index 2e11a375..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n69.obj +++ /dev/null @@ -1,122 +0,0 @@ -v -0.15957569 -0.49112347 0.79465447 -v -0.41777458 -0.30353100 0.79465447 -v -0.51639778 0.00000000 0.79465447 -v -0.41777458 0.30353100 0.79465447 -v -0.15957569 0.49112347 0.79465447 -v 0.15957569 0.49112347 0.79465447 -v 0.41777458 0.30353100 0.79465447 -v 0.51639778 0.00000000 0.79465447 -v 0.41777458 -0.30353100 0.79465447 -v 0.15957569 -0.49112347 0.79465447 -v -0.00000000 -0.71076057 0.62686666 -v -0.00000000 -0.87854838 0.35538028 -v 0.15957569 -0.93039766 0.08389390 -v 0.41777458 -0.84650376 -0.08389390 -v 0.67597347 -0.65891128 -0.08389390 -v 0.83554916 -0.43927419 0.08389390 -v 0.83554916 -0.27148638 0.35538028 -v 0.67597347 -0.21963709 0.62686666 -v -0.15957569 -0.93039766 0.08389390 -v -0.41777458 -0.84650376 -0.08389390 -v -0.67597347 -0.65891128 -0.08389390 -v -0.83554916 -0.43927419 0.08389391 -v -0.83554916 -0.27148638 0.35538028 -v -0.67597347 -0.21963709 0.62686666 -v -0.93417236 -0.13574319 0.08389390 -v -0.93417236 0.13574319 -0.08389390 -v -0.83554916 0.43927419 -0.08389390 -v -0.67597347 0.65891128 0.08389390 -v -0.51639778 0.71076057 0.35538028 -v -0.41777458 0.57501738 0.62686666 -v -0.41777458 0.84650376 0.08389390 -v -0.15957569 0.93039766 -0.08389390 -v 0.15957569 0.93039766 -0.08389390 -v 0.41777458 0.84650376 0.08389390 -v 0.51639778 0.71076057 0.35538028 -v 0.41777458 0.57501738 0.62686666 -v 0.67597347 0.65891128 0.08389390 -v 0.83554916 0.43927419 -0.08389390 -v 0.93417236 0.13574319 -0.08389390 -v 0.93417236 -0.13574319 0.08389390 -v 0.51639778 -0.71076057 -0.35538028 -v 0.41777458 -0.57501738 -0.62686666 -v 0.15957569 -0.49112347 -0.79465447 -v -0.15957569 -0.49112347 -0.79465447 -v -0.41777458 -0.57501738 -0.62686666 -v -0.51639778 -0.71076057 -0.35538028 -v -0.41777458 -0.30353100 -0.79465447 -v -0.51639778 0.00000000 -0.79465447 -v -0.67597347 0.21963709 -0.62686666 -v -0.83554916 0.27148638 -0.35538028 -v -0.41777458 0.30353100 -0.79465447 -v -0.15957569 0.49112347 -0.79465447 -v -0.00000000 0.71076057 -0.62686666 -v -0.00000000 0.87854838 -0.35538028 -v 0.15957569 0.49112347 -0.79465447 -v 0.41777458 0.30353100 -0.79465447 -v 0.67597347 0.21963709 -0.62686666 -v 0.83554916 0.27148638 -0.35538028 -v 0.51639778 -0.00000000 -0.79465447 -v 0.41777458 -0.30353100 -0.79465447 -v -0.15957569 -0.21963709 0.96244228 -v 0.15957569 -0.21963709 0.96244228 -v 0.25819889 0.08389390 0.96244228 -v -0.00000000 0.27148638 0.96244228 -v -0.25819889 0.08389390 0.96244228 -v -0.00000000 -0.27148638 -0.96244228 -v -0.25819889 -0.08389390 -0.96244228 -v -0.15957569 0.21963709 -0.96244228 -v 0.15957569 0.21963709 -0.96244228 -v 0.25819889 -0.08389390 -0.96244228 -f 1 2 24 23 22 21 20 19 12 11 -f 1 11 10 -f 1 10 62 61 -f 1 61 2 -f 2 3 24 -f 2 61 65 3 -f 3 4 30 29 28 27 26 25 23 24 -f 3 65 4 -f 4 5 30 -f 4 65 64 5 -f 5 6 36 35 34 33 32 31 29 30 -f 5 64 6 -f 6 7 36 -f 6 64 63 7 -f 7 8 18 17 40 39 38 37 35 36 -f 7 63 8 -f 8 9 18 -f 8 63 62 9 -f 9 10 11 12 13 14 15 16 17 18 -f 9 62 10 -f 12 19 13 -f 13 19 20 46 45 44 43 42 41 14 -f 14 41 15 -f 15 41 42 60 59 57 58 39 40 16 -f 16 40 17 -f 20 21 46 -f 21 22 25 26 50 49 48 47 45 46 -f 22 23 25 -f 26 27 50 -f 27 28 31 32 54 53 52 51 49 50 -f 28 29 31 -f 32 33 54 -f 33 34 37 38 58 57 56 55 53 54 -f 34 35 37 -f 38 39 58 -f 42 43 60 -f 43 44 66 -f 43 66 70 60 -f 44 45 47 -f 44 47 67 66 -f 47 48 67 -f 48 49 51 -f 48 51 68 67 -f 51 52 68 -f 52 53 55 -f 52 55 69 68 -f 55 56 69 -f 56 57 59 -f 56 59 70 69 -f 59 60 70 -f 61 62 63 64 65 -f 66 67 68 69 70 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n70.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n70.obj deleted file mode 100644 index 62c1da41..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n70.obj +++ /dev/null @@ -1,122 +0,0 @@ -v -0.21398275 -0.46330675 0.74252390 -v -0.46736036 -0.27921715 0.74252390 -v -0.56414199 0.01864609 0.74252390 -v -0.46736036 0.31650933 0.74252390 -v -0.21398275 0.50059894 0.74252390 -v 0.09920920 0.50059894 0.74252390 -v 0.35258680 0.31650933 0.74252390 -v 0.44936843 0.01864609 0.74252390 -v 0.35258680 -0.27921715 0.74252390 -v 0.09920920 -0.46330675 0.74252390 -v -0.05738678 -0.67884262 0.57786915 -v -0.05738678 -0.84349737 0.31145217 -v 0.09920920 -0.89437848 0.04503519 -v 0.35258680 -0.81205111 -0.11961956 -v 0.60596441 -0.62796150 -0.11961956 -v 0.76256038 -0.41242564 0.04503519 -v 0.76256038 -0.24777089 0.31145217 -v 0.60596441 -0.19688977 0.57786915 -v -0.21398275 -0.89437848 0.04503519 -v -0.46736036 -0.81205111 -0.11961956 -v -0.72073796 -0.62796150 -0.11961956 -v -0.87733393 -0.41242564 0.04503519 -v -0.87733393 -0.24777089 0.31145217 -v -0.72073796 -0.19688977 0.57786915 -v -0.97411557 -0.11456240 0.04503519 -v -0.97411557 0.15185459 -0.11961956 -v -0.87733393 0.44971782 -0.11961956 -v -0.72073796 0.66525369 0.04503519 -v -0.56414199 0.71613481 0.31145217 -v -0.46736036 0.58292632 0.57786915 -v -0.46736036 0.84934330 0.04503519 -v -0.21398275 0.93167067 -0.11961956 -v 0.09920920 0.93167067 -0.11961956 -v 0.35258680 0.84934330 0.04503519 -v 0.44936843 0.71613481 0.31145217 -v 0.35258680 0.58292632 0.57786915 -v 0.60596441 0.66525369 0.04503519 -v 0.76256038 0.44971782 -0.11961956 -v 0.85934201 0.15185458 -0.11961956 -v 0.85934201 -0.11456240 0.04503519 -v 0.44936843 -0.67884262 -0.38603654 -v 0.35258680 -0.54563413 -0.65245352 -v 0.09920920 -0.46330675 -0.81710827 -v -0.21398275 -0.46330675 -0.81710827 -v -0.46736036 -0.54563413 -0.65245352 -v -0.56414199 -0.67884262 -0.38603654 -v -0.46736035 -0.27921715 -0.81710827 -v -0.56414199 0.01864609 -0.81710827 -v -0.72073796 0.23418196 -0.65245352 -v -0.87733393 0.28506308 -0.38603654 -v -0.46736035 0.31650933 -0.81710827 -v -0.21398275 0.50059894 -0.81710827 -v -0.05738678 0.71613481 -0.65245352 -v -0.05738678 0.88078955 -0.38603654 -v 0.09920919 0.50059894 -0.81710827 -v 0.35258680 0.31650933 -0.81710827 -v 0.60596441 0.23418196 -0.65245353 -v 0.76256038 0.28506307 -0.38603654 -v 0.44936843 0.01864609 -0.81710827 -v 0.35258680 -0.27921715 -0.81710827 -v -0.21398275 -0.19688977 0.90717865 -v 0.09920920 -0.19688977 0.90717865 -v 0.19599083 0.10097347 0.90717865 -v -0.05738678 0.28506308 0.90717865 -v -0.31076438 0.10097347 0.90717865 -v 0.78931016 -0.42111717 -0.26689125 -v 0.63271419 -0.47199828 -0.53330823 -v 0.63271419 -0.20558130 -0.69796298 -v 0.78931016 0.00995456 -0.53330823 -v 0.88609180 -0.12325393 -0.26689125 -f 1 2 24 23 22 21 20 19 12 11 -f 1 11 10 -f 1 10 62 61 -f 1 61 2 -f 2 3 24 -f 2 61 65 3 -f 3 4 30 29 28 27 26 25 23 24 -f 3 65 4 -f 4 5 30 -f 4 65 64 5 -f 5 6 36 35 34 33 32 31 29 30 -f 5 64 6 -f 6 7 36 -f 6 64 63 7 -f 7 8 18 17 40 39 38 37 35 36 -f 7 63 8 -f 8 9 18 -f 8 63 62 9 -f 9 10 11 12 13 14 15 16 17 18 -f 9 62 10 -f 12 19 13 -f 13 19 20 46 45 44 43 42 41 14 -f 14 41 15 -f 15 41 67 66 -f 15 66 16 -f 16 40 17 -f 16 66 70 40 -f 20 21 46 -f 21 22 25 26 50 49 48 47 45 46 -f 22 23 25 -f 26 27 50 -f 27 28 31 32 54 53 52 51 49 50 -f 28 29 31 -f 32 33 54 -f 33 34 37 38 58 57 56 55 53 54 -f 34 35 37 -f 38 39 58 -f 39 40 70 -f 39 70 69 58 -f 41 42 67 -f 42 43 60 -f 42 60 68 67 -f 43 44 47 48 51 52 55 56 59 60 -f 44 45 47 -f 48 49 51 -f 52 53 55 -f 56 57 59 -f 57 58 69 -f 57 69 68 59 -f 59 68 60 -f 61 62 63 64 65 -f 66 67 68 69 70 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n71.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n71.obj deleted file mode 100644 index 331009af..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n71.obj +++ /dev/null @@ -1,137 +0,0 @@ -v -0.17974856 -0.51787354 0.78493349 -v -0.43698164 -0.33098277 0.78493349 -v -0.53523593 -0.02858715 0.78493349 -v -0.43698164 0.27380847 0.78493349 -v -0.17974856 0.46069924 0.78493349 -v 0.13820900 0.46069924 0.78493349 -v 0.39544208 0.27380847 0.78493349 -v 0.49369637 -0.02858715 0.78493349 -v 0.39544208 -0.33098277 0.78493349 -v 0.13820900 -0.51787354 0.78493349 -v -0.02076978 -0.73668906 0.61777331 -v -0.02076978 -0.90384925 0.34730244 -v 0.13820900 -0.95550458 0.07683158 -v 0.39544208 -0.87192449 -0.09032860 -v 0.65267515 -0.68503372 -0.09032860 -v 0.81165394 -0.46621820 0.07683158 -v 0.81165394 -0.29905801 0.34730244 -v 0.65267515 -0.24740267 0.61777331 -v -0.17974856 -0.95550458 0.07683158 -v -0.43698164 -0.87192449 -0.09032860 -v -0.69421472 -0.68503372 -0.09032860 -v -0.85319350 -0.46621820 0.07683158 -v -0.85319350 -0.29905801 0.34730244 -v -0.69421472 -0.24740267 0.61777331 -v -0.95144779 -0.16382258 0.07683158 -v -0.95144779 0.10664828 -0.09032860 -v -0.85319350 0.40904390 -0.09032860 -v -0.69421472 0.62785942 0.07683158 -v -0.53523593 0.67951476 0.34730244 -v -0.43698164 0.54427933 0.61777331 -v -0.43698164 0.81475019 0.07683158 -v -0.17974856 0.89833028 -0.09032860 -v 0.13820900 0.89833028 -0.09032860 -v 0.39544208 0.81475019 0.07683158 -v 0.49369637 0.67951476 0.34730244 -v 0.39544208 0.54427933 0.61777331 -v 0.65267515 0.62785942 0.07683158 -v 0.81165394 0.40904390 -0.09032860 -v 0.90990823 0.10664828 -0.09032860 -v 0.90990823 -0.16382258 0.07683158 -v 0.49369637 -0.73668906 -0.36079947 -v 0.39544208 -0.60145363 -0.63127033 -v 0.13820900 -0.51787354 -0.79843051 -v -0.17974856 -0.51787354 -0.79843051 -v -0.43698164 -0.60145363 -0.63127033 -v -0.53523593 -0.73668906 -0.36079947 -v -0.43698164 -0.33098277 -0.79843051 -v -0.53523593 -0.02858715 -0.79843051 -v -0.69421472 0.19022837 -0.63127033 -v -0.85319350 0.24188371 -0.36079947 -v -0.43698164 0.27380847 -0.79843051 -v -0.17974856 0.46069924 -0.79843051 -v -0.02076978 0.67951476 -0.63127033 -v -0.02076978 0.84667494 -0.36079947 -v 0.13820900 0.46069923 -0.79843051 -v 0.39544208 0.27380847 -0.79843051 -v 0.65267515 0.19022837 -0.63127033 -v 0.81165394 0.24188371 -0.36079947 -v 0.49369637 -0.02858715 -0.79843051 -v 0.39544208 -0.33098277 -0.79843051 -v -0.17974856 -0.24740267 0.95209368 -v 0.13820900 -0.24740267 0.95209368 -v 0.23646329 0.05499294 0.95209368 -v -0.02076978 0.24188371 0.95209368 -v -0.27800286 0.05499294 0.95209368 -v 0.83881076 -0.47504198 -0.23984122 -v 0.67983197 -0.52669732 -0.51031208 -v 0.67983197 -0.25622646 -0.67747227 -v 0.83881076 -0.03741094 -0.51031208 -v 0.93706505 -0.17264637 -0.23984122 -v -0.71099855 0.65096039 -0.23984122 -v -0.45376548 0.83785116 -0.23984122 -v -0.29478669 0.78619582 -0.51031208 -v -0.45376548 0.56738030 -0.67747227 -v -0.71099855 0.48380020 -0.51031208 -f 1 2 24 23 22 21 20 19 12 11 -f 1 11 10 -f 1 10 62 61 -f 1 61 2 -f 2 3 24 -f 2 61 65 3 -f 3 4 30 29 28 27 26 25 23 24 -f 3 65 4 -f 4 5 30 -f 4 65 64 5 -f 5 6 36 35 34 33 32 31 29 30 -f 5 64 6 -f 6 7 36 -f 6 64 63 7 -f 7 8 18 17 40 39 38 37 35 36 -f 7 63 8 -f 8 9 18 -f 8 63 62 9 -f 9 10 11 12 13 14 15 16 17 18 -f 9 62 10 -f 12 19 13 -f 13 19 20 46 45 44 43 42 41 14 -f 14 41 15 -f 15 41 67 66 -f 15 66 16 -f 16 40 17 -f 16 66 70 40 -f 20 21 46 -f 21 22 25 26 50 49 48 47 45 46 -f 22 23 25 -f 26 27 50 -f 27 28 71 -f 27 71 75 50 -f 28 29 31 -f 28 31 72 71 -f 31 32 72 -f 32 33 54 -f 32 54 73 72 -f 33 34 37 38 58 57 56 55 53 54 -f 34 35 37 -f 38 39 58 -f 39 40 70 -f 39 70 69 58 -f 41 42 67 -f 42 43 60 -f 42 60 68 67 -f 43 44 47 48 51 52 55 56 59 60 -f 44 45 47 -f 48 49 51 -f 49 50 75 -f 49 75 74 51 -f 51 74 52 -f 52 53 55 -f 52 74 73 53 -f 53 73 54 -f 56 57 59 -f 57 58 69 -f 57 69 68 59 -f 59 68 60 -f 61 62 63 64 65 -f 66 67 68 69 70 -f 71 72 73 74 75 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n72.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n72.obj deleted file mode 100644 index ad80a06d..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n72.obj +++ /dev/null @@ -1,122 +0,0 @@ -v -0.22391898 -0.68915176 0.68915176 -v -0.58622750 -0.42591921 0.68915176 -v -0.72461704 0.00000000 0.68915176 -v -0.58622750 0.42591921 0.68915176 -v -0.22391898 0.68915176 0.68915176 -v 0.22391898 0.68915176 0.68915176 -v 0.58622750 0.42591921 0.68915176 -v 0.72461704 0.00000000 0.68915176 -v 0.58622750 -0.42591921 0.68915176 -v 0.22391898 -0.68915176 0.68915176 -v -0.22391898 -0.92459411 0.30819804 -v -0.81014648 -0.49867490 0.30819804 -v -0.94853602 -0.07275569 0.30819804 -v -0.72461704 0.61639607 0.30819804 -v -0.36230852 0.87962862 0.30819804 -v 0.36230852 0.87962862 0.30819804 -v 0.72461704 0.61639607 0.30819804 -v 0.94853602 -0.07275569 0.30819804 -v 0.81014648 -0.49867490 0.30819804 -v 0.22391898 -0.92459411 0.30819804 -v 0.00000000 -0.99734979 -0.07275569 -v -0.58622750 -0.80687293 0.07275569 -v -0.94853602 0.30819804 0.07275569 -v 0.00000000 0.99734979 0.07275569 -v 0.94853602 0.30819804 0.07275569 -v 0.58622750 -0.80687293 0.07275569 -v -0.36230852 -0.87962862 -0.30819804 -v -0.22391898 -0.68915176 -0.68915176 -v -0.22391898 -0.30819804 -0.92459411 -v -0.36230852 0.11772117 -0.92459411 -v -0.58622750 0.42591921 -0.68915176 -v -0.81014648 0.49867490 -0.30819804 -v 0.36230852 -0.87962862 -0.30819804 -v 0.22391898 -0.68915176 -0.68915176 -v 0.22391898 -0.30819804 -0.92459411 -v 0.36230852 0.11772117 -0.92459411 -v 0.58622750 0.42591921 -0.68915176 -v 0.81014648 0.49867490 -0.30819804 -v -0.00000000 0.38095372 -0.92459410 -v -0.22391898 0.68915176 -0.68915176 -v 0.22391898 0.68915176 -0.68915176 -v -0.22391898 0.92459411 -0.30819804 -v 0.22391898 0.92459411 -0.30819804 -v 0.58622750 0.80687293 -0.07275569 -v -0.58622750 0.80687293 -0.07275569 -v 0.00000000 -0.38095372 0.92459411 -v 0.36230852 -0.11772117 0.92459411 -v 0.22391898 0.30819804 0.92459411 -v -0.22391898 0.30819804 0.92459411 -v -0.36230852 -0.11772117 0.92459411 -v -0.94853602 -0.30819803 -0.07275569 -v -0.94853602 0.07275569 -0.30819804 -v -0.72461704 0.00000000 -0.68915176 -v -0.58622750 -0.42591921 -0.68915176 -v -0.72461704 -0.61639607 -0.30819804 -v 0.98678595 -0.08518384 -0.13783035 -v 0.84839641 -0.51110305 -0.13783035 -v 0.62447743 -0.58385874 -0.51878407 -v 0.62447743 -0.20290502 -0.75422642 -v 0.84839641 0.10529302 -0.51878407 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 46 -f 1 46 50 2 -f 2 3 13 12 -f 2 50 3 -f 3 4 14 23 13 -f 3 50 49 4 -f 4 5 15 14 -f 4 49 5 -f 5 6 16 24 15 -f 5 49 48 6 -f 6 7 17 16 -f 6 48 7 -f 7 8 18 25 17 -f 7 48 47 8 -f 8 9 19 18 -f 8 47 9 -f 9 10 20 26 19 -f 9 47 46 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 51 -f 12 51 55 22 -f 13 23 52 51 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 57 56 -f 18 56 25 -f 19 26 57 -f 20 21 33 26 -f 21 27 28 34 33 -f 22 55 27 -f 23 32 52 -f 24 43 42 -f 25 56 60 38 -f 26 33 58 57 -f 27 55 54 28 -f 28 29 35 34 -f 28 54 29 -f 29 30 39 36 35 -f 29 54 53 30 -f 30 31 40 39 -f 30 53 31 -f 31 32 45 42 40 -f 31 53 52 32 -f 33 34 58 -f 34 35 59 58 -f 35 36 59 -f 36 39 41 37 -f 36 37 60 59 -f 37 41 43 44 38 -f 37 38 60 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 -f 51 52 53 54 55 -f 56 57 58 59 60 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n73.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n73.obj deleted file mode 100644 index d65e44ca..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n73.obj +++ /dev/null @@ -1,122 +0,0 @@ -v -0.22391898 -0.68915175 0.68915175 -v -0.58622750 -0.42591921 0.68915175 -v -0.72461704 -0.00000000 0.68915175 -v -0.58622750 0.42591921 0.68915175 -v -0.22391898 0.68915175 0.68915175 -v 0.22391898 0.68915175 0.68915175 -v 0.58622749 0.42591921 0.68915175 -v 0.72461703 -0.00000000 0.68915175 -v 0.58622749 -0.42591921 0.68915175 -v 0.22391898 -0.68915175 0.68915175 -v -0.22391898 -0.92459410 0.30819803 -v -0.81014648 -0.49867489 0.30819803 -v -0.94853602 -0.07275569 0.30819803 -v -0.72461704 0.61639607 0.30819803 -v -0.36230852 0.87962861 0.30819803 -v 0.36230852 0.87962861 0.30819803 -v 0.72461703 0.61639607 0.30819803 -v 0.94853601 -0.07275569 0.30819803 -v 0.81014647 -0.49867489 0.30819803 -v 0.22391898 -0.92459410 0.30819803 -v -0.00000000 -0.99734979 -0.07275569 -v -0.58622750 -0.80687293 0.07275569 -v -0.94853602 -0.30819803 -0.07275569 -v -0.94853602 0.30819803 0.07275569 -v -0.58622750 0.80687293 -0.07275569 -v -0.00000000 0.99734979 0.07275569 -v 0.58622749 0.80687293 -0.07275569 -v 0.94853601 0.30819803 0.07275569 -v 0.94853601 -0.30819803 -0.07275569 -v 0.58622749 -0.80687293 0.07275569 -v 0.36230852 -0.87962861 -0.30819803 -v -0.36230852 -0.87962861 -0.30819803 -v -0.72461704 -0.61639607 -0.30819803 -v -0.94853601 0.07275569 -0.30819803 -v -0.81014648 0.49867489 -0.30819803 -v -0.22391898 0.92459410 -0.30819803 -v 0.22391898 0.92459410 -0.30819803 -v 0.81014647 0.49867489 -0.30819803 -v 0.94853601 0.07275569 -0.30819803 -v 0.72461703 -0.61639607 -0.30819803 -v -0.22391898 -0.68915175 -0.68915175 -v -0.58622750 -0.42591921 -0.68915175 -v -0.72461703 0.00000000 -0.68915175 -v -0.58622748 0.42591921 -0.68915175 -v -0.22391896 0.68915175 -0.68915175 -v 0.22391899 0.68915175 -0.68915175 -v 0.58622751 0.42591921 -0.68915175 -v 0.72461704 0.00000000 -0.68915175 -v 0.58622750 -0.42591921 -0.68915175 -v 0.22391898 -0.68915175 -0.68915175 -v -0.22391898 -0.30819803 0.92459410 -v 0.22391898 -0.30819803 0.92459410 -v 0.36230852 0.11772117 0.92459410 -v -0.00000000 0.38095372 0.92459410 -v -0.36230852 0.11772117 0.92459410 -v 0.00000000 -0.38095372 -0.92459410 -v -0.36230851 -0.11772117 -0.92459410 -v -0.22391897 0.30819803 -0.92459410 -v 0.22391899 0.30819803 -0.92459410 -v 0.36230852 -0.11772117 -0.92459410 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 52 51 -f 1 51 2 -f 2 3 13 12 -f 2 51 55 3 -f 3 4 14 24 13 -f 3 55 4 -f 4 5 15 14 -f 4 55 54 5 -f 5 6 16 26 15 -f 5 54 6 -f 6 7 17 16 -f 6 54 53 7 -f 7 8 18 28 17 -f 7 53 8 -f 8 9 19 18 -f 8 53 52 9 -f 9 10 20 30 19 -f 9 52 10 -f 11 22 32 21 -f 11 21 20 -f 12 13 23 -f 12 23 33 22 -f 13 24 34 23 -f 14 15 25 -f 14 25 35 24 -f 15 26 36 25 -f 16 17 27 -f 16 27 37 26 -f 17 28 38 27 -f 18 19 29 -f 18 29 39 28 -f 19 30 40 29 -f 20 21 31 30 -f 21 32 41 50 31 -f 22 33 32 -f 23 34 43 42 33 -f 24 35 34 -f 25 36 45 44 35 -f 26 37 36 -f 27 38 47 46 37 -f 28 39 38 -f 29 40 49 48 39 -f 30 31 40 -f 31 50 49 40 -f 32 33 42 41 -f 34 35 44 43 -f 36 37 46 45 -f 38 39 48 47 -f 41 42 57 56 -f 41 56 50 -f 42 43 57 -f 43 44 58 57 -f 44 45 58 -f 45 46 59 58 -f 46 47 59 -f 47 48 60 59 -f 48 49 60 -f 49 50 56 60 -f 51 52 53 54 55 -f 56 57 58 59 60 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n74.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n74.obj deleted file mode 100644 index b0a6ff58..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n74.obj +++ /dev/null @@ -1,122 +0,0 @@ -v -0.22391898 -0.68915176 0.68915176 -v -0.58622750 -0.42591921 0.68915176 -v -0.72461704 -0.00000000 0.68915176 -v -0.58622750 0.42591921 0.68915176 -v -0.22391898 0.68915176 0.68915176 -v 0.22391898 0.68915176 0.68915176 -v 0.58622750 0.42591921 0.68915176 -v 0.72461704 -0.00000000 0.68915176 -v 0.58622750 -0.42591921 0.68915176 -v 0.22391898 -0.68915176 0.68915176 -v -0.22391898 -0.92459411 0.30819804 -v -0.81014648 -0.49867490 0.30819804 -v -0.94853602 -0.07275569 0.30819804 -v -0.72461704 0.61639607 0.30819804 -v -0.36230852 0.87962862 0.30819804 -v 0.36230852 0.87962862 0.30819804 -v 0.72461704 0.61639607 0.30819804 -v 0.94853602 -0.07275569 0.30819804 -v 0.81014648 -0.49867490 0.30819804 -v 0.22391898 -0.92459411 0.30819804 -v 0.00000000 -0.99734979 -0.07275569 -v -0.58622750 -0.80687293 0.07275569 -v -0.94853602 0.30819804 0.07275569 -v 0.00000000 0.99734979 0.07275569 -v 0.94853602 0.30819803 0.07275569 -v 0.58622750 -0.80687293 0.07275569 -v -0.36230852 -0.87962862 -0.30819804 -v -0.22391898 -0.68915176 -0.68915176 -v -0.22391898 -0.30819803 -0.92459411 -v -0.36230852 0.11772118 -0.92459411 -v -0.58622750 0.42591921 -0.68915176 -v -0.81014648 0.49867490 -0.30819804 -v 0.36230852 -0.87962862 -0.30819804 -v 0.22391898 -0.68915176 -0.68915176 -v 0.22391898 -0.30819804 -0.92459411 -v 0.36230852 0.11772117 -0.92459411 -v 0.58622750 0.42591921 -0.68915176 -v 0.81014648 0.49867490 -0.30819804 -v -0.00000000 0.38095372 -0.92459410 -v -0.22391898 0.68915176 -0.68915176 -v 0.22391898 0.68915176 -0.68915176 -v -0.22391898 0.92459411 -0.30819804 -v 0.22391898 0.92459411 -0.30819804 -v 0.58622750 0.80687293 -0.07275569 -v -0.58622750 0.80687293 -0.07275569 -v 0.00000000 -0.38095372 0.92459411 -v 0.36230852 -0.11772117 0.92459411 -v 0.22391898 0.30819804 0.92459411 -v -0.22391898 0.30819804 0.92459411 -v -0.36230852 -0.11772117 0.92459411 -v -0.84839641 -0.51110305 -0.13783035 -v -0.98678595 -0.08518384 -0.13783035 -v -0.84839641 0.10529302 -0.51878407 -v -0.62447743 -0.20290502 -0.75422642 -v -0.62447743 -0.58385874 -0.51878407 -v 0.98678595 -0.08518384 -0.13783035 -v 0.84839641 -0.51110305 -0.13783035 -v 0.62447743 -0.58385874 -0.51878407 -v 0.62447743 -0.20290502 -0.75422642 -v 0.84839641 0.10529302 -0.51878407 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 46 -f 1 46 50 2 -f 2 3 13 12 -f 2 50 3 -f 3 4 14 23 13 -f 3 50 49 4 -f 4 5 15 14 -f 4 49 5 -f 5 6 16 24 15 -f 5 49 48 6 -f 6 7 17 16 -f 6 48 7 -f 7 8 18 25 17 -f 7 48 47 8 -f 8 9 19 18 -f 8 47 9 -f 9 10 20 26 19 -f 9 47 46 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 52 51 -f 12 51 22 -f 13 23 52 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 57 56 -f 18 56 25 -f 19 26 57 -f 20 21 33 26 -f 21 27 28 34 33 -f 22 51 55 27 -f 23 32 53 52 -f 24 43 42 -f 25 56 60 38 -f 26 33 58 57 -f 27 55 28 -f 28 29 35 34 -f 28 55 54 29 -f 29 30 39 36 35 -f 29 54 30 -f 30 31 40 39 -f 30 54 53 31 -f 31 32 45 42 40 -f 31 53 32 -f 33 34 58 -f 34 35 59 58 -f 35 36 59 -f 36 39 41 37 -f 36 37 60 59 -f 37 41 43 44 38 -f 37 38 60 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 -f 51 52 53 54 55 -f 56 57 58 59 60 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n75.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n75.obj deleted file mode 100644 index a6eca558..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n75.obj +++ /dev/null @@ -1,122 +0,0 @@ -v -0.22391898 -0.68915176 0.68915176 -v -0.58622750 -0.42591921 0.68915176 -v -0.72461704 -0.00000000 0.68915176 -v -0.58622750 0.42591921 0.68915176 -v -0.22391898 0.68915176 0.68915176 -v 0.22391898 0.68915176 0.68915176 -v 0.58622750 0.42591921 0.68915176 -v 0.72461704 -0.00000000 0.68915176 -v 0.58622750 -0.42591921 0.68915176 -v 0.22391898 -0.68915176 0.68915176 -v -0.22391898 -0.92459411 0.30819804 -v -0.81014648 -0.49867490 0.30819804 -v -0.94853602 -0.07275569 0.30819804 -v -0.72461704 0.61639607 0.30819804 -v -0.36230852 0.87962862 0.30819804 -v 0.36230852 0.87962862 0.30819804 -v 0.72461704 0.61639607 0.30819804 -v 0.94853602 -0.07275569 0.30819804 -v 0.81014648 -0.49867490 0.30819804 -v 0.22391898 -0.92459411 0.30819804 -v -0.00000000 -0.99734979 -0.07275569 -v -0.58622750 -0.80687293 0.07275569 -v -0.94853602 0.30819804 0.07275569 -v 0.00000000 0.99734979 0.07275569 -v 0.94853602 0.30819804 0.07275569 -v 0.58622750 -0.80687293 0.07275569 -v -0.36230852 -0.87962862 -0.30819804 -v -0.22391898 -0.68915176 -0.68915176 -v -0.22391898 -0.30819803 -0.92459411 -v -0.36230852 0.11772118 -0.92459411 -v -0.58622750 0.42591921 -0.68915176 -v -0.81014648 0.49867490 -0.30819804 -v 0.36230852 -0.87962862 -0.30819804 -v 0.22391898 -0.68915176 -0.68915176 -v 0.22391898 -0.30819804 -0.92459411 -v 0.36230852 0.11772117 -0.92459411 -v 0.58622750 0.42591921 -0.68915176 -v 0.81014648 0.49867490 -0.30819804 -v -0.00000000 0.38095372 -0.92459410 -v -0.22391898 0.68915176 -0.68915176 -v 0.22391898 0.68915176 -0.68915176 -v -0.22391898 0.92459411 -0.30819804 -v 0.22391898 0.92459411 -0.30819804 -v 0.58622750 0.80687293 -0.07275569 -v -0.58622750 0.80687293 -0.07275569 -v -0.22391898 -0.30819804 0.92459411 -v 0.22391898 -0.30819804 0.92459411 -v 0.36230852 0.11772117 0.92459411 -v 0.00000000 0.38095372 0.92459411 -v -0.36230852 0.11772117 0.92459411 -v -0.84839641 -0.51110305 -0.13783035 -v -0.98678595 -0.08518384 -0.13783035 -v -0.84839641 0.10529302 -0.51878407 -v -0.62447743 -0.20290502 -0.75422642 -v -0.62447743 -0.58385874 -0.51878407 -v 0.98678595 -0.08518384 -0.13783035 -v 0.84839641 -0.51110305 -0.13783035 -v 0.62447743 -0.58385874 -0.51878407 -v 0.62447743 -0.20290502 -0.75422642 -v 0.84839641 0.10529302 -0.51878407 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 47 46 -f 1 46 2 -f 2 3 13 12 -f 2 46 50 3 -f 3 4 14 23 13 -f 3 50 4 -f 4 5 15 14 -f 4 50 49 5 -f 5 6 16 24 15 -f 5 49 6 -f 6 7 17 16 -f 6 49 48 7 -f 7 8 18 25 17 -f 7 48 8 -f 8 9 19 18 -f 8 48 47 9 -f 9 10 20 26 19 -f 9 47 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 52 51 -f 12 51 22 -f 13 23 52 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 57 56 -f 18 56 25 -f 19 26 57 -f 20 21 33 26 -f 21 27 28 34 33 -f 22 51 55 27 -f 23 32 53 52 -f 24 43 42 -f 25 56 60 38 -f 26 33 58 57 -f 27 55 28 -f 28 29 35 34 -f 28 55 54 29 -f 29 30 39 36 35 -f 29 54 30 -f 30 31 40 39 -f 30 54 53 31 -f 31 32 45 42 40 -f 31 53 32 -f 33 34 58 -f 34 35 59 58 -f 35 36 59 -f 36 39 41 37 -f 36 37 60 59 -f 37 41 43 44 38 -f 37 38 60 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 -f 51 52 53 54 55 -f 56 57 58 59 60 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n76.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n76.obj deleted file mode 100644 index 6ae6abe0..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n76.obj +++ /dev/null @@ -1,107 +0,0 @@ -v -0.14383464 -0.67226446 0.61486772 -v -0.48573906 -0.42385636 0.61486772 -v -0.61633492 -0.02192360 0.61486772 -v -0.48573906 0.38000915 0.61486772 -v -0.14383464 0.62841725 0.61486772 -v 0.27878247 0.62841725 0.61486772 -v 0.62068689 0.38000915 0.61486772 -v 0.75128276 -0.02192360 0.61486772 -v 0.62068689 -0.42385636 0.61486772 -v 0.27878247 -0.67226446 0.61486772 -v -0.14383464 -0.89444742 0.25536813 -v -0.69704761 -0.49251467 0.25536813 -v -0.82764348 -0.09058192 0.25536813 -v -0.61633492 0.55975894 0.25536813 -v -0.27443050 0.80816704 0.25536813 -v 0.40937834 0.80816704 0.25536813 -v 0.75128276 0.55975894 0.25536813 -v 0.96259131 -0.09058192 0.25536813 -v 0.83199544 -0.49251467 0.25536813 -v 0.27878247 -0.89444742 0.25536813 -v 0.06747392 -0.96310573 -0.10413145 -v -0.48573906 -0.78335594 0.03318517 -v -0.82764348 0.26891767 0.03318517 -v 0.06747392 0.91925852 0.03318517 -v 0.96259131 0.26891767 0.03318517 -v 0.62068689 -0.78335594 0.03318517 -v -0.27443050 -0.85201425 -0.32631441 -v -0.14383464 -0.67226446 -0.68581399 -v -0.14383464 -0.31276488 -0.90799695 -v -0.27443050 0.08916788 -0.90799695 -v -0.48573906 0.38000915 -0.68581399 -v -0.69704761 0.44866746 -0.32631441 -v 0.40937834 -0.85201425 -0.32631441 -v 0.27878247 -0.67226446 -0.68581399 -v 0.27878247 -0.31276488 -0.90799695 -v 0.40937834 0.08916788 -0.90799695 -v 0.62068689 0.38000915 -0.68581399 -v 0.83199544 0.44866746 -0.32631441 -v 0.06747392 0.33757598 -0.90799695 -v -0.14383464 0.62841725 -0.68581399 -v 0.27878247 0.62841725 -0.68581399 -v -0.14383464 0.85060021 -0.32631441 -v 0.27878247 0.85060021 -0.32631441 -v 0.62068689 0.73950873 -0.10413145 -v -0.48573906 0.73950873 -0.10413145 -v 0.06747392 -0.38142319 0.83705068 -v 0.40937834 -0.13301509 0.83705068 -v 0.27878247 0.26891767 0.83705068 -v -0.14383464 0.26891767 0.83705068 -v -0.27443050 -0.13301508 0.83705068 -v -0.82764348 -0.31276488 -0.10413145 -v -0.82764348 0.04673471 -0.32631441 -v -0.61633492 -0.02192360 -0.68581399 -v -0.48573906 -0.42385636 -0.68581399 -v -0.61633492 -0.60360615 -0.32631441 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 46 -f 1 46 50 2 -f 2 3 13 12 -f 2 50 3 -f 3 4 14 23 13 -f 3 50 49 4 -f 4 5 15 14 -f 4 49 5 -f 5 6 16 24 15 -f 5 49 48 6 -f 6 7 17 16 -f 6 48 7 -f 7 8 18 25 17 -f 7 48 47 8 -f 8 9 19 18 -f 8 47 9 -f 9 10 20 26 19 -f 9 47 46 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 51 -f 12 51 55 22 -f 13 23 52 51 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 26 33 34 35 36 37 38 25 -f 20 21 33 26 -f 21 27 28 34 33 -f 22 55 27 -f 23 32 52 -f 24 43 42 -f 27 55 54 28 -f 28 29 35 34 -f 28 54 29 -f 29 30 39 36 35 -f 29 54 53 30 -f 30 31 40 39 -f 30 53 31 -f 31 32 45 42 40 -f 31 53 52 32 -f 36 39 41 37 -f 37 41 43 44 38 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 -f 51 52 53 54 55 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n77.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n77.obj deleted file mode 100644 index 14c23ffd..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n77.obj +++ /dev/null @@ -1,107 +0,0 @@ -v -0.21130855 -0.65034085 0.57102051 -v -0.55321297 -0.40193275 0.57102051 -v -0.68380884 -0.00000000 0.57102051 -v -0.55321297 0.40193275 0.57102051 -v -0.21130855 0.65034085 0.57102051 -v 0.21130855 0.65034085 0.57102051 -v 0.55321297 0.40193275 0.57102051 -v 0.68380884 -0.00000000 0.57102051 -v 0.55321297 -0.40193275 0.57102051 -v 0.21130855 -0.65034085 0.57102051 -v -0.21130855 -0.87252381 0.21152092 -v -0.76452153 -0.47059106 0.21152092 -v -0.89511739 -0.06865831 0.21152092 -v -0.68380884 0.58168254 0.21152092 -v -0.34190442 0.83009064 0.21152092 -v 0.34190442 0.83009064 0.21152092 -v 0.68380884 0.58168254 0.21152092 -v 0.89511739 -0.06865831 0.21152092 -v 0.76452152 -0.47059106 0.21152092 -v 0.21130855 -0.87252381 0.21152092 -v -0.00000000 -0.94118212 -0.14797866 -v -0.55321297 -0.76143233 -0.01066204 -v -0.89511739 -0.29084127 -0.14797866 -v -0.89511739 0.29084127 -0.01066204 -v -0.55321297 0.76143233 -0.14797866 -v -0.00000000 0.94118212 -0.01066204 -v 0.55321297 0.76143233 -0.14797866 -v 0.89511739 0.29084127 -0.01066204 -v 0.89511739 -0.29084127 -0.14797866 -v 0.55321297 -0.76143233 -0.01066204 -v 0.34190442 -0.83009064 -0.37016162 -v -0.34190442 -0.83009064 -0.37016162 -v -0.68380884 -0.58168254 -0.37016162 -v -0.89511739 0.06865831 -0.37016162 -v -0.76452153 0.47059106 -0.37016162 -v -0.21130855 0.87252381 -0.37016162 -v 0.21130855 0.87252381 -0.37016162 -v 0.76452153 0.47059106 -0.37016162 -v 0.89511739 0.06865831 -0.37016162 -v 0.68380884 -0.58168254 -0.37016162 -v -0.21130855 -0.65034085 -0.72966120 -v -0.55321297 -0.40193275 -0.72966120 -v -0.68380884 0.00000000 -0.72966120 -v -0.55321297 0.40193275 -0.72966120 -v -0.21130855 0.65034085 -0.72966120 -v 0.21130855 0.65034085 -0.72966120 -v 0.55321297 0.40193275 -0.72966120 -v 0.68380884 -0.00000000 -0.72966120 -v 0.55321297 -0.40193275 -0.72966120 -v 0.21130855 -0.65034085 -0.72966120 -v -0.21130855 -0.29084127 0.79320347 -v 0.21130855 -0.29084127 0.79320347 -v 0.34190442 0.11109148 0.79320347 -v -0.00000000 0.35949958 0.79320347 -v -0.34190442 0.11109148 0.79320347 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 52 51 -f 1 51 2 -f 2 3 13 12 -f 2 51 55 3 -f 3 4 14 24 13 -f 3 55 4 -f 4 5 15 14 -f 4 55 54 5 -f 5 6 16 26 15 -f 5 54 6 -f 6 7 17 16 -f 6 54 53 7 -f 7 8 18 28 17 -f 7 53 8 -f 8 9 19 18 -f 8 53 52 9 -f 9 10 20 30 19 -f 9 52 10 -f 11 22 32 21 -f 11 21 20 -f 12 13 23 -f 12 23 33 22 -f 13 24 34 23 -f 14 15 25 -f 14 25 35 24 -f 15 26 36 25 -f 16 17 27 -f 16 27 37 26 -f 17 28 38 27 -f 18 19 29 -f 18 29 39 28 -f 19 30 40 29 -f 20 21 31 30 -f 21 32 41 50 31 -f 22 33 32 -f 23 34 43 42 33 -f 24 35 34 -f 25 36 45 44 35 -f 26 37 36 -f 27 38 47 46 37 -f 28 39 38 -f 29 40 49 48 39 -f 30 31 40 -f 31 50 49 40 -f 32 33 42 41 -f 34 35 44 43 -f 36 37 46 45 -f 38 39 48 47 -f 41 42 43 44 45 46 47 48 49 50 -f 51 52 53 54 55 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n78.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n78.obj deleted file mode 100644 index 7693437a..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n78.obj +++ /dev/null @@ -1,107 +0,0 @@ -v -0.14383464 -0.67226446 0.61486772 -v -0.48573906 -0.42385636 0.61486772 -v -0.61633492 -0.02192360 0.61486772 -v -0.48573906 0.38000915 0.61486772 -v -0.14383464 0.62841725 0.61486772 -v 0.27878247 0.62841725 0.61486772 -v 0.62068689 0.38000915 0.61486772 -v 0.75128276 -0.02192360 0.61486772 -v 0.62068689 -0.42385636 0.61486772 -v 0.27878247 -0.67226446 0.61486772 -v -0.14383464 -0.89444742 0.25536813 -v -0.69704761 -0.49251467 0.25536813 -v -0.82764348 -0.09058192 0.25536813 -v -0.61633492 0.55975894 0.25536813 -v -0.27443050 0.80816704 0.25536813 -v 0.40937834 0.80816704 0.25536813 -v 0.75128276 0.55975894 0.25536813 -v 0.96259131 -0.09058192 0.25536813 -v 0.83199544 -0.49251467 0.25536813 -v 0.27878247 -0.89444742 0.25536813 -v 0.06747392 -0.96310573 -0.10413145 -v -0.48573906 -0.78335594 0.03318517 -v -0.82764348 0.26891767 0.03318517 -v 0.06747392 0.91925852 0.03318517 -v 0.96259131 0.26891767 0.03318517 -v 0.62068689 -0.78335594 0.03318517 -v -0.27443050 -0.85201425 -0.32631441 -v -0.14383464 -0.67226446 -0.68581399 -v -0.14383464 -0.31276488 -0.90799695 -v -0.27443050 0.08916788 -0.90799695 -v -0.48573906 0.38000915 -0.68581399 -v -0.69704761 0.44866746 -0.32631441 -v 0.40937834 -0.85201425 -0.32631441 -v 0.27878247 -0.67226446 -0.68581399 -v 0.27878247 -0.31276488 -0.90799695 -v 0.40937834 0.08916788 -0.90799695 -v 0.62068689 0.38000915 -0.68581399 -v 0.83199544 0.44866746 -0.32631441 -v 0.06747392 0.33757598 -0.90799695 -v -0.14383464 0.62841725 -0.68581399 -v 0.27878247 0.62841725 -0.68581399 -v -0.14383464 0.85060021 -0.32631441 -v 0.27878247 0.85060021 -0.32631441 -v 0.62068689 0.73950873 -0.10413145 -v -0.48573906 0.73950873 -0.10413145 -v 0.06747392 -0.38142319 0.83705068 -v 0.40937834 -0.13301509 0.83705068 -v 0.27878247 0.26891767 0.83705068 -v -0.14383464 0.26891767 0.83705068 -v -0.27443050 -0.13301509 0.83705068 -v -0.73314342 -0.50424291 -0.16554131 -v -0.86373929 -0.10231015 -0.16554131 -v -0.73314342 0.07743964 -0.52504089 -v -0.52183487 -0.21340164 -0.74722385 -v -0.52183487 -0.57290122 -0.52504089 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 46 -f 1 46 50 2 -f 2 3 13 12 -f 2 50 3 -f 3 4 14 23 13 -f 3 50 49 4 -f 4 5 15 14 -f 4 49 5 -f 5 6 16 24 15 -f 5 49 48 6 -f 6 7 17 16 -f 6 48 7 -f 7 8 18 25 17 -f 7 48 47 8 -f 8 9 19 18 -f 8 47 9 -f 9 10 20 26 19 -f 9 47 46 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 52 51 -f 12 51 22 -f 13 23 52 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 26 33 34 35 36 37 38 25 -f 20 21 33 26 -f 21 27 28 34 33 -f 22 51 55 27 -f 23 32 53 52 -f 24 43 42 -f 27 55 28 -f 28 29 35 34 -f 28 55 54 29 -f 29 30 39 36 35 -f 29 54 30 -f 30 31 40 39 -f 30 54 53 31 -f 31 32 45 42 40 -f 31 53 32 -f 36 39 41 37 -f 37 41 43 44 38 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 -f 51 52 53 54 55 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n79.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n79.obj deleted file mode 100644 index 5923c300..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n79.obj +++ /dev/null @@ -1,107 +0,0 @@ -v -0.14383464 -0.67226446 0.61486772 -v -0.48573906 -0.42385636 0.61486772 -v -0.61633492 -0.02192360 0.61486772 -v -0.48573906 0.38000915 0.61486772 -v -0.14383464 0.62841725 0.61486772 -v 0.27878247 0.62841725 0.61486772 -v 0.62068689 0.38000915 0.61486772 -v 0.75128276 -0.02192360 0.61486772 -v 0.62068689 -0.42385636 0.61486772 -v 0.27878247 -0.67226446 0.61486772 -v -0.14383464 -0.89444742 0.25536813 -v -0.69704761 -0.49251467 0.25536813 -v -0.82764348 -0.09058192 0.25536813 -v -0.61633492 0.55975894 0.25536813 -v -0.27443050 0.80816704 0.25536813 -v 0.40937834 0.80816704 0.25536813 -v 0.75128276 0.55975894 0.25536813 -v 0.96259131 -0.09058192 0.25536813 -v 0.83199544 -0.49251467 0.25536813 -v 0.27878247 -0.89444742 0.25536813 -v 0.06747392 -0.96310573 -0.10413145 -v -0.48573906 -0.78335594 0.03318517 -v -0.82764348 0.26891767 0.03318517 -v 0.06747392 0.91925852 0.03318517 -v 0.96259131 0.26891767 0.03318517 -v 0.62068689 -0.78335594 0.03318517 -v -0.27443050 -0.85201425 -0.32631441 -v -0.14383464 -0.67226446 -0.68581399 -v -0.14383464 -0.31276488 -0.90799695 -v -0.27443050 0.08916788 -0.90799695 -v -0.48573906 0.38000915 -0.68581399 -v -0.69704761 0.44866746 -0.32631441 -v 0.40937834 -0.85201425 -0.32631441 -v 0.27878247 -0.67226446 -0.68581399 -v 0.27878247 -0.31276488 -0.90799695 -v 0.40937834 0.08916788 -0.90799695 -v 0.62068689 0.38000915 -0.68581399 -v 0.83199544 0.44866746 -0.32631441 -v 0.06747392 0.33757598 -0.90799695 -v -0.14383464 0.62841725 -0.68581399 -v 0.27878247 0.62841725 -0.68581399 -v -0.14383464 0.85060021 -0.32631441 -v 0.27878247 0.85060021 -0.32631441 -v 0.62068689 0.73950873 -0.10413145 -v -0.48573906 0.73950873 -0.10413145 -v -0.14383464 -0.31276488 0.83705068 -v 0.27878247 -0.31276488 0.83705068 -v 0.40937834 0.08916788 0.83705068 -v 0.06747392 0.33757598 0.83705068 -v -0.27443050 0.08916788 0.83705068 -v -0.73314342 -0.50424291 -0.16554131 -v -0.86373929 -0.10231015 -0.16554131 -v -0.73314342 0.07743964 -0.52504089 -v -0.52183487 -0.21340164 -0.74722385 -v -0.52183487 -0.57290122 -0.52504089 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 47 46 -f 1 46 2 -f 2 3 13 12 -f 2 46 50 3 -f 3 4 14 23 13 -f 3 50 4 -f 4 5 15 14 -f 4 50 49 5 -f 5 6 16 24 15 -f 5 49 6 -f 6 7 17 16 -f 6 49 48 7 -f 7 8 18 25 17 -f 7 48 8 -f 8 9 19 18 -f 8 48 47 9 -f 9 10 20 26 19 -f 9 47 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 52 51 -f 12 51 22 -f 13 23 52 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 26 33 34 35 36 37 38 25 -f 20 21 33 26 -f 21 27 28 34 33 -f 22 51 55 27 -f 23 32 53 52 -f 24 43 42 -f 27 55 28 -f 28 29 35 34 -f 28 55 54 29 -f 29 30 39 36 35 -f 29 54 30 -f 30 31 40 39 -f 30 54 53 31 -f 31 32 45 42 40 -f 31 53 32 -f 36 39 41 37 -f 37 41 43 44 38 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 -f 51 52 53 54 55 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n80.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n80.obj deleted file mode 100644 index c6797f3d..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n80.obj +++ /dev/null @@ -1,92 +0,0 @@ -v -0.22391898 -0.68915176 0.68915176 -v -0.58622750 -0.42591921 0.68915176 -v -0.72461704 -0.00000000 0.68915176 -v -0.58622750 0.42591921 0.68915176 -v -0.22391898 0.68915176 0.68915176 -v 0.22391898 0.68915176 0.68915176 -v 0.58622750 0.42591921 0.68915176 -v 0.72461704 -0.00000000 0.68915176 -v 0.58622750 -0.42591921 0.68915176 -v 0.22391898 -0.68915176 0.68915176 -v -0.22391898 -0.92459411 0.30819803 -v -0.81014648 -0.49867490 0.30819803 -v -0.94853602 -0.07275569 0.30819803 -v -0.72461704 0.61639607 0.30819803 -v -0.36230852 0.87962862 0.30819803 -v 0.36230852 0.87962862 0.30819803 -v 0.72461704 0.61639607 0.30819803 -v 0.94853602 -0.07275569 0.30819803 -v 0.81014648 -0.49867490 0.30819803 -v 0.22391898 -0.92459411 0.30819803 -v -0.00000000 -0.99734979 -0.07275569 -v -0.58622750 -0.80687293 0.07275569 -v -0.94853602 -0.30819803 -0.07275569 -v -0.94853602 0.30819803 0.07275569 -v -0.58622750 0.80687293 -0.07275569 -v -0.00000000 0.99734979 0.07275569 -v 0.58622750 0.80687293 -0.07275569 -v 0.94853602 0.30819803 0.07275569 -v 0.94853602 -0.30819804 -0.07275569 -v 0.58622750 -0.80687293 0.07275569 -v 0.36230852 -0.87962862 -0.30819803 -v -0.36230852 -0.87962862 -0.30819803 -v -0.72461704 -0.61639607 -0.30819803 -v -0.94853602 0.07275569 -0.30819803 -v -0.81014648 0.49867490 -0.30819803 -v -0.22391898 0.92459411 -0.30819803 -v 0.22391898 0.92459410 -0.30819803 -v 0.81014648 0.49867490 -0.30819803 -v 0.94853602 0.07275569 -0.30819803 -v 0.72461704 -0.61639607 -0.30819803 -v -0.22391898 -0.68915176 -0.68915176 -v -0.58622750 -0.42591921 -0.68915176 -v -0.72461703 0.00000000 -0.68915176 -v -0.58622750 0.42591921 -0.68915176 -v -0.22391898 0.68915176 -0.68915176 -v 0.22391898 0.68915176 -0.68915176 -v 0.58622750 0.42591921 -0.68915176 -v 0.72461704 -0.00000000 -0.68915176 -v 0.58622750 -0.42591921 -0.68915176 -v 0.22391898 -0.68915176 -0.68915176 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 9 8 7 6 5 4 3 2 -f 2 3 13 12 -f 3 4 14 24 13 -f 4 5 15 14 -f 5 6 16 26 15 -f 6 7 17 16 -f 7 8 18 28 17 -f 8 9 19 18 -f 9 10 20 30 19 -f 11 22 32 21 -f 11 21 20 -f 12 13 23 -f 12 23 33 22 -f 13 24 34 23 -f 14 15 25 -f 14 25 35 24 -f 15 26 36 25 -f 16 17 27 -f 16 27 37 26 -f 17 28 38 27 -f 18 19 29 -f 18 29 39 28 -f 19 30 40 29 -f 20 21 31 30 -f 21 32 41 50 31 -f 22 33 32 -f 23 34 43 42 33 -f 24 35 34 -f 25 36 45 44 35 -f 26 37 36 -f 27 38 47 46 37 -f 28 39 38 -f 29 40 49 48 39 -f 30 31 40 -f 31 50 49 40 -f 32 33 42 41 -f 34 35 44 43 -f 36 37 46 45 -f 38 39 48 47 -f 41 42 43 44 45 46 47 48 49 50 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n81.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n81.obj deleted file mode 100644 index e249e287..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n81.obj +++ /dev/null @@ -1,92 +0,0 @@ -v -0.20493237 -0.67749353 0.55503095 -v -0.53651992 -0.43658108 0.55503095 -v -0.66317509 -0.04677654 0.55503095 -v -0.53651992 0.34302799 0.55503095 -v -0.20493237 0.58394044 0.55503095 -v 0.20493237 0.58394044 0.55503095 -v 0.53651992 0.34302799 0.55503095 -v 0.66317509 -0.04677654 0.55503095 -v 0.53651992 -0.43658108 0.55503095 -v 0.20493237 -0.67749353 0.55503095 -v -0.20493237 -0.89297218 0.20637917 -v -0.74145229 -0.50316764 0.20637917 -v -0.86810746 -0.11336311 0.20637917 -v -0.66317509 0.51735388 0.20637917 -v -0.33158754 0.75826633 0.20637917 -v 0.33158754 0.75826633 0.20637917 -v 0.66317509 0.51735388 0.20637917 -v 0.86810746 -0.11336311 0.20637917 -v 0.74145229 -0.50316764 0.20637917 -v 0.20493237 -0.89297218 0.20637917 -v 0.00000000 -0.95955874 -0.14227260 -v -0.53651992 -0.78523286 -0.00909947 -v -0.86810746 0.23528867 -0.00909947 -v 0.00000000 0.86600566 -0.00909947 -v 0.86810746 0.23528867 -0.00909947 -v 0.53651992 -0.78523286 -0.00909947 -v -0.33158754 -0.85181942 -0.35775125 -v -0.20493237 -0.67749353 -0.70640303 -v -0.20493237 -0.32884176 -0.92188167 -v -0.33158754 0.06096278 -0.92188167 -v -0.53651992 0.34302799 -0.70640302 -v -0.74145229 0.40961456 -0.35775125 -v 0.33158754 -0.85181942 -0.35775125 -v 0.20493237 -0.67749353 -0.70640303 -v 0.20493237 -0.32884176 -0.92188167 -v 0.33158754 0.06096278 -0.92188167 -v 0.53651992 0.34302799 -0.70640303 -v 0.74145229 0.40961456 -0.35775125 -v -0.00000000 0.30187523 -0.92188167 -v -0.20493237 0.58394044 -0.70640302 -v 0.20493237 0.58394044 -0.70640303 -v -0.20493237 0.79941909 -0.35775125 -v 0.20493237 0.79941909 -0.35775125 -v 0.53651992 0.69167977 -0.14227260 -v -0.53651992 0.69167977 -0.14227260 -v 0.00000000 -0.39542832 0.77050960 -v 0.33158754 -0.15451587 0.77050960 -v 0.20493237 0.23528867 0.77050960 -v -0.20493237 0.23528867 0.77050960 -v -0.33158754 -0.15451587 0.77050960 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 46 -f 1 46 50 2 -f 2 3 13 12 -f 2 50 3 -f 3 4 14 23 13 -f 3 50 49 4 -f 4 5 15 14 -f 4 49 5 -f 5 6 16 24 15 -f 5 49 48 6 -f 6 7 17 16 -f 6 48 7 -f 7 8 18 25 17 -f 7 48 47 8 -f 8 9 19 18 -f 8 47 9 -f 9 10 20 26 19 -f 9 47 46 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 23 32 31 30 29 28 27 22 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 26 33 34 35 36 37 38 25 -f 20 21 33 26 -f 21 27 28 34 33 -f 24 43 42 -f 28 29 35 34 -f 29 30 39 36 35 -f 30 31 40 39 -f 31 32 45 42 40 -f 36 39 41 37 -f 37 41 43 44 38 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n82.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n82.obj deleted file mode 100644 index bec40fa7..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n82.obj +++ /dev/null @@ -1,92 +0,0 @@ -v -0.20493237 -0.67749353 0.55503095 -v -0.53651992 -0.43658108 0.55503095 -v -0.66317509 -0.04677654 0.55503095 -v -0.53651992 0.34302799 0.55503095 -v -0.20493237 0.58394044 0.55503095 -v 0.20493237 0.58394044 0.55503095 -v 0.53651992 0.34302799 0.55503095 -v 0.66317509 -0.04677654 0.55503095 -v 0.53651992 -0.43658108 0.55503095 -v 0.20493237 -0.67749353 0.55503095 -v -0.20493237 -0.89297218 0.20637917 -v -0.74145229 -0.50316764 0.20637917 -v -0.86810746 -0.11336311 0.20637917 -v -0.66317509 0.51735388 0.20637917 -v -0.33158754 0.75826633 0.20637917 -v 0.33158754 0.75826633 0.20637917 -v 0.66317509 0.51735388 0.20637917 -v 0.86810746 -0.11336311 0.20637917 -v 0.74145229 -0.50316764 0.20637917 -v 0.20493237 -0.89297218 0.20637917 -v 0.00000000 -0.95955874 -0.14227260 -v -0.53651992 -0.78523286 -0.00909947 -v -0.86810746 0.23528867 -0.00909947 -v 0.00000000 0.86600566 -0.00909947 -v 0.86810746 0.23528867 -0.00909947 -v 0.53651992 -0.78523286 -0.00909947 -v -0.33158754 -0.85181942 -0.35775125 -v -0.20493237 -0.67749353 -0.70640303 -v -0.20493237 -0.32884176 -0.92188167 -v -0.33158754 0.06096278 -0.92188167 -v -0.53651992 0.34302799 -0.70640302 -v -0.74145229 0.40961456 -0.35775125 -v 0.33158754 -0.85181942 -0.35775125 -v 0.20493237 -0.67749353 -0.70640303 -v 0.20493237 -0.32884176 -0.92188167 -v 0.33158754 0.06096278 -0.92188167 -v 0.53651992 0.34302799 -0.70640303 -v 0.74145229 0.40961456 -0.35775125 -v -0.00000000 0.30187523 -0.92188167 -v -0.20493237 0.58394044 -0.70640302 -v 0.20493237 0.58394044 -0.70640303 -v -0.20493237 0.79941909 -0.35775125 -v 0.20493237 0.79941909 -0.35775125 -v 0.53651992 0.69167977 -0.14227260 -v -0.53651992 0.69167977 -0.14227260 -v -0.20493237 -0.32884176 0.77050960 -v 0.20493237 -0.32884176 0.77050960 -v 0.33158754 0.06096278 0.77050960 -v 0.00000000 0.30187523 0.77050960 -v -0.33158754 0.06096278 0.77050960 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 47 46 -f 1 46 2 -f 2 3 13 12 -f 2 46 50 3 -f 3 4 14 23 13 -f 3 50 4 -f 4 5 15 14 -f 4 50 49 5 -f 5 6 16 24 15 -f 5 49 6 -f 6 7 17 16 -f 6 49 48 7 -f 7 8 18 25 17 -f 7 48 8 -f 8 9 19 18 -f 8 48 47 9 -f 9 10 20 26 19 -f 9 47 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 23 32 31 30 29 28 27 22 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 26 33 34 35 36 37 38 25 -f 20 21 33 26 -f 21 27 28 34 33 -f 24 43 42 -f 28 29 35 34 -f 29 30 39 36 35 -f 30 31 40 39 -f 31 32 45 42 40 -f 36 39 41 37 -f 37 41 43 44 38 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n83.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n83.obj deleted file mode 100644 index 40656942..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n83.obj +++ /dev/null @@ -1,77 +0,0 @@ -v -0.21205343 -0.70641331 0.66290442 -v -0.55516310 -0.45712955 0.66290442 -v -0.68621933 -0.05377995 0.66290442 -v -0.55516310 0.34956965 0.66290442 -v -0.21205343 0.59885342 0.66290442 -v 0.21205343 0.59885342 0.66290442 -v 0.55516310 0.34956965 0.66290442 -v 0.68621933 -0.05377995 0.66290442 -v 0.55516310 -0.45712955 0.66290442 -v 0.21205343 -0.70641331 0.66290442 -v -0.21205343 -0.92937949 0.30213757 -v -0.76721653 -0.52602989 0.30213757 -v -0.89827276 -0.12268028 0.30213757 -v -0.68621933 0.52995308 0.30213757 -v -0.34310966 0.77923684 0.30213757 -v 0.34310966 0.77923684 0.30213757 -v 0.68621933 0.52995308 0.30213757 -v 0.89827276 -0.12268028 0.30213757 -v 0.76721653 -0.52602989 0.30213757 -v 0.21205343 -0.92937949 0.30213757 -v 0.00000000 -0.99827982 -0.05862928 -v -0.55516310 -0.81789640 0.07917139 -v -0.89827276 0.23808657 0.07917139 -v 0.00000000 0.89071993 0.07917139 -v 0.89827276 0.23808657 0.07917139 -v 0.55516310 -0.81789640 0.07917139 -v -0.34310966 -0.88679674 -0.28159546 -v -0.21205343 -0.70641331 -0.64236231 -v -0.21205343 -0.34564646 -0.86532848 -v -0.34310967 0.05770314 -0.86532848 -v -0.55516310 0.34956965 -0.64236231 -v -0.76721653 0.41846999 -0.28159546 -v 0.34310966 -0.88679674 -0.28159546 -v 0.21205343 -0.70641331 -0.64236231 -v 0.21205343 -0.34564646 -0.86532848 -v 0.34310966 0.05770314 -0.86532848 -v 0.55516310 0.34956965 -0.64236231 -v 0.76721653 0.41846999 -0.28159546 -v -0.00000000 0.30698691 -0.86532848 -v -0.21205344 0.59885342 -0.64236231 -v 0.21205343 0.59885342 -0.64236231 -v -0.21205343 0.82181959 -0.28159546 -v 0.21205343 0.82181959 -0.28159546 -v 0.55516310 0.71033651 -0.05862928 -v -0.55516310 0.71033650 -0.05862928 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 9 8 7 6 5 4 3 2 -f 2 3 13 12 -f 3 4 14 23 13 -f 4 5 15 14 -f 5 6 16 24 15 -f 6 7 17 16 -f 7 8 18 25 17 -f 8 9 19 18 -f 9 10 20 26 19 -f 11 22 27 21 -f 11 21 20 -f 12 13 23 32 31 30 29 28 27 22 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 26 33 34 35 36 37 38 25 -f 20 21 33 26 -f 21 27 28 34 33 -f 24 43 42 -f 28 29 35 34 -f 29 30 39 36 35 -f 30 31 40 39 -f 31 32 45 42 40 -f 36 39 41 37 -f 37 41 43 44 38 -f 39 40 41 -f 40 42 43 41 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n84.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n84.obj deleted file mode 100644 index 99140d2c..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n84.obj +++ /dev/null @@ -1,20 +0,0 @@ -v -0.75649990 -0.43676533 0.48676866 -v -0.21875602 -0.92678633 -0.30530764 -v -0.21875602 0.49463440 0.48676866 -v -0.57471845 0.07921625 -0.43918622 -v 0.47448656 -0.13708534 -0.53435131 -v 0.14100681 0.88189762 -0.44985925 -v 0.31898787 -0.43676533 0.48676866 -v 0.83424915 0.48165406 0.26839843 -f 1 2 7 -f 1 7 3 -f 1 3 4 -f 1 4 2 -f 2 4 5 -f 2 5 7 -f 3 7 8 -f 3 8 6 -f 3 6 4 -f 4 6 5 -f 5 6 8 -f 5 8 7 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n85.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n85.obj deleted file mode 100644 index 88e6e2d9..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n85.obj +++ /dev/null @@ -1,42 +0,0 @@ -v -0.40739095 -0.40739110 0.55150049 -v -0.40739095 0.40739118 0.55150049 -v 0.40739133 0.40739118 0.55150049 -v 0.40739133 -0.40739110 0.55150049 -v -0.69897385 -0.69897400 -0.15122917 -v -0.98849816 0.00000004 0.15122929 -v -0.69897385 0.69897408 -0.15122917 -v 0.00000019 0.98849838 0.15122929 -v 0.69897423 0.69897408 -0.15122917 -v 0.98849853 0.00000004 0.15122929 -v 0.69897423 -0.69897400 -0.15122917 -v 0.00000019 -0.98849831 0.15122929 -v -0.57613626 0.00000004 -0.55149955 -v -0.00000043 0.57614036 -0.55150182 -v 0.57613486 -0.00000057 -0.55149925 -v -0.00000043 -0.57614028 -0.55150182 -f 1 2 6 -f 1 6 5 -f 1 5 12 -f 1 12 4 -f 1 4 3 2 -f 2 3 8 -f 2 8 7 -f 2 7 6 -f 3 4 10 -f 3 10 9 -f 3 9 8 -f 4 12 11 -f 4 11 10 -f 5 6 13 -f 5 13 16 -f 5 16 12 -f 6 7 13 -f 7 8 14 -f 7 14 13 -f 8 9 14 -f 9 10 15 -f 9 15 14 -f 10 11 15 -f 11 12 16 -f 11 16 15 -f 13 14 15 16 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n86.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n86.obj deleted file mode 100644 index 0c12e8e4..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n86.obj +++ /dev/null @@ -1,24 +0,0 @@ -v 0.15389145 -0.79063961 -0.25122195 -v 0.15389145 0.79063935 -0.25122195 -v -0.08683237 0.00000121 -0.81691859 -v 0.76720476 -0.00000013 -0.29376075 -v -0.34687634 -0.50076793 0.56626173 -v -0.34687634 0.50076766 0.56626173 -v 0.65465925 -0.50076793 0.56626173 -v 0.65465925 0.50076766 0.56626173 -v -0.80186056 -0.50076793 -0.32596185 -v -0.80186056 0.50076766 -0.32596185 -f 1 3 4 -f 1 4 7 -f 1 7 5 -f 1 5 9 -f 1 9 3 -f 2 3 10 -f 2 10 6 -f 2 6 8 -f 2 8 4 -f 2 4 3 -f 3 9 10 -f 4 8 7 -f 5 7 8 6 -f 5 6 10 9 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n87.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n87.obj deleted file mode 100644 index d6f957ec..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n87.obj +++ /dev/null @@ -1,28 +0,0 @@ -v 0.11988005 -0.67749119 -0.31454842 -v 0.11988005 0.67749098 -0.31454842 -v -0.08639380 0.00000104 -0.79928823 -v 0.64542211 -0.00000010 -0.35099950 -v -0.30922289 -0.42910304 0.38594519 -v -0.30922289 0.42910283 0.38594519 -v 0.54898298 -0.42910304 0.38594519 -v 0.54898298 0.42910283 0.38594519 -v -0.69909432 -0.42910304 -0.37859230 -v -0.69909432 0.42910283 -0.37859230 -v 0.11988005 -0.00000010 0.99278838 -f 1 3 4 -f 1 4 7 -f 1 7 5 -f 1 5 9 -f 1 9 3 -f 2 3 10 -f 2 10 6 -f 2 6 8 -f 2 8 4 -f 2 4 3 -f 3 9 10 -f 4 8 7 -f 5 6 10 9 -f 5 7 11 -f 5 11 6 -f 6 11 8 -f 7 8 11 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n88.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n88.obj deleted file mode 100644 index 6b72d3ca..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n88.obj +++ /dev/null @@ -1,30 +0,0 @@ -v 0.38077489 -0.65068035 -0.28161977 -v 0.23971953 -0.00000007 -0.65071787 -v 0.69238902 0.00000073 -0.03866788 -v -0.17227827 -0.97677286 0.12741658 -v -0.55290763 -0.38062943 0.40892884 -v -0.55290763 0.38062930 0.40892884 -v -0.17227827 0.97677272 0.12741658 -v 0.38077489 0.65068022 -0.28161977 -v -0.32999437 -0.38062943 -0.31896162 -v -0.32999437 0.38062930 -0.31896162 -v 0.20835110 -0.38062943 0.40892884 -v 0.20835110 0.38062930 0.40892884 -f 1 2 3 -f 1 3 11 -f 1 11 4 -f 1 4 9 -f 1 9 2 -f 2 9 10 -f 2 10 8 -f 2 8 3 -f 3 8 12 -f 3 12 11 -f 4 11 5 -f 4 5 9 -f 5 11 12 6 -f 5 6 10 9 -f 6 12 7 -f 6 7 10 -f 7 12 8 -f 7 8 10 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n89.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n89.obj deleted file mode 100644 index 0b5c2160..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n89.obj +++ /dev/null @@ -1,35 +0,0 @@ -v -0.44436584 -0.44436584 0.75893037 -v -0.44436584 0.44436584 0.75893037 -v 0.44436584 0.44436584 0.75893037 -v 0.44436584 -0.44436584 0.75893037 -v -0.97875646 0.00000000 0.20502633 -v 0.97875646 -0.00000000 0.20502633 -v -0.44436584 -0.63708304 -0.10865484 -v 0.44436584 -0.63708304 -0.10865484 -v -0.44436584 0.63708304 -0.10865484 -v 0.44436584 0.63708304 -0.10865484 -v -0.74267577 0.00000000 -0.65177582 -v 0.74267577 -0.00000000 -0.65177582 -v -0.00000000 -0.44436731 -0.85380157 -v 0.00000000 0.44436731 -0.85380157 -f 1 2 5 -f 1 5 7 -f 1 7 8 4 -f 1 4 3 2 -f 2 3 10 9 -f 2 9 5 -f 3 4 6 -f 3 6 10 -f 4 8 6 -f 5 9 11 -f 5 11 7 -f 6 8 12 -f 6 12 10 -f 7 11 13 -f 7 13 8 -f 8 13 12 -f 9 10 14 -f 9 14 11 -f 10 12 14 -f 11 14 13 -f 12 13 14 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n90.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n90.obj deleted file mode 100644 index 12cea9c9..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n90.obj +++ /dev/null @@ -1,40 +0,0 @@ -v -0.41242387 -0.58439230 0.69885062 -v 0.41242321 -0.58439230 0.69885062 -v -0.41242387 0.24045478 0.69885062 -v 0.41242321 0.24045478 0.69885062 -v -0.41242387 -0.73037469 -0.11297563 -v 0.41242321 -0.73037469 -0.11297563 -v -0.92917625 -0.17196876 0.20565034 -v 0.92917559 -0.17196876 0.20565034 -v -0.63276502 0.56134326 -0.02837223 -v 0.63276436 0.56134326 -0.02837223 -v -0.63276502 -0.07142283 -0.55750338 -v 0.63276436 -0.07142283 -0.55750338 -v -0.00000033 -0.54083237 -0.80170870 -v 0.00000232 0.26800856 -0.96341536 -v 0.00000232 0.90077466 -0.43428421 -v -0.00000033 0.88477025 0.39040759 -f 1 2 4 3 -f 1 3 7 -f 1 7 5 -f 1 5 6 2 -f 2 6 8 -f 2 8 4 -f 3 4 16 -f 3 16 9 -f 3 9 7 -f 4 8 10 -f 4 10 16 -f 5 7 11 -f 5 11 13 -f 5 13 6 -f 6 13 12 -f 6 12 8 -f 7 9 11 -f 8 12 10 -f 9 16 15 -f 9 15 14 11 -f 10 12 14 15 -f 10 15 16 -f 11 14 13 -f 12 13 14 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n91.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n91.obj deleted file mode 100644 index 8fa9e15a..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n91.obj +++ /dev/null @@ -1,28 +0,0 @@ -v -0.35682209 -0.79465447 0.49112347 -v 0.35682209 -0.79465447 0.49112347 -v 0.57735027 -0.49112347 -0.11593853 -v -0.00000000 -0.30353100 -0.49112347 -v -0.57735027 -0.49112347 -0.11593853 -v -0.57735027 -0.11593852 0.49112347 -v 0.57735027 -0.11593853 0.49112347 -v 0.57735027 0.11593853 -0.49112347 -v -0.57735027 0.11593853 -0.49112347 -v 0.00000000 0.30353100 0.49112347 -v 0.57735027 0.49112347 0.11593853 -v 0.35682209 0.79465447 -0.49112347 -v -0.35682209 0.79465447 -0.49112347 -v -0.57735027 0.49112347 0.11593852 -f 1 2 7 10 6 -f 1 6 5 -f 1 5 4 3 2 -f 2 3 7 -f 3 4 8 -f 3 8 11 7 -f 4 5 9 -f 4 9 13 12 8 -f 5 6 14 9 -f 6 10 14 -f 7 11 10 -f 8 12 11 -f 9 14 13 -f 10 11 12 13 14 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n92.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n92.obj deleted file mode 100644 index 1f85374b..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/n92.obj +++ /dev/null @@ -1,38 +0,0 @@ -v -0.33030437 -0.57210395 -0.43569542 -v 0.33030437 -0.57210395 -0.43569542 -v 0.66060874 0.00000000 -0.43569542 -v 0.33030437 0.57210395 -0.43569542 -v -0.33030437 0.57210395 -0.43569542 -v -0.66060874 -0.00000000 -0.43569542 -v -0.53444370 -0.68996385 0.18142700 -v 0.00000000 -0.99852506 -0.05429279 -v 0.53444370 -0.68996385 0.18142700 -v 0.86474807 -0.11785990 0.18142700 -v 0.86474807 0.49926253 -0.05429279 -v 0.33030437 0.80782374 0.18142700 -v -0.33030437 0.80782374 0.18142700 -v -0.86474807 0.49926253 -0.05429279 -v -0.86474807 -0.11785990 0.18142700 -v -0.33030437 -0.19070132 0.56282964 -v 0.33030437 -0.19070132 0.56282964 -v 0.00000000 0.38140263 0.56282964 -f 1 2 8 -f 1 8 7 -f 1 7 15 6 -f 1 6 5 4 3 2 -f 2 3 10 9 -f 2 9 8 -f 3 4 11 -f 3 11 10 -f 4 5 13 12 -f 4 12 11 -f 5 6 14 -f 5 14 13 -f 6 15 14 -f 7 8 9 17 16 -f 7 16 15 -f 9 10 17 -f 10 11 12 18 17 -f 12 13 18 -f 13 14 15 16 18 -f 16 17 18 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p03.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p03.obj deleted file mode 100644 index 2dfa2604..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p03.obj +++ /dev/null @@ -1,11 +0,0 @@ -v -0.65465367 -0.37796447 0.65465367 -v 0.00000000 0.75592895 0.65465367 -v 0.65465367 -0.37796447 0.65465367 -v -0.65465367 -0.37796447 -0.65465367 -v 0.00000000 0.75592895 -0.65465367 -v 0.65465367 -0.37796447 -0.65465367 -f 1 2 5 4 -f 1 4 6 3 -f 1 3 2 -f 2 3 6 5 -f 4 5 6 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p04.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p04.obj deleted file mode 100644 index c42c1d1f..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p04.obj +++ /dev/null @@ -1,14 +0,0 @@ -v -0.57735027 -0.57735027 0.57735027 -v -0.57735027 0.57735027 0.57735027 -v 0.57735027 0.57735027 0.57735027 -v 0.57735027 -0.57735027 0.57735027 -v -0.57735027 -0.57735027 -0.57735027 -v -0.57735027 0.57735027 -0.57735027 -v 0.57735027 0.57735027 -0.57735027 -v 0.57735027 -0.57735027 -0.57735027 -f 1 2 6 5 -f 1 5 8 4 -f 1 4 3 2 -f 2 3 7 6 -f 3 4 8 7 -f 5 6 7 8 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p05.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p05.obj deleted file mode 100644 index e7731809..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p05.obj +++ /dev/null @@ -1,17 +0,0 @@ -v -0.50673185 -0.69745656 0.50673185 -v -0.81990936 0.26640470 0.50673185 -v 0.00000000 0.86210372 0.50673185 -v 0.81990936 0.26640470 0.50673185 -v 0.50673185 -0.69745656 0.50673185 -v -0.50673185 -0.69745656 -0.50673185 -v -0.81990936 0.26640470 -0.50673185 -v 0.00000000 0.86210372 -0.50673185 -v 0.81990936 0.26640470 -0.50673185 -v 0.50673185 -0.69745656 -0.50673185 -f 1 2 7 6 -f 1 6 10 5 -f 1 5 4 3 2 -f 2 3 8 7 -f 3 4 9 8 -f 4 5 10 9 -f 6 7 8 9 10 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p06.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p06.obj deleted file mode 100644 index 6b1fc4e7..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p06.obj +++ /dev/null @@ -1,20 +0,0 @@ -v -0.44721360 -0.77459667 0.44721360 -v -0.89442719 0.00000000 0.44721360 -v -0.44721360 0.77459667 0.44721360 -v 0.44721360 0.77459667 0.44721360 -v 0.89442719 -0.00000000 0.44721360 -v 0.44721360 -0.77459667 0.44721360 -v -0.44721360 -0.77459667 -0.44721360 -v -0.89442719 0.00000000 -0.44721360 -v -0.44721360 0.77459667 -0.44721360 -v 0.44721360 0.77459667 -0.44721360 -v 0.89442719 -0.00000000 -0.44721360 -v 0.44721360 -0.77459667 -0.44721360 -f 1 2 8 7 -f 1 7 12 6 -f 1 6 5 4 3 2 -f 2 3 9 8 -f 3 4 10 9 -f 4 5 11 10 -f 5 6 12 11 -f 7 8 9 10 11 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p07.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p07.obj deleted file mode 100644 index b11e3f11..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p07.obj +++ /dev/null @@ -1,23 +0,0 @@ -v -0.39803250 -0.82652300 0.39803250 -v -0.89437090 -0.20413432 0.39803250 -v -0.71722978 0.57197166 0.39803250 -v 0.00000000 0.91737132 0.39803250 -v 0.71722978 0.57197166 0.39803250 -v 0.89437090 -0.20413432 0.39803250 -v 0.39803250 -0.82652300 0.39803250 -v -0.39803250 -0.82652300 -0.39803250 -v -0.89437090 -0.20413432 -0.39803250 -v -0.71722978 0.57197166 -0.39803250 -v 0.00000000 0.91737132 -0.39803250 -v 0.71722978 0.57197166 -0.39803250 -v 0.89437090 -0.20413432 -0.39803250 -v 0.39803250 -0.82652300 -0.39803250 -f 1 2 9 8 -f 1 8 14 7 -f 1 7 6 5 4 3 2 -f 2 3 10 9 -f 3 4 11 10 -f 4 5 12 11 -f 5 6 13 12 -f 6 7 14 13 -f 8 9 10 11 12 13 14 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p08.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p08.obj deleted file mode 100644 index 3b99bc23..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p08.obj +++ /dev/null @@ -1,26 +0,0 @@ -v -0.35740674 -0.86285621 0.35740674 -v -0.86285621 -0.35740674 0.35740674 -v -0.86285621 0.35740674 0.35740674 -v -0.35740674 0.86285621 0.35740674 -v 0.35740674 0.86285621 0.35740674 -v 0.86285621 0.35740674 0.35740674 -v 0.86285621 -0.35740674 0.35740674 -v 0.35740674 -0.86285621 0.35740674 -v -0.35740674 -0.86285621 -0.35740674 -v -0.86285621 -0.35740674 -0.35740674 -v -0.86285621 0.35740674 -0.35740674 -v -0.35740674 0.86285621 -0.35740674 -v 0.35740674 0.86285621 -0.35740674 -v 0.86285621 0.35740674 -0.35740674 -v 0.86285621 -0.35740674 -0.35740674 -v 0.35740674 -0.86285621 -0.35740674 -f 1 2 10 9 -f 1 9 16 8 -f 1 8 7 6 5 4 3 2 -f 2 3 11 10 -f 3 4 12 11 -f 4 5 13 12 -f 5 6 14 13 -f 6 7 15 14 -f 7 8 16 15 -f 9 10 11 12 13 14 15 16 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p09.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p09.obj deleted file mode 100644 index e00153ab..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p09.obj +++ /dev/null @@ -1,29 +0,0 @@ -v -0.32361558 -0.88912649 0.32361558 -v -0.81942341 -0.47309432 0.32361558 -v -0.93181392 0.16430393 0.32361558 -v -0.60819834 0.72482256 0.32361558 -v 0.00000000 0.94618865 0.32361558 -v 0.60819834 0.72482256 0.32361558 -v 0.93181392 0.16430393 0.32361558 -v 0.81942341 -0.47309432 0.32361558 -v 0.32361558 -0.88912649 0.32361558 -v -0.32361558 -0.88912649 -0.32361558 -v -0.81942341 -0.47309432 -0.32361558 -v -0.93181392 0.16430393 -0.32361558 -v -0.60819834 0.72482256 -0.32361558 -v 0.00000000 0.94618865 -0.32361558 -v 0.60819834 0.72482256 -0.32361558 -v 0.93181392 0.16430393 -0.32361558 -v 0.81942341 -0.47309432 -0.32361558 -v 0.32361558 -0.88912649 -0.32361558 -f 1 2 11 10 -f 1 10 18 9 -f 1 9 8 7 6 5 4 3 2 -f 2 3 12 11 -f 3 4 13 12 -f 4 5 14 13 -f 5 6 15 14 -f 6 7 16 15 -f 7 8 17 16 -f 8 9 18 17 -f 10 11 12 13 14 15 16 17 18 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p10.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p10.obj deleted file mode 100644 index 31941eda..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/p10.obj +++ /dev/null @@ -1,32 +0,0 @@ -v -0.29524181 -0.90866085 0.29524181 -v -0.77295309 -0.56158329 0.29524181 -v -0.95542256 0.00000000 0.29524181 -v -0.77295309 0.56158329 0.29524181 -v -0.29524181 0.90866085 0.29524181 -v 0.29524181 0.90866085 0.29524181 -v 0.77295309 0.56158329 0.29524181 -v 0.95542256 -0.00000000 0.29524181 -v 0.77295309 -0.56158329 0.29524181 -v 0.29524181 -0.90866085 0.29524181 -v -0.29524181 -0.90866085 -0.29524181 -v -0.77295309 -0.56158329 -0.29524181 -v -0.95542256 0.00000000 -0.29524181 -v -0.77295309 0.56158329 -0.29524181 -v -0.29524181 0.90866085 -0.29524181 -v 0.29524181 0.90866085 -0.29524181 -v 0.77295309 0.56158329 -0.29524181 -v 0.95542256 -0.00000000 -0.29524181 -v 0.77295309 -0.56158329 -0.29524181 -v 0.29524181 -0.90866085 -0.29524181 -f 1 2 12 11 -f 1 11 20 10 -f 1 10 9 8 7 6 5 4 3 2 -f 2 3 13 12 -f 3 4 14 13 -f 4 5 15 14 -f 5 6 16 15 -f 6 7 17 16 -f 7 8 18 17 -f 8 9 19 18 -f 9 10 20 19 -f 11 12 13 14 15 16 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r01.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r01.obj deleted file mode 100644 index 2edf33c5..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r01.obj +++ /dev/null @@ -1,8 +0,0 @@ -v -0.81649658 -0.47140452 0.33333333 -v 0.81649658 -0.47140452 0.33333333 -v 0.00000000 0.00000000 -1.00000000 -v 0.00000000 0.94280904 0.33333333 -f 1 2 4 -f 1 4 3 -f 1 3 2 -f 2 3 4 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r02.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r02.obj deleted file mode 100644 index 85bbede8..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r02.obj +++ /dev/null @@ -1,14 +0,0 @@ -v -0.70710678 -0.70710678 0.00000000 -v -0.70710678 0.70710678 0.00000000 -v 0.70710678 0.70710678 0.00000000 -v 0.70710678 -0.70710678 0.00000000 -v 0.00000000 0.00000000 -1.00000000 -v 0.00000000 0.00000000 1.00000000 -f 1 2 5 -f 1 5 4 -f 1 4 6 -f 1 6 2 -f 2 3 5 -f 2 6 3 -f 3 4 5 -f 3 6 4 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r03.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r03.obj deleted file mode 100644 index c42c1d1f..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r03.obj +++ /dev/null @@ -1,14 +0,0 @@ -v -0.57735027 -0.57735027 0.57735027 -v -0.57735027 0.57735027 0.57735027 -v 0.57735027 0.57735027 0.57735027 -v 0.57735027 -0.57735027 0.57735027 -v -0.57735027 -0.57735027 -0.57735027 -v -0.57735027 0.57735027 -0.57735027 -v 0.57735027 0.57735027 -0.57735027 -v 0.57735027 -0.57735027 -0.57735027 -f 1 2 6 5 -f 1 5 8 4 -f 1 4 3 2 -f 2 3 7 6 -f 3 4 8 7 -f 5 6 7 8 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r04.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r04.obj deleted file mode 100644 index 56a0c40c..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r04.obj +++ /dev/null @@ -1,32 +0,0 @@ -v -0.35682209 -0.49112347 0.79465447 -v 0.35682209 -0.49112347 0.79465447 -v 0.57735027 -0.79465447 0.18759247 -v 0.00000000 -0.98224695 -0.18759247 -v -0.57735027 -0.79465447 0.18759247 -v -0.57735027 0.18759247 0.79465447 -v 0.57735027 0.18759247 0.79465447 -v 0.93417236 -0.30353100 -0.18759247 -v -0.00000000 -0.60706200 -0.79465447 -v -0.93417236 -0.30353100 -0.18759247 -v -0.93417236 0.30353100 0.18759247 -v 0.00000000 0.60706200 0.79465447 -v 0.93417236 0.30353100 0.18759247 -v 0.57735027 -0.18759247 -0.79465447 -v -0.57735027 -0.18759247 -0.79465447 -v -0.57735027 0.79465447 -0.18759247 -v 0.00000000 0.98224695 0.18759247 -v 0.57735027 0.79465447 -0.18759247 -v 0.35682209 0.49112347 -0.79465447 -v -0.35682209 0.49112347 -0.79465447 -f 1 2 7 12 6 -f 1 6 11 10 5 -f 1 5 4 3 2 -f 2 3 8 13 7 -f 3 4 9 14 8 -f 4 5 10 15 9 -f 6 12 17 16 11 -f 7 13 18 17 12 -f 8 14 19 18 13 -f 9 15 20 19 14 -f 10 11 16 20 15 -f 16 17 18 19 20 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r05.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r05.obj deleted file mode 100644 index fd013dc2..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/r05.obj +++ /dev/null @@ -1,32 +0,0 @@ -v -0.52573111 -0.72360680 0.44721360 -v -0.85065081 0.27639320 0.44721360 -v -0.00000000 0.89442719 0.44721360 -v 0.85065081 0.27639320 0.44721360 -v 0.52573111 -0.72360680 0.44721360 -v 0.00000000 -0.89442719 -0.44721360 -v -0.85065081 -0.27639320 -0.44721360 -v -0.52573111 0.72360680 -0.44721360 -v 0.52573111 0.72360680 -0.44721360 -v 0.85065081 -0.27639320 -0.44721360 -v 0.00000000 0.00000000 1.00000000 -v -0.00000000 0.00000000 -1.00000000 -f 1 2 7 -f 1 7 6 -f 1 6 5 -f 1 5 11 -f 1 11 2 -f 2 3 8 -f 2 8 7 -f 2 11 3 -f 3 4 9 -f 3 9 8 -f 3 11 4 -f 4 5 10 -f 4 10 9 -f 4 11 5 -f 5 6 10 -f 6 7 12 -f 6 12 10 -f 7 8 12 -f 8 9 12 -f 9 10 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s01.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s01.obj deleted file mode 100644 index f493d9c7..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s01.obj +++ /dev/null @@ -1,26 +0,0 @@ -v -0.50000000 -0.86602540 -0.00000000 -v -1.00000000 0.00000000 -0.00000000 -v -0.50000000 0.86602540 -0.00000000 -v 0.50000000 0.86602540 -0.00000000 -v 1.00000000 0.00000000 -0.00000000 -v 0.50000000 -0.86602540 -0.00000000 -v -0.50000000 -0.28867513 -0.81649658 -v 0.00000000 0.57735027 -0.81649658 -v 0.50000000 -0.28867513 -0.81649658 -v 0.00000000 -0.57735027 0.81649658 -v 0.50000000 0.28867513 0.81649658 -v -0.50000000 0.28867513 0.81649658 -f 1 2 7 -f 1 7 9 6 -f 1 6 10 -f 1 10 12 2 -f 2 3 8 7 -f 2 12 3 -f 3 4 8 -f 3 12 11 4 -f 4 5 9 8 -f 4 11 5 -f 5 6 9 -f 5 11 10 6 -f 7 8 9 -f 10 11 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s02.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s02.obj deleted file mode 100644 index cc2dc6cb..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s02.obj +++ /dev/null @@ -1,62 +0,0 @@ -v -0.30901699 -0.95105652 -0.00000000 -v -0.80901699 -0.58778525 -0.00000000 -v -1.00000000 0.00000000 -0.00000000 -v -0.80901699 0.58778525 -0.00000000 -v -0.30901700 0.95105652 -0.00000000 -v 0.30901699 0.95105652 -0.00000000 -v 0.80901699 0.58778525 -0.00000000 -v 1.00000000 0.00000000 -0.00000000 -v 0.80901699 -0.58778525 -0.00000000 -v 0.30901699 -0.95105652 -0.00000000 -v 0.00000000 -0.85065081 -0.52573111 -v -0.80901699 -0.26286556 -0.52573111 -v -0.50000000 0.68819096 -0.52573111 -v 0.50000000 0.68819096 -0.52573111 -v 0.80901699 -0.26286556 -0.52573111 -v -0.30901699 -0.42532540 -0.85065081 -v -0.50000000 0.16245985 -0.85065081 -v 0.00000000 0.52573111 -0.85065081 -v 0.50000000 0.16245985 -0.85065081 -v 0.30901699 -0.42532540 -0.85065081 -v -0.50000000 -0.68819096 0.52573111 -v 0.50000000 -0.68819096 0.52573111 -v 0.80901699 0.26286556 0.52573111 -v -0.00000000 0.85065081 0.52573111 -v -0.80901699 0.26286556 0.52573111 -v 0.00000000 -0.52573111 0.85065081 -v 0.50000000 -0.16245985 0.85065081 -v 0.30901699 0.42532540 0.85065081 -v -0.30901699 0.42532540 0.85065081 -v -0.50000000 -0.16245985 0.85065081 -f 1 2 12 16 11 -f 1 11 10 -f 1 10 22 26 21 -f 1 21 2 -f 2 3 12 -f 2 21 30 25 3 -f 3 4 13 17 12 -f 3 25 4 -f 4 5 13 -f 4 25 29 24 5 -f 5 6 14 18 13 -f 5 24 6 -f 6 7 14 -f 6 24 28 23 7 -f 7 8 15 19 14 -f 7 23 8 -f 8 9 15 -f 8 23 27 22 9 -f 9 10 11 20 15 -f 9 22 10 -f 11 16 20 -f 12 17 16 -f 13 18 17 -f 14 19 18 -f 15 20 19 -f 16 17 18 19 20 -f 21 26 30 -f 22 27 26 -f 23 28 27 -f 24 29 28 -f 25 30 29 -f 26 27 28 29 30 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s03.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s03.obj deleted file mode 100644 index 0663c724..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s03.obj +++ /dev/null @@ -1,20 +0,0 @@ -v -0.42640143 -0.73854895 0.52223297 -v -0.85280287 0.00000000 0.52223297 -v -0.42640143 0.73854895 0.52223297 -v 0.42640143 0.73854895 0.52223297 -v 0.85280287 -0.00000000 0.52223297 -v 0.42640143 -0.73854895 0.52223297 -v -0.85280287 -0.49236596 -0.17407766 -v 0.00000000 0.98473193 -0.17407766 -v 0.85280287 -0.49236596 -0.17407766 -v -0.42640143 -0.24618298 -0.87038828 -v 0.00000000 0.49236596 -0.87038828 -v 0.42640143 -0.24618298 -0.87038828 -f 1 2 7 -f 1 7 10 12 9 6 -f 1 6 5 4 3 2 -f 2 3 8 11 10 7 -f 3 4 8 -f 4 5 9 12 11 8 -f 5 6 9 -f 10 11 12 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s04.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s04.obj deleted file mode 100644 index 58e0fa0c..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s04.obj +++ /dev/null @@ -1,38 +0,0 @@ -v -0.31622777 -0.54772256 0.77459667 -v -0.63245553 0.00000000 0.77459667 -v -0.31622777 0.54772256 0.77459667 -v 0.31622777 0.54772256 0.77459667 -v 0.63245553 -0.00000000 0.77459667 -v 0.31622777 -0.54772256 0.77459667 -v -0.31622777 -0.91287093 0.25819889 -v -0.94868330 0.18257419 0.25819889 -v -0.63245553 0.73029674 0.25819889 -v 0.63245553 0.73029674 0.25819889 -v 0.94868330 0.18257419 0.25819889 -v 0.31622777 -0.91287093 0.25819889 -v -0.63245553 -0.73029674 -0.25819889 -v -0.94868330 -0.18257419 -0.25819889 -v -0.31622777 0.91287093 -0.25819889 -v 0.31622777 0.91287093 -0.25819889 -v 0.94868330 -0.18257419 -0.25819889 -v 0.63245553 -0.73029674 -0.25819889 -v -0.31622777 -0.54772256 -0.77459667 -v -0.63245553 0.00000000 -0.77459667 -v -0.31622777 0.54772256 -0.77459667 -v 0.31622777 0.54772256 -0.77459667 -v 0.63245553 -0.00000000 -0.77459667 -v 0.31622777 -0.54772256 -0.77459667 -f 1 7 12 6 -f 1 6 5 4 3 2 -f 1 2 8 14 13 7 -f 2 3 9 8 -f 3 4 10 16 15 9 -f 4 5 11 10 -f 5 6 12 18 17 11 -f 7 13 19 24 18 12 -f 8 9 15 21 20 14 -f 10 11 17 23 22 16 -f 13 14 20 19 -f 15 16 22 21 -f 17 18 24 23 -f 19 20 21 22 23 24 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s05.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s05.obj deleted file mode 100644 index a2ec5ff1..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s05.obj +++ /dev/null @@ -1,38 +0,0 @@ -v -0.28108464 -0.67859834 0.67859834 -v -0.67859834 -0.28108464 0.67859834 -v -0.67859834 0.28108464 0.67859834 -v -0.28108464 0.67859834 0.67859834 -v 0.28108464 0.67859834 0.67859834 -v 0.67859834 0.28108464 0.67859834 -v 0.67859834 -0.28108464 0.67859834 -v 0.28108464 -0.67859834 0.67859834 -v 0.00000000 -0.95968298 0.28108464 -v -0.95968298 0.00000000 0.28108464 -v 0.00000000 0.95968298 0.28108464 -v 0.95968298 -0.00000000 0.28108464 -v -0.00000000 -0.95968298 -0.28108464 -v -0.95968298 0.00000000 -0.28108464 -v 0.00000000 0.95968298 -0.28108464 -v 0.95968298 -0.00000000 -0.28108464 -v -0.28108464 -0.67859834 -0.67859834 -v -0.67859834 -0.28108464 -0.67859834 -v -0.67859834 0.28108464 -0.67859834 -v -0.28108464 0.67859834 -0.67859834 -v 0.28108464 0.67859834 -0.67859834 -v 0.67859834 0.28108464 -0.67859834 -v 0.67859834 -0.28108464 -0.67859834 -v 0.28108464 -0.67859834 -0.67859834 -f 1 2 10 14 18 17 13 9 -f 1 9 8 -f 1 8 7 6 5 4 3 2 -f 2 3 10 -f 3 4 11 15 20 19 14 10 -f 4 5 11 -f 5 6 12 16 22 21 15 11 -f 6 7 12 -f 7 8 9 13 24 23 16 12 -f 13 17 24 -f 14 19 18 -f 15 21 20 -f 16 23 22 -f 17 18 19 20 21 22 23 24 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s06.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s06.obj deleted file mode 100644 index 4167cae1..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s06.obj +++ /dev/null @@ -1,92 +0,0 @@ -v -0.20177411 -0.27771823 0.93923362 -v -0.40354821 -0.55543646 0.72707577 -v -0.20177411 -0.83315470 0.51491792 -v 0.20177411 -0.83315470 0.51491792 -v 0.40354821 -0.55543646 0.72707577 -v 0.20177411 -0.27771823 0.93923362 -v -0.32647736 0.10607893 0.93923362 -v -0.65295472 0.21215785 0.72707577 -v -0.85472883 -0.06556038 0.51491792 -v -0.73002557 -0.44935754 0.51491792 -v -0.73002557 -0.66151539 0.17163931 -v -0.40354821 -0.89871508 0.17163931 -v -0.20177411 -0.96427546 -0.17163931 -v 0.20177411 -0.96427546 -0.17163931 -v 0.40354821 -0.89871508 0.17163931 -v 0.73002557 -0.66151539 0.17163931 -v 0.73002557 -0.44935754 0.51491792 -v 0.85472883 -0.06556038 0.51491792 -v 0.65295472 0.21215785 0.72707577 -v 0.32647736 0.10607893 0.93923362 -v -0.00000000 0.34327861 0.93923362 -v -0.65295472 0.55543646 0.51491792 -v -0.85472883 0.48987608 0.17163931 -v -0.97943209 0.10607893 0.17163931 -v -0.97943209 -0.10607892 -0.17163931 -v -0.85472883 -0.48987608 -0.17163931 -v -0.65295472 -0.55543646 -0.51491792 -v -0.32647736 -0.79263615 -0.51491792 -v -0.00000000 -0.68655723 -0.72707577 -v 0.32647736 -0.79263615 -0.51491792 -v 0.65295472 -0.55543646 -0.51491792 -v 0.85472883 -0.48987608 -0.17163931 -v 0.97943209 -0.10607893 -0.17163931 -v 0.97943209 0.10607893 0.17163931 -v 0.85472883 0.48987608 0.17163931 -v 0.65295472 0.55543646 0.51491792 -v 0.32647736 0.79263615 0.51491792 -v 0.00000000 0.68655723 0.72707577 -v -0.32647736 0.79263615 0.51491792 -v -0.73002557 0.66151539 -0.17163931 -v -0.73002557 0.44935754 -0.51491792 -v -0.85472883 0.06556038 -0.51491792 -v -0.65295472 -0.21215785 -0.72707577 -v -0.32647736 -0.10607892 -0.93923362 -v 0.00000000 -0.34327861 -0.93923362 -v 0.32647736 -0.10607892 -0.93923362 -v 0.65295472 -0.21215785 -0.72707577 -v 0.85472883 0.06556038 -0.51491792 -v 0.73002557 0.44935754 -0.51491792 -v 0.73002557 0.66151539 -0.17163931 -v 0.40354821 0.89871508 -0.17163931 -v 0.20177411 0.96427546 0.17163931 -v -0.20177411 0.96427546 0.17163931 -v -0.40354821 0.89871508 -0.17163931 -v -0.20177411 0.83315469 -0.51491792 -v -0.40354821 0.55543646 -0.72707577 -v -0.20177411 0.27771823 -0.93923362 -v 0.20177410 0.27771823 -0.93923362 -v 0.40354821 0.55543646 -0.72707577 -v 0.20177411 0.83315469 -0.51491792 -f 1 6 20 21 7 -f 1 7 8 9 10 2 -f 1 2 3 4 5 6 -f 2 10 11 12 3 -f 3 12 13 14 15 4 -f 4 15 16 17 5 -f 5 17 18 19 20 6 -f 7 21 38 39 22 8 -f 8 22 23 24 9 -f 9 24 25 26 11 10 -f 11 26 27 28 13 12 -f 13 28 29 30 14 -f 14 30 31 32 16 15 -f 16 32 33 34 18 17 -f 18 34 35 36 19 -f 19 36 37 38 21 20 -f 22 39 53 54 40 23 -f 23 40 41 42 25 24 -f 25 42 43 27 26 -f 27 43 44 45 29 28 -f 29 45 46 47 31 30 -f 31 47 48 33 32 -f 33 48 49 50 35 34 -f 35 50 51 52 37 36 -f 37 52 53 39 38 -f 40 54 55 56 41 -f 41 56 57 44 43 42 -f 44 57 58 46 45 -f 46 58 59 49 48 47 -f 49 59 60 51 50 -f 51 60 55 54 53 52 -f 55 60 59 58 57 56 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s07.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s07.obj deleted file mode 100644 index 5820f529..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s07.obj +++ /dev/null @@ -1,92 +0,0 @@ -v -0.16838141 -0.51822468 0.83850515 -v -0.44082824 -0.32028047 0.83850515 -v -0.54489368 0.00000000 0.83850515 -v -0.44082824 0.32028047 0.83850515 -v -0.16838141 0.51822468 0.83850515 -v 0.16838141 0.51822468 0.83850515 -v 0.44082824 0.32028047 0.83850515 -v 0.54489368 0.00000000 0.83850515 -v 0.44082824 -0.32028047 0.83850515 -v 0.16838141 -0.51822468 0.83850515 -v 0.00000000 -0.74998180 0.66145846 -v -0.00000000 -0.92702849 0.37499090 -v 0.16838141 -0.98173893 0.08852334 -v 0.44082824 -0.89321558 -0.08852334 -v 0.71327508 -0.69527137 -0.08852334 -v 0.88165649 -0.46351425 0.08852334 -v 0.88165649 -0.28646756 0.37499090 -v 0.71327508 -0.23175712 0.66145846 -v -0.16838141 -0.98173893 0.08852334 -v -0.44082824 -0.89321558 -0.08852334 -v -0.71327508 -0.69527137 -0.08852334 -v -0.88165649 -0.46351425 0.08852334 -v -0.88165649 -0.28646756 0.37499090 -v -0.71327508 -0.23175712 0.66145846 -v -0.98572192 -0.14323378 0.08852334 -v -0.98572192 0.14323378 -0.08852334 -v -0.88165649 0.46351425 -0.08852334 -v -0.71327508 0.69527137 0.08852334 -v -0.54489368 0.74998180 0.37499090 -v -0.44082824 0.60674802 0.66145846 -v -0.44082824 0.89321558 0.08852334 -v -0.16838141 0.98173893 -0.08852334 -v 0.16838141 0.98173893 -0.08852334 -v 0.44082824 0.89321558 0.08852334 -v 0.54489368 0.74998180 0.37499090 -v 0.44082824 0.60674802 0.66145846 -v 0.71327508 0.69527137 0.08852334 -v 0.88165649 0.46351425 -0.08852334 -v 0.98572192 0.14323378 -0.08852334 -v 0.98572192 -0.14323378 0.08852334 -v 0.54489368 -0.74998180 -0.37499090 -v 0.44082824 -0.60674802 -0.66145846 -v 0.16838141 -0.51822468 -0.83850515 -v -0.16838141 -0.51822468 -0.83850515 -v -0.44082824 -0.60674802 -0.66145846 -v -0.54489368 -0.74998180 -0.37499090 -v -0.44082824 -0.32028047 -0.83850515 -v -0.54489367 0.00000000 -0.83850515 -v -0.71327508 0.23175712 -0.66145846 -v -0.88165649 0.28646756 -0.37499090 -v -0.44082824 0.32028047 -0.83850515 -v -0.16838141 0.51822468 -0.83850515 -v 0.00000000 0.74998180 -0.66145846 -v 0.00000000 0.92702849 -0.37499090 -v 0.16838141 0.51822468 -0.83850515 -v 0.44082824 0.32028047 -0.83850515 -v 0.71327508 0.23175712 -0.66145846 -v 0.88165649 0.28646756 -0.37499090 -v 0.54489368 -0.00000000 -0.83850515 -v 0.44082824 -0.32028047 -0.83850515 -f 1 2 24 23 22 21 20 19 12 11 -f 1 11 10 -f 1 10 9 8 7 6 5 4 3 2 -f 2 3 24 -f 3 4 30 29 28 27 26 25 23 24 -f 4 5 30 -f 5 6 36 35 34 33 32 31 29 30 -f 6 7 36 -f 7 8 18 17 40 39 38 37 35 36 -f 8 9 18 -f 9 10 11 12 13 14 15 16 17 18 -f 12 19 13 -f 13 19 20 46 45 44 43 42 41 14 -f 14 41 15 -f 15 41 42 60 59 57 58 39 40 16 -f 16 40 17 -f 20 21 46 -f 21 22 25 26 50 49 48 47 45 46 -f 22 23 25 -f 26 27 50 -f 27 28 31 32 54 53 52 51 49 50 -f 28 29 31 -f 32 33 54 -f 33 34 37 38 58 57 56 55 53 54 -f 34 35 37 -f 38 39 58 -f 42 43 60 -f 43 44 47 48 51 52 55 56 59 60 -f 44 45 47 -f 48 49 51 -f 52 53 55 -f 56 57 59 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s08.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s08.obj deleted file mode 100644 index 8441f42c..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s08.obj +++ /dev/null @@ -1,50 +0,0 @@ -v -0.35740674 -0.86285621 0.35740674 -v -0.86285621 -0.35740674 0.35740674 -v -0.86285621 0.35740674 0.35740674 -v -0.35740674 0.86285621 0.35740674 -v 0.35740674 0.86285621 0.35740674 -v 0.86285621 0.35740674 0.35740674 -v 0.86285621 -0.35740674 0.35740674 -v 0.35740674 -0.86285621 0.35740674 -v -0.35740674 -0.86285621 -0.35740674 -v -0.86285621 -0.35740674 -0.35740674 -v -0.86285621 0.35740674 -0.35740674 -v -0.35740674 0.86285621 -0.35740674 -v 0.35740674 0.86285621 -0.35740674 -v 0.86285621 0.35740674 -0.35740674 -v 0.86285621 -0.35740674 -0.35740674 -v 0.35740674 -0.86285621 -0.35740674 -v -0.35740674 -0.35740674 0.86285621 -v 0.35740674 -0.35740674 0.86285621 -v 0.35740674 0.35740674 0.86285621 -v -0.35740674 0.35740674 0.86285621 -v -0.35740674 -0.35740674 -0.86285621 -v -0.35740674 0.35740674 -0.86285621 -v 0.35740674 0.35740674 -0.86285621 -v 0.35740674 -0.35740674 -0.86285621 -f 1 2 10 9 -f 1 9 16 8 -f 1 8 18 17 -f 1 17 2 -f 2 3 11 10 -f 2 17 20 3 -f 3 4 12 11 -f 3 20 4 -f 4 5 13 12 -f 4 20 19 5 -f 5 6 14 13 -f 5 19 6 -f 6 7 15 14 -f 6 19 18 7 -f 7 8 16 15 -f 7 18 8 -f 9 10 21 -f 9 21 24 16 -f 10 11 22 21 -f 11 12 22 -f 12 13 23 22 -f 13 14 23 -f 14 15 24 23 -f 15 16 24 -f 17 18 19 20 -f 21 22 23 24 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s09.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s09.obj deleted file mode 100644 index 40f8fdd8..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s09.obj +++ /dev/null @@ -1,122 +0,0 @@ -v -0.22391898 -0.68915176 0.68915176 -v -0.58622750 -0.42591921 0.68915176 -v -0.72461704 -0.00000000 0.68915176 -v -0.58622750 0.42591921 0.68915176 -v -0.22391898 0.68915176 0.68915176 -v 0.22391898 0.68915176 0.68915176 -v 0.58622750 0.42591921 0.68915176 -v 0.72461704 -0.00000000 0.68915176 -v 0.58622750 -0.42591921 0.68915176 -v 0.22391898 -0.68915176 0.68915176 -v -0.22391898 -0.92459411 0.30819804 -v -0.81014648 -0.49867490 0.30819804 -v -0.94853602 -0.07275569 0.30819804 -v -0.72461704 0.61639607 0.30819804 -v -0.36230852 0.87962862 0.30819804 -v 0.36230852 0.87962862 0.30819804 -v 0.72461704 0.61639607 0.30819804 -v 0.94853602 -0.07275569 0.30819804 -v 0.81014648 -0.49867490 0.30819804 -v 0.22391898 -0.92459411 0.30819804 -v 0.00000000 -0.99734979 -0.07275569 -v -0.58622750 -0.80687293 0.07275569 -v -0.94853602 0.30819804 0.07275569 -v 0.00000000 0.99734979 0.07275569 -v 0.94853602 0.30819803 0.07275569 -v 0.58622750 -0.80687293 0.07275569 -v -0.36230852 -0.87962862 -0.30819804 -v -0.22391898 -0.68915176 -0.68915176 -v -0.22391898 -0.30819804 -0.92459411 -v -0.36230852 0.11772117 -0.92459411 -v -0.58622750 0.42591921 -0.68915176 -v -0.81014648 0.49867490 -0.30819804 -v 0.36230852 -0.87962862 -0.30819804 -v 0.22391898 -0.68915176 -0.68915176 -v 0.22391898 -0.30819803 -0.92459411 -v 0.36230852 0.11772117 -0.92459411 -v 0.58622750 0.42591921 -0.68915176 -v 0.81014648 0.49867490 -0.30819804 -v -0.00000000 0.38095372 -0.92459410 -v -0.22391898 0.68915176 -0.68915176 -v 0.22391898 0.68915176 -0.68915176 -v -0.22391898 0.92459411 -0.30819804 -v 0.22391898 0.92459411 -0.30819804 -v 0.58622750 0.80687293 -0.07275569 -v -0.58622750 0.80687293 -0.07275569 -v 0.00000000 -0.38095372 0.92459411 -v 0.36230852 -0.11772117 0.92459411 -v 0.22391898 0.30819804 0.92459411 -v -0.22391898 0.30819804 0.92459411 -v -0.36230852 -0.11772117 0.92459411 -v -0.94853602 -0.30819804 -0.07275569 -v -0.94853602 0.07275569 -0.30819804 -v -0.72461704 -0.00000000 -0.68915176 -v -0.58622750 -0.42591921 -0.68915176 -v -0.72461704 -0.61639607 -0.30819804 -v 0.94853602 -0.30819804 -0.07275569 -v 0.72461704 -0.61639607 -0.30819804 -v 0.58622750 -0.42591921 -0.68915176 -v 0.72461704 0.00000000 -0.68915176 -v 0.94853602 0.07275569 -0.30819804 -f 1 2 12 22 11 -f 1 11 20 10 -f 1 10 46 -f 1 46 50 2 -f 2 3 13 12 -f 2 50 3 -f 3 4 14 23 13 -f 3 50 49 4 -f 4 5 15 14 -f 4 49 5 -f 5 6 16 24 15 -f 5 49 48 6 -f 6 7 17 16 -f 6 48 7 -f 7 8 18 25 17 -f 7 48 47 8 -f 8 9 19 18 -f 8 47 9 -f 9 10 20 26 19 -f 9 47 46 10 -f 11 22 27 21 -f 11 21 20 -f 12 13 51 -f 12 51 55 22 -f 13 23 52 51 -f 14 15 45 -f 14 45 32 23 -f 15 24 42 45 -f 16 17 44 -f 16 44 43 24 -f 17 25 38 44 -f 18 19 56 -f 18 56 60 25 -f 19 26 57 56 -f 20 21 33 26 -f 21 27 28 34 33 -f 22 55 27 -f 23 32 52 -f 24 43 42 -f 25 60 38 -f 26 33 57 -f 27 55 54 28 -f 28 29 35 34 -f 28 54 29 -f 29 30 39 36 35 -f 29 54 53 30 -f 30 31 40 39 -f 30 53 31 -f 31 32 45 42 40 -f 31 53 52 32 -f 33 34 58 57 -f 34 35 58 -f 35 36 59 58 -f 36 39 41 37 -f 36 37 59 -f 37 41 43 44 38 -f 37 38 60 59 -f 39 40 41 -f 40 42 43 41 -f 46 47 48 49 50 -f 51 52 53 54 55 -f 56 57 58 59 60 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s10.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s10.obj deleted file mode 100644 index c9027972..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s10.obj +++ /dev/null @@ -1,74 +0,0 @@ -v -0.21573941 -0.52084100 0.82594259 -v -0.52084100 -0.21573941 0.82594259 -v -0.52084100 0.21573941 0.82594259 -v -0.21573941 0.52084100 0.82594259 -v 0.21573941 0.52084100 0.82594259 -v 0.52084100 0.21573941 0.82594259 -v 0.52084100 -0.21573941 0.82594259 -v 0.21573941 -0.52084100 0.82594259 -v -0.21573941 -0.82594259 0.52084100 -v -0.82594259 -0.21573941 0.52084100 -v -0.82594259 0.21573941 0.52084100 -v -0.21573941 0.82594259 0.52084100 -v 0.21573941 0.82594259 0.52084100 -v 0.82594259 0.21573941 0.52084100 -v 0.82594259 -0.21573941 0.52084100 -v 0.21573941 -0.82594259 0.52084100 -v -0.52084100 -0.82594259 0.21573941 -v -0.82594259 -0.52084100 0.21573941 -v -0.82594259 0.52084100 0.21573941 -v -0.52084100 0.82594259 0.21573941 -v 0.52084100 0.82594259 0.21573941 -v 0.82594259 0.52084100 0.21573941 -v 0.82594259 -0.52084100 0.21573941 -v 0.52084100 -0.82594259 0.21573941 -v 0.52084100 -0.82594259 -0.21573941 -v 0.21573940 -0.82594259 -0.52084100 -v -0.21573941 -0.82594259 -0.52084100 -v -0.52084100 -0.82594259 -0.21573941 -v -0.82594259 -0.52084100 -0.21573941 -v -0.82594259 -0.21573941 -0.52084100 -v -0.82594259 0.21573941 -0.52084100 -v -0.82594259 0.52084100 -0.21573941 -v -0.52084100 0.82594259 -0.21573941 -v -0.21573941 0.82594259 -0.52084100 -v 0.21573941 0.82594259 -0.52084100 -v 0.52084100 0.82594259 -0.21573941 -v 0.82594259 0.52084100 -0.21573941 -v 0.82594259 0.21573941 -0.52084100 -v 0.82594259 -0.21573941 -0.52084100 -v 0.82594259 -0.52084100 -0.21573941 -v 0.52084100 -0.21573941 -0.82594259 -v 0.52084100 0.21573941 -0.82594259 -v 0.21573941 0.52084100 -0.82594259 -v -0.21573941 0.52084100 -0.82594259 -v -0.52084100 0.21573941 -0.82594259 -v -0.52084100 -0.21573941 -0.82594259 -v -0.21573941 -0.52084100 -0.82594259 -v 0.21573940 -0.52084100 -0.82594259 -f 1 2 10 18 17 9 -f 1 9 16 8 -f 1 8 7 6 5 4 3 2 -f 2 3 11 10 -f 3 4 12 20 19 11 -f 4 5 13 12 -f 5 6 14 22 21 13 -f 6 7 15 14 -f 7 8 16 24 23 15 -f 9 17 28 27 26 25 24 16 -f 10 11 19 32 31 30 29 18 -f 12 13 21 36 35 34 33 20 -f 14 15 23 40 39 38 37 22 -f 17 18 29 28 -f 19 20 33 32 -f 21 22 37 36 -f 23 24 25 40 -f 25 26 48 41 39 40 -f 26 27 47 48 -f 27 28 29 30 46 47 -f 30 31 45 46 -f 31 32 33 34 44 45 -f 34 35 43 44 -f 35 36 37 38 42 43 -f 38 39 41 42 -f 41 48 47 46 45 44 43 42 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s11.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s11.obj deleted file mode 100644 index 496cd08e..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s11.obj +++ /dev/null @@ -1,182 +0,0 @@ -v -0.13149606 -0.40470333 0.90494412 -v -0.34426119 -0.25012042 0.90494412 -v -0.42553024 -0.00000001 0.90494412 -v -0.34426119 0.25012040 0.90494412 -v -0.13149606 0.40470332 0.90494412 -v 0.13149611 0.40470332 0.90494412 -v 0.34426124 0.25012040 0.90494412 -v 0.42553028 -0.00000001 0.90494412 -v 0.34426124 -0.25012042 0.90494412 -v 0.13149611 -0.40470333 0.90494412 -v -0.13149606 -0.62841783 0.76668096 -v -0.34426119 -0.69754941 0.62841780 -v -0.42553024 -0.80940666 0.40470330 -v -0.34426119 -0.92126391 0.18098881 -v -0.13149606 -0.99039549 0.04272564 -v 0.13149611 -0.99039549 0.04272564 -v 0.34426124 -0.92126391 0.18098881 -v 0.42553028 -0.80940666 0.40470330 -v 0.34426124 -0.69754941 0.62841780 -v 0.13149611 -0.62841783 0.76668096 -v -0.55702632 -0.54296650 0.62841780 -v -0.55702632 -0.31925200 0.76668096 -v -0.63829537 -0.06913159 0.76668096 -v -0.76979145 0.11185724 0.62841780 -v -0.90128753 0.15458291 0.40470330 -v -0.98255658 0.04272566 0.18098880 -v -0.98255658 -0.18098884 0.04272564 -v -0.90128753 -0.43110925 0.04272564 -v -0.76979145 -0.61209808 0.18098881 -v -0.63829537 -0.65482375 0.40470330 -v -0.82001848 0.54296648 0.18098881 -v -0.82001848 0.40470332 0.40470330 -v -0.68852240 0.36197765 0.62841780 -v -0.47575727 0.43110923 0.76668096 -v -0.26299214 0.58569215 0.76668096 -v -0.13149606 0.76668098 0.62841780 -v -0.13149606 0.90494414 0.40470330 -v -0.26299214 0.94766981 0.18098881 -v -0.47575727 0.87853823 0.04272564 -v -0.68852240 0.72395531 0.04272564 -v 0.47575732 0.87853821 0.04272564 -v 0.26299219 0.94766979 0.18098880 -v 0.13149611 0.90494413 0.40470330 -v 0.13149611 0.76668098 0.62841780 -v 0.26299219 0.58569215 0.76668096 -v 0.47575732 0.43110923 0.76668096 -v 0.68852245 0.36197765 0.62841780 -v 0.82001853 0.40470330 0.40470331 -v 0.82001853 0.54296646 0.18098881 -v 0.68852245 0.72395529 0.04272564 -v 0.63829541 -0.65482375 0.40470330 -v 0.76979150 -0.61209808 0.18098881 -v 0.90128758 -0.43110925 0.04272564 -v 0.98255663 -0.18098884 0.04272564 -v 0.98255647 0.04272561 0.18098879 -v 0.90128750 0.15458288 0.40470331 -v 0.76979150 0.11185724 0.62841780 -v 0.63829541 -0.06913159 0.76668096 -v 0.55702637 -0.31925200 0.76668096 -v 0.55702637 -0.54296650 0.62841780 -v -0.47575727 -0.87853824 -0.04272569 -v -0.68852240 -0.72395533 -0.04272569 -v -0.82001848 -0.54296650 -0.18098886 -v -0.82001848 -0.40470333 -0.40470335 -v -0.68852240 -0.36197767 -0.62841785 -v -0.47575727 -0.43110925 -0.76668101 -v -0.26299214 -0.58569216 -0.76668101 -v -0.13149605 -0.76668099 -0.62841784 -v -0.13149606 -0.90494416 -0.40470335 -v -0.26299214 -0.94766982 -0.18098885 -v -0.90128753 -0.15458292 -0.40470335 -v -0.98255658 -0.04272567 -0.18098885 -v -0.98255658 0.18098882 -0.04272569 -v -0.90128753 0.43110923 -0.04272569 -v -0.76979145 0.61209806 -0.18098885 -v -0.63829536 0.65482373 -0.40470335 -v -0.55702632 0.54296648 -0.62841785 -v -0.55702632 0.31925199 -0.76668101 -v -0.63829537 0.06913157 -0.76668101 -v -0.76979145 -0.11185726 -0.62841785 -v -0.13149606 0.62841781 -0.76668101 -v -0.34426119 0.69754940 -0.62841785 -v -0.42553023 0.80940665 -0.40470335 -v -0.34426119 0.92126389 -0.18098885 -v -0.13149606 0.99039547 -0.04272569 -v 0.13149611 0.99039546 -0.04272569 -v 0.34426124 0.92126387 -0.18098886 -v 0.42553028 0.80940661 -0.40470335 -v 0.34426124 0.69754939 -0.62841785 -v 0.13149611 0.62841781 -0.76668101 -v 0.76979153 -0.11185725 -0.62841782 -v 0.63829541 0.06913155 -0.76668097 -v 0.55702634 0.31925197 -0.76668097 -v 0.55702635 0.54296649 -0.62841782 -v 0.63829541 0.65482370 -0.40470335 -v 0.76979149 0.61209803 -0.18098885 -v 0.90128750 0.43110919 -0.04272571 -v 0.98255648 0.18098877 -0.04272572 -v 0.98255640 -0.04272561 -0.18098874 -v 0.90128711 -0.15458281 -0.40470320 -v 0.26299219 -0.94766982 -0.18098885 -v 0.13149611 -0.90494416 -0.40470335 -v 0.13149611 -0.76668098 -0.62841784 -v 0.26299219 -0.58569215 -0.76668099 -v 0.47575682 -0.43110886 -0.76668009 -v 0.68852237 -0.36197738 -0.62841730 -v 0.82001805 -0.40470325 -0.40470322 -v 0.82001853 -0.54296650 -0.18098885 -v 0.68852245 -0.72395533 -0.04272569 -v 0.47575732 -0.87853824 -0.04272569 -v -0.13149606 -0.40470333 -0.90494417 -v -0.34426119 -0.25012042 -0.90494417 -v -0.42553024 -0.00000000 -0.90494417 -v -0.34426119 0.25012040 -0.90494417 -v -0.13149606 0.40470332 -0.90494417 -v 0.13149611 0.40470332 -0.90494417 -v 0.34426120 0.25012038 -0.90494414 -v 0.42553027 -0.00000003 -0.90494414 -v 0.34426060 -0.25012001 -0.90494332 -v 0.13149611 -0.40470332 -0.90494416 -f 1 2 22 21 12 11 -f 1 11 20 10 -f 1 10 9 8 7 6 5 4 3 2 -f 2 3 23 22 -f 3 4 34 33 24 23 -f 4 5 35 34 -f 5 6 45 44 36 35 -f 6 7 46 45 -f 7 8 58 57 47 46 -f 8 9 59 58 -f 9 10 20 19 60 59 -f 11 12 13 14 15 16 17 18 19 20 -f 12 21 30 13 -f 13 30 29 62 61 14 -f 14 61 70 15 -f 15 70 69 102 101 16 -f 16 101 110 17 -f 17 110 109 52 51 18 -f 18 51 60 19 -f 21 22 23 24 25 26 27 28 29 30 -f 24 33 32 25 -f 25 32 31 74 73 26 -f 26 73 72 27 -f 27 72 71 64 63 28 -f 28 63 62 29 -f 31 32 33 34 35 36 37 38 39 40 -f 31 40 75 74 -f 36 44 43 37 -f 37 43 42 86 85 38 -f 38 85 84 39 -f 39 84 83 76 75 40 -f 41 42 43 44 45 46 47 48 49 50 -f 41 50 96 95 88 87 -f 41 87 86 42 -f 47 57 56 48 -f 48 56 55 98 97 49 -f 49 97 96 50 -f 51 52 53 54 55 56 57 58 59 60 -f 52 109 108 53 -f 53 108 107 100 99 54 -f 54 99 98 55 -f 61 62 63 64 65 66 67 68 69 70 -f 64 71 80 65 -f 65 80 79 113 112 66 -f 66 112 111 67 -f 67 111 120 104 103 68 -f 68 103 102 69 -f 71 72 73 74 75 76 77 78 79 80 -f 76 83 82 77 -f 77 82 81 115 114 78 -f 78 114 113 79 -f 81 82 83 84 85 86 87 88 89 90 -f 81 90 116 115 -f 88 95 94 89 -f 89 94 93 117 116 90 -f 91 92 93 94 95 96 97 98 99 100 -f 91 100 107 106 -f 91 106 105 119 118 92 -f 92 118 117 93 -f 101 102 103 104 105 106 107 108 109 110 -f 104 120 119 105 -f 111 112 113 114 115 116 117 118 119 120 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s12L.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s12L.obj deleted file mode 100644 index aaee84e5..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s12L.obj +++ /dev/null @@ -1,62 +0,0 @@ -v -0.37210275 -0.37210283 0.85033943 -v -0.37210275 0.37210284 0.85033943 -v 0.37210291 0.37210284 0.85033943 -v 0.37210291 -0.37210283 0.85033943 -v -0.68440375 -0.68440382 0.25135842 -v -0.88671195 0.00000000 0.46232019 -v -0.68440375 0.68440383 0.25135842 -v 0.00000008 0.88671203 0.46232019 -v 0.68440391 0.68440383 0.25135842 -v 0.88671211 0.00000000 0.46232019 -v 0.68440391 -0.68440382 0.25135842 -v 0.00000008 -0.88671202 0.46232019 -v -0.74420553 -0.48209560 -0.46232023 -v -0.94651373 0.20230822 -0.25135846 -v -0.48209559 0.74420581 -0.46232023 -v 0.20230824 0.94651401 -0.25135846 -v 0.74420550 0.48209553 -0.46232032 -v 0.94651368 -0.20230824 -0.25135852 -v 0.48209586 -0.74420614 -0.46232018 -v -0.20230823 -0.94651406 -0.25135841 -v -0.51460872 0.10999275 -0.85033925 -v 0.10999269 0.51461005 -0.85033999 -v 0.51460748 -0.10999294 -0.85033865 -v -0.10999264 -0.51460945 -0.85033947 -f 1 2 6 -f 1 6 5 -f 1 5 12 -f 1 12 4 -f 1 4 3 2 -f 2 3 8 -f 2 8 7 -f 2 7 6 -f 3 4 10 -f 3 10 9 -f 3 9 8 -f 4 12 11 -f 4 11 10 -f 5 6 14 13 -f 5 13 20 -f 5 20 12 -f 6 7 14 -f 7 8 16 15 -f 7 15 14 -f 8 9 16 -f 9 17 16 -f 9 10 18 17 -f 10 11 18 -f 11 12 20 19 -f 11 19 18 -f 13 14 21 -f 13 21 24 -f 13 24 20 -f 14 15 21 -f 15 16 22 -f 15 22 21 -f 16 17 22 -f 17 23 22 -f 17 18 23 -f 18 19 23 -f 19 20 24 -f 19 24 23 -f 21 22 23 24 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s12R.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s12R.obj deleted file mode 100644 index 8cdb06b6..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s12R.obj +++ /dev/null @@ -1,62 +0,0 @@ -v -0.37210283 -0.37210275 0.85033943 -v 0.37210284 -0.37210275 0.85033943 -v 0.37210284 0.37210291 0.85033943 -v -0.37210283 0.37210291 0.85033943 -v -0.68440382 -0.68440374 0.25135842 -v 0.00000000 -0.88671194 0.46232019 -v 0.68440383 -0.68440374 0.25135842 -v 0.88671203 0.00000008 0.46232019 -v 0.68440383 0.68440391 0.25135842 -v 0.00000001 0.88671211 0.46232019 -v -0.68440382 0.68440391 0.25135842 -v -0.88671202 0.00000008 0.46232019 -v -0.48209560 -0.74420553 -0.46232022 -v 0.20230822 -0.94651373 -0.25135846 -v 0.74420581 -0.48209559 -0.46232022 -v 0.94651401 0.20230824 -0.25135846 -v 0.48209553 0.74420550 -0.46232032 -v -0.20230824 0.94651368 -0.25135852 -v -0.74420614 0.48209586 -0.46232018 -v -0.94651406 -0.20230823 -0.25135841 -v 0.10999275 -0.51460872 -0.85033925 -v 0.51461005 0.10999269 -0.85033999 -v -0.10999294 0.51460747 -0.85033864 -v -0.51460944 -0.10999264 -0.85033947 -f 1 4 12 -f 1 12 5 -f 1 5 6 -f 1 6 2 -f 1 2 3 4 -f 2 6 7 -f 2 7 8 -f 2 8 3 -f 3 8 9 -f 3 9 10 -f 3 10 4 -f 4 10 11 -f 4 11 12 -f 5 12 20 -f 5 20 13 -f 5 13 14 6 -f 6 14 7 -f 7 14 15 -f 7 15 16 8 -f 8 16 9 -f 9 16 17 -f 9 17 18 10 -f 10 18 11 -f 11 18 19 -f 11 19 20 12 -f 13 20 24 -f 13 24 21 -f 13 21 14 -f 14 21 15 -f 15 21 22 -f 15 22 16 -f 16 22 17 -f 17 22 23 -f 17 23 18 -f 18 23 19 -f 19 23 24 -f 19 24 20 -f 21 24 23 22 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s13L.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s13L.obj deleted file mode 100644 index fe10910d..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s13L.obj +++ /dev/null @@ -1,152 +0,0 @@ -v -0.23192831 -0.31922195 0.91886098 -v -0.37526789 0.12193192 0.91886098 -v 0.00000001 0.39458001 0.91886098 -v 0.37526790 0.12193192 0.91886098 -v 0.23192832 -0.31922195 0.91886098 -v -0.64379514 -0.20918173 0.73605007 -v -0.72920227 0.23693218 0.64197045 -v -0.39788728 0.54764486 0.73605007 -v 0.00000001 0.76672864 0.64197045 -v 0.39788729 0.54764486 0.73605007 -v 0.72920229 0.23693218 0.64197045 -v 0.64379516 -0.20918173 0.73605007 -v 0.45067180 -0.62029652 0.64197045 -v 0.00000001 -0.67692629 0.73605007 -v -0.45067179 -0.62029652 0.64197045 -v -0.80031956 -0.46310151 0.38082081 -v -0.68774804 0.61804289 0.38082081 -v 0.37526790 0.84507302 0.38082081 -v 0.91967637 -0.09575906 0.38082081 -v 0.19312336 -0.90425538 0.38082081 -v -0.53607892 -0.81262648 0.22859680 -v -0.80975412 -0.58290795 -0.06719747 -v -0.98246410 -0.17391866 0.06719745 -v -0.93851120 0.25872595 0.22859680 -v -0.80460617 0.58999346 -0.06719747 -v -0.46900456 0.88063506 0.06719744 -v -0.04395289 0.97252791 0.22859680 -v 0.31248017 0.94754396 -0.06719747 -v 0.69260335 0.71818105 0.06719745 -v 0.91134683 0.34232934 0.22859680 -v 0.99772955 -0.00437911 -0.06719747 -v 0.89705698 -0.43677477 0.06719744 -v 0.60719621 -0.76095675 0.22859680 -v 0.30415062 -0.95025041 -0.06719747 -v -0.13819163 -0.98812271 0.06719745 -v -0.46900456 -0.85309854 -0.22859683 -v -0.89001331 -0.25070046 -0.38082083 -v -0.95627530 0.18242790 -0.22859683 -v -0.51345952 0.76898225 -0.38082083 -v -0.12200607 0.96584518 -0.22859683 -v 0.57267787 0.72595761 -0.38082083 -v 0.88087142 0.41449724 -0.22859683 -v 0.86739393 -0.32031578 -0.38082083 -v 0.66641454 -0.70967180 -0.22859683 -v -0.03659893 -0.92392370 -0.38082084 -v -0.33866894 -0.68787802 -0.64197048 -v -0.59886666 -0.31557553 -0.73605009 -v -0.75886533 0.10952730 -0.64197048 -v -0.48519013 0.47203783 -0.73605009 -v -0.13033561 0.75556961 -0.64197047 -v 0.29900267 0.60731094 -0.73605008 -v 0.67831351 0.35744039 -0.64197048 -v 0.66998396 -0.09669904 -0.73605009 -v 0.54955640 -0.53465933 -0.64197049 -v 0.11507018 -0.66707429 -0.73605010 -v -0.17428848 -0.35400123 -0.91886092 -v -0.39053340 0.05636580 -0.91886108 -v -0.06707427 0.38883710 -0.91886080 -v 0.34907940 0.18394910 -0.91886141 -v 0.28281632 -0.27515023 -0.91886006 -f 1 2 6 -f 1 6 15 -f 1 15 14 -f 1 14 5 -f 1 5 4 3 2 -f 2 3 8 -f 2 8 7 -f 2 7 6 -f 3 4 10 -f 3 10 9 -f 3 9 8 -f 4 5 12 -f 4 12 11 -f 4 11 10 -f 5 14 13 -f 5 13 12 -f 6 7 24 23 16 -f 6 16 15 -f 7 8 17 -f 7 17 24 -f 8 9 27 26 17 -f 9 10 18 -f 9 18 27 -f 10 11 30 29 18 -f 11 12 19 -f 11 19 30 -f 12 13 33 32 19 -f 13 14 20 -f 13 20 33 -f 14 15 21 35 20 -f 15 16 21 -f 16 23 22 -f 16 22 21 -f 17 26 25 -f 17 25 24 -f 18 29 28 -f 18 28 27 -f 19 32 31 -f 19 31 30 -f 20 35 34 -f 20 34 33 -f 21 22 36 -f 21 36 35 -f 22 23 37 -f 22 37 47 46 36 -f 23 24 38 -f 23 38 37 -f 24 25 38 -f 25 26 39 -f 25 39 49 48 38 -f 26 27 40 -f 26 40 39 -f 27 28 40 -f 28 29 41 -f 28 41 51 50 40 -f 29 30 42 -f 29 42 41 -f 30 31 42 -f 31 43 53 52 42 -f 31 32 43 -f 32 44 43 -f 32 33 44 -f 33 34 44 -f 34 35 45 -f 34 45 55 54 44 -f 35 36 45 -f 36 46 45 -f 37 38 48 -f 37 48 47 -f 39 40 50 -f 39 50 49 -f 41 42 52 -f 41 52 51 -f 43 44 54 -f 43 54 53 -f 45 46 55 -f 46 47 56 -f 46 56 55 -f 47 48 57 -f 47 57 56 -f 48 49 57 -f 49 50 58 -f 49 58 57 -f 50 51 58 -f 51 59 58 -f 51 52 59 -f 52 53 59 -f 53 54 60 -f 53 60 59 -f 54 55 60 -f 55 56 60 -f 56 57 58 59 60 diff --git a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s13R.obj b/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s13R.obj deleted file mode 100644 index fa9be1b3..00000000 --- a/texmf-dist/scripts/ketcindy/data/polyhedrons_obj/s13R.obj +++ /dev/null @@ -1,152 +0,0 @@ -v -0.23192837 -0.31922203 0.91886124 -v 0.23192838 -0.31922203 0.91886124 -v 0.37526800 0.12193196 0.91886124 -v 0.00000000 0.39458012 0.91886124 -v -0.37526799 0.12193196 0.91886124 -v 0.00000000 -0.67692647 0.73605027 -v 0.45067192 -0.62029668 0.64197064 -v 0.64379533 -0.20918178 0.73605027 -v 0.72920248 0.23693225 0.64197064 -v 0.39788740 0.54764501 0.73605027 -v 0.00000000 0.76672886 0.64197064 -v -0.39788739 0.54764501 0.73605027 -v -0.72920248 0.23693225 0.64197064 -v -0.64379532 -0.20918178 0.73605027 -v -0.45067191 -0.62029668 0.64197064 -v -0.19312341 -0.90425562 0.38082092 -v 0.80031978 -0.46310163 0.38082092 -v 0.68774824 0.61804307 0.38082092 -v -0.37526799 0.84507325 0.38082092 -v -0.91967661 -0.09575908 0.38082092 -v -0.60719637 -0.76095695 0.22859687 -v -0.30415069 -0.95025066 -0.06719748 -v 0.13819168 -0.98812298 0.06719747 -v 0.53607907 -0.81262670 0.22859687 -v 0.80975434 -0.58290810 -0.06719748 -v 0.98246437 -0.17391870 0.06719747 -v 0.93851146 0.25872603 0.22859687 -v 0.80460641 0.58999364 -0.06719748 -v 0.46900470 0.88063531 0.06719747 -v 0.04395291 0.97252818 0.22859687 -v -0.31248024 0.94754422 -0.06719748 -v -0.69260352 0.71818125 0.06719747 -v -0.91134706 0.34232943 0.22859687 -v -0.99772981 -0.00437910 -0.06719748 -v -0.89705721 -0.43677489 0.06719747 -v -0.66641472 -0.70967199 -0.22859688 -v 0.03659896 -0.92392391 -0.38082093 -v 0.46900470 -0.85309878 -0.22859688 -v 0.89001354 -0.25070051 -0.38082093 -v 0.95627558 0.18242795 -0.22859688 -v 0.51345966 0.76898245 -0.38082093 -v 0.12200611 0.96584547 -0.22859688 -v -0.57267800 0.72595780 -0.38082093 -v -0.88087165 0.41449736 -0.22859688 -v -0.86739415 -0.32031586 -0.38082093 -v -0.54955655 -0.53465945 -0.64197064 -v -0.11507021 -0.66707442 -0.73605028 -v 0.33866904 -0.68787822 -0.64197064 -v 0.59886681 -0.31557561 -0.73605027 -v 0.75886555 0.10952733 -0.64197063 -v 0.48519026 0.47203794 -0.73605027 -v 0.13033567 0.75556984 -0.64197064 -v -0.29900272 0.60731111 -0.73605027 -v -0.67831368 0.35744049 -0.64197064 -v -0.66998413 -0.09669906 -0.73605027 -v -0.28281717 -0.27515070 -0.91886123 -v 0.17428857 -0.35400135 -0.91886120 -v 0.39053348 0.05636583 -0.91886122 -v 0.06707433 0.38883729 -0.91886104 -v -0.34907938 0.18394906 -0.91886143 -f 1 5 14 -f 1 14 15 -f 1 15 6 -f 1 6 2 -f 1 2 3 4 5 -f 2 6 7 -f 2 7 8 -f 2 8 3 -f 3 8 9 -f 3 9 10 -f 3 10 4 -f 4 10 11 -f 4 11 12 -f 4 12 5 -f 5 12 13 -f 5 13 14 -f 6 15 16 -f 6 16 23 24 7 -f 7 24 17 -f 7 17 8 -f 8 17 26 27 9 -f 9 27 18 -f 9 18 10 -f 10 18 29 30 11 -f 11 30 19 -f 11 19 12 -f 12 19 32 33 13 -f 13 33 20 -f 13 20 14 -f 14 20 35 21 15 -f 15 21 16 -f 16 21 22 -f 16 22 23 -f 17 24 25 -f 17 25 26 -f 18 27 28 -f 18 28 29 -f 19 30 31 -f 19 31 32 -f 20 33 34 -f 20 34 35 -f 21 35 36 -f 21 36 22 -f 22 36 46 47 37 -f 22 37 23 -f 23 37 38 -f 23 38 24 -f 24 38 25 -f 25 38 48 49 39 -f 25 39 26 -f 26 39 40 -f 26 40 27 -f 27 40 28 -f 28 41 29 -f 28 40 50 51 41 -f 29 42 30 -f 29 41 42 -f 30 42 31 -f 31 42 52 53 43 -f 31 43 32 -f 32 43 44 -f 32 44 33 -f 33 44 34 -f 34 44 54 55 45 -f 34 45 35 -f 35 45 36 -f 36 45 46 -f 37 47 48 -f 37 48 38 -f 39 49 50 -f 39 50 40 -f 41 52 42 -f 41 51 52 -f 43 53 54 -f 43 54 44 -f 45 55 46 -f 46 56 47 -f 46 55 56 -f 47 56 57 -f 47 57 48 -f 48 57 49 -f 49 58 50 -f 49 57 58 -f 50 58 51 -f 51 58 59 -f 51 59 52 -f 52 59 53 -f 53 59 60 -f 53 60 54 -f 54 60 55 -f 55 60 56 -f 56 60 59 58 57 diff --git a/texmf-dist/scripts/ketcindy/dirhead.txt b/texmf-dist/scripts/ketcindy/dirhead.txt deleted file mode 100644 index e87a8005..00000000 --- a/texmf-dist/scripts/ketcindy/dirhead.txt +++ /dev/null @@ -1,7 +0,0 @@ -Dirhead=Dircdy; -Dirwork=gethome()+pathsep()+"ketcindy"; -Dircdy=Dirwork; -setdirectory(Dirhead); -import("setketcindy.txt"); -import("ketoutset.txt"); -setdirectory(Dirwork); diff --git a/texmf-dist/scripts/ketcindy/ketcindy.sh b/texmf-dist/scripts/ketcindy/ketcindy.sh deleted file mode 100755 index 23465f4b..00000000 --- a/texmf-dist/scripts/ketcindy/ketcindy.sh +++ /dev/null @@ -1,100 +0,0 @@ -#!/bin/sh -# -# KETCindy starter script -# -# (C) 2017 Norbert Preining -# Licensed under the same license terms as ketpic itself, that is GPLv3+ -# - -BinaryName=Cinderella2 -TemplateFile=template1basic.cdy -systype=`uname` - -if [ "$1" = "-c" ] -then - shift - cinderella="$1" -else - cinderella=`which $BinaryName 2>/dev/null` -fi - -if [ -z "$cinderella" ] -then - case $systype in - Darwin) - if [ -r /Applications/Cinderella2.app/Contents/MacOS/Cinderella2 ] - then - cinderella=/Applications/Cinderella2.app/Contents/MacOS/Cinderella2 - else - echo "Cannot find $BinaryName!" >&2 - exit 1 - fi - ;; - *) - echo "Cannot find $BinaryName!" >&2 - exit 1 - ;; - esac -fi - -if [ ! -x "$cinderella" ] ; then - echo "Program $cinderella is not executable!" >&2 - exit 1 -fi -# find real path -realcind=`realpath "$cinderella"` -cinddir=`dirname "$realcind"` -case $systype in - Darwin) - plugindir="$cinddir/../PlugIns";; - *) - plugindir="$cinddir/Plugins";; -esac - -plugin="$plugindir/KetCindyPlugin.jar" - -# find Jar -KetCdyJar=`kpsewhich -format=texmfscripts KetCindyPlugin.jar` -# search for template.cdy -TempCdy=`kpsewhich -format=texmfscripts $TemplateFile` - -if [ -z "$TempCdy" -o -z "$KetCdyJar" ] -then - echo "Cannot find $TemplateFile via kpsewhich, is ketpic installed?" >&2 - exit 1 -fi - - -if [ ! -r "$plugin" ] ; then - echo "Cinderella is *NOT* set up for KETCindy!" - echo "You need to copy" - echo " $KetCdyJar" - echo "into" - echo " $plugindir" - echo "" - exit 1 -fi - -# check whether the .jar md5sum is fine, but don't make this an error -case $systype in - Darwin) - __md5sum=md5;; - *) - __md5sum=md5sum;; -esac -myjarmd=`cat "$KetCdyJar" | $__md5sum` -sysjarmd=`cat "$plugin" | $__md5sum` -if [ ! "$myjarmd" = "$sysjarmd" ] -then - echo "The installed version of the plugin in" - echo " $plugin" - echo "differs from the version shipped in" - echo " $KetCdyJar" - echo "You might need to update the former one with the later one!" -fi - - -mkdir -p ~/ketcindy - -exec "$cinderella" "$TempCdy" - diff --git a/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar b/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar Binary files differdeleted file mode 100644 index 2ae7ceda..00000000 --- a/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dhelpE.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dhelpE.txt deleted file mode 100644 index 27b40955..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dhelpE.txt +++ /dev/null @@ -1,29 +0,0 @@ -//help:start(); -//help:Changstyle3d*(change the attribute of 3d plot data); -//help:Findangle*(specify the angles theta and phi); -//help:Cancoordpara*(specify the coordinate with respect to canonical coordinate); -//help:Projcoordpara*(specify the coordinate of projected image); -//help:Parapt*(the coordinate of the point in the projected plane); -//help:Spaceline*(generate the plot data of 3d segments); -//help:Spacecurve*(generate the plot data of 3d curve); -//help:Xyzax3data*(generate the plot data of coordinate axes); -//help:Datalist3d*(list of plot data of the all objects on the screen. Both 2d and 3d values are returned); -//help:Skeletonparadata*(generate the plot data of the objects with hidden line elimination); -//help:Embed*(generate the embedded plot data); -//help:Rotate3pt*(rotate the point); -//help:Rotate3data*(rotate 3d plot data); -//help:Translate3pt*(parallelly transport the point); -//help:Translate3data*(parallelly transport the plot data); -//help:Reflect3point*(reflect the point); -//help:Xyzcoord*(coordinate of a point determined with respect to main screen and sub screen); -//help:PutonCurve3d*(put a point on the 3d curve); -//help:Ptsegdata*(generate the 3d plot data of point and segment derived from those on 2d screen); -//help:Putpoint3d*(put a specific point); -//help:Perppt*(the foot of the perpendicular on the plane); -//help:Perpplane*(a fiducial point of a plane with specific point on it and with specific normal vector); -//help:Drawpoint3d*(draw a specific point); -//help:Putaxes3d*(take a point with specific coordinates as geometric one); -//help:IntersectsgpL*(intersection between line and plane); -//help:Bezier3*(draw 3d Bezier curve); -//help:Mkbezierptcrv3*(draw 3d Bezier curve by automatically taking controll points); -//help:end(); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dhelpJ.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dhelpJ.txt deleted file mode 100644 index bd29d25f..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dhelpJ.txt +++ /dev/null @@ -1,45 +0,0 @@ -//help:start(); -//help:Changstyle3d*(3dプãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã®å±žæ€§ã‚’変更); -//help:Findangle*(theta,phiを求ã‚ã‚‹); -//help:Cancoordpara*(標準座標を求ã‚ã‚‹); -//help:Projcoordpara*(投影座標を求ã‚ã‚‹); -//help:Parapt*(点ã®æŠ•å½±é¢ã§ã®åº§æ¨™); -//help:Spaceline*(空間ã®æŠ˜ç·šãƒ‡ãƒ¼ã‚¿ä½œæˆ); -//help:Spacecurve*(空間曲線ã®ãƒ‡ãƒ¼ã‚¿ä½œæˆ); -//help:Xyzax3data*(座標軸ã®ãƒ‡ãƒ¼ã‚¿ä½œæˆ); -//help:Datalist3d*(ç”»é¢ã«æã‹ã‚Œã¦ã„ã‚‹ã™ã¹ã¦ã®ãƒ—ãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ï¼Žæˆ»ã‚Šå€¤ã¯3d,2d); -//help:Skeletonparadata*(スケルトン処ç†ã®ãƒ‡ãƒ¼ã‚¿ä½œæˆ); -//help:Embed*(埋ã‚è¾¼ã¿ãƒ‡ãƒ¼ã‚¿ä½œæˆ); -//help:Rotatept3d*(空間点を回転); -//help:Rotatedata3d*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã‚’回転); -//help:Translatept3d*(空間点を平行移動); -//help:Translatedata3d*(空間プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã‚’平行移動); -//help:Reflectpoint3d*(点をé¡æ˜ ); -//help:Xyzcoord*(主副画é¢ã§æ±ºã¾ã‚‹ç‚¹ã®åº§æ¨™); -//help:PutonCurve3d*(空間曲線上ã«ç‚¹ã‚’ã¨ã‚‹); -//help:Ptsegdata*(ç”»é¢ã«ã¨ã£ãŸç‚¹ã¨ç·šåˆ†ã‹ã‚‰ç©ºé–“ã®ç‚¹ã¨ç·šåˆ†ã‚’作æˆ); -//help:Putpoint3d*(空間点をã¨ã‚‹); -//help:Perppt*(å¹³é¢ã«ä¸‹ã‚ã—ãŸåž‚ç·šã®è¶³); -//help:Perpplane*(点を通り垂直ãªå¹³é¢ä¸Šã®åŸºæº–点); -//help:Drawpoint3d*(空間点をæã); -//help:Putaxes3d*(座標点を幾何点ã¨ã—ã¦ã¨ã‚‹); -//help:IntersectsgpL*(空間ã®ç›´ç·šã¨å¹³é¢ã®äº¤ç‚¹); -//help:Bezier3d*(空間ベジェ曲線); -//help:Mkbezierptcrv3d*(制御点を自動的ã«ã¨ã‚‹ç©ºé–“ベジェ曲線); -//help:Readobj*(objファイルをèªã¿è¾¼ã‚€ï¼Žã‚ªãƒ—ションã¯ä¸Šä¸‹å転(符å·ï¼‰ã¨å€çŽ‡); -//help:VertexandEdge*(é ‚ç‚¹ã¨é¢ã‹ã‚‰è¾ºã‚’求ã‚,辺をæã); -//help:Phparadata*(多é¢ä½“を陰線処ç†ã—ã¦æã -//è¿½åŠ ã‚ªãƒ—ã‚·ãƒ§ãƒ³ : "Hidden=線種"); -//help:Nohiddenbyfaces*(多é¢ä½“ã¨ç©ºé–“曲線を陰線処ç†); -//help:Fixpoint3d*(空間ã®å›ºå®šç‚¹ã‚’ã¨ã‚‹); -//help:Sf3data*(陰線処ç†ãªã—ã®ç©ºé–“曲é¢ã‚’æã); -//help:Concatobj*(ã„ãã¤ã‹ã®objデータをçµåˆ); -//help:Crvsfparadata*(曲線ã®æ›²é¢ã«ã‚ˆã‚‹é™°ç·šå‡¦ç†); -//help:Intersectcrvsf*(曲線ã¨æ›²é¢ã®äº¤ç‚¹ã‚’求ã‚ã‚‹); -//help:Intersectcrvsf*(曲線ã¨æ›²é¢ã®äº¤ç‚¹ã‚’求ã‚ã‚‹); -//help:Sfbdparaparadata*(空間曲é¢ã®é™°ç·šå‡¦ç†); -//help:Wireparadata*(曲é¢ã®ãƒ¯ã‚¤ãƒ¤ãƒ•ãƒ¬ãƒ¼ãƒ を陰線処ç†); -//help:Dist3d*(空間ã®ï¼’点ã®è·é›¢); - - -//help:end(); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt deleted file mode 100644 index 55b2fc71..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt +++ /dev/null @@ -1,34 +0,0 @@ -// 2018.03.27 -// Start3d changed (for C) -// 2018.02.27 -// Sfbdpara,... changed ("Res=" made from fname) -// 2018.02.26 -// Sfcutparadata (renamed from Sfcutdata) changed -// 2018.02.24 -// Sfcutdata added -// 2018.02.23 -// Crvonsfparadata added -// Wireparadata added -// Skeletonparadata rechanged to old version -// 2018.02.22 -// Intersectcrvsf added (changed to R) -// Sdbdpradata,Crvsfparadata,Intersectcrvsf changed (title printing) -// 2018.02.20 -// Addpoints added -// PthiddenQ,Meetpoints debugged -// 2018.02.18 -// Sfbdparadata debuggded (OTHERPARTITION ) -// 2018.02.11 -// Sfbdparadata added -// 2018.01.04 -// Skeletonparadata(Skeletondatacindy) majorly changed -// 2017.10.23 -// Rotatedata3d, Translatedata3d debugged ([]) -// 2017.10.08 -// Bezier3,Putbezier3data,Mkbezierptcrv3d greatly changed -// 2017.10.07 -// Mkpointlist debugged -// Start3d,Ptseg3d, Setangle, Mkpointlist, Mkseq3d, Putpoint3d Skeleton..,Putbezier.. -// changed ( "=" removed from VLIST) -// 2017.09.18 -// SCIWR,SCIRE removed diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs deleted file mode 100644 index ce7a65f1..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs +++ /dev/null @@ -1,4503 +0,0 @@ -// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -// -//This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU General Public License as published by -// the Free Software Foundation; either version 3 of the License, or -// (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with this program. If not, see <http://www.gnu.org/licenses/> -// - -println("ketcindylib3d(20180327) loaded"); - -//help:start(); - -Ketinit3d():=Ketinit3d(1); -Ketinit3d(sf):=( - regional(tmp); - tmp=round(4*SW.y)/4; -// Ketinit3d(sf,[round(SW.x)+1,tmp-0.5,tmp-1]); - Ketinit3d(sf,[-5,tmp-0.5,tmp-1]); -); -Ketinit3d(subflg,position):=( -//help:Ketinit3d(subflg=1) - regional(ctr,tmp,tmp1,tmp2,tmp3,tmp4,xPos,yTh,yPh); -// println("KETCindy3d V.2.3.5(2016.02.03)"); - BezierNumber3=1; //15.02.28 - if(!islist(BZLIST3), - BZLIST3=[]; //15.02.28 - , - tmp=apply(allpoints(),text(#)); - tmp1=select(tmp,substring(#,length(#)-1,length(#))=="p"); - tmp2=[]; - forall(tmp1,ctr, - tmp=substring(ctr,0,length(ctr)-1); - tmp=select(BZLIST3,#_1==tmp); - if(length(tmp)>0, - tmp2=append(tmp2,tmp_1); - ); - ); - BZLIST3=tmp2; - ); - SUBSCR=subflg; - Setwindow("Msg=no"); - if(length(position)>2, - xPos=position_1; - yTh=position_2; - yPh=position_3; - , - xPos=0; - yTh=position_1; - yPh=position_2; - ); -// THETA=60*pi/180; -// PHI=30*pi/180; - FocusPoint=[0,0,0]; - EyePoint=[5,5,5]; - Listplot("th",[[xPos,yTh],[xPos+9,yTh]],["notex","linecolor->[0,1,0]","Msg=no"]); - Listplot("ph",[[xPos,yPh],[xPos+9,yPh]],["notex","linecolor->[0,1,0]","Msg=no"]); - //16.02.10 - PutonCurve("TH",sgth,[xPos,xPos+9,"Msg=no"]); - PutonCurve("FI",sgph,[xPos,xPos+9,"Msg=no"]); - THETA=(TH.x-xPos)*20*pi/180; - PHI=(FI.x-xPos)*40*pi/180; -// Defvar("THETA",THETA); // 16.06.20 -// Defvar("PHI",PHI); // 16.06.20 - drawtext([xPos-0.8,yTh-0.1],Sprintf((TH.x-xPos)*20,2),align->"right"); //17.05.02 - drawtext([xPos-0.8,yPh-0.1],Sprintf((FI.x-xPos)*40,2),align->"right"); //17.05.02 - tmp="Setangle("+text((TH.x-xPos)*20)+","+text((FI.x-xPos)*40)+")"; - GLIST=append(GLIST,tmp); - Addax(0); - TSIZE=10; - TSIZEZ=10; - ErrFlg=0; -); - -Start3d():=Start3d([]); -Start3d(ptexception):=( -//help:Start3d(); -//help:Start3d(execptionptlist); - regional(xmn,xMx,ymn,yMx,pt,pt3,pt2, - xPos,yTh,yPh,Eps,tmp,tmp1,tmp2,tmp3,tmp4); - ConstantListC=[[50,50],[5000,1500,500,200],[0.00001,0.01,0.1]]; - FuncListC=[]; - CommandListC=[]; - GCLIST=[]; - GLIST=[]; - FUNLIST=[]; - COM0thlist=[]; - COM1stlist=[]; - COM2ndlist=[]; - SEG3dlist=[]; - OutFileList=[]; - FigPdfList=[]; // 16.04.08 - ErrFlag=0; - OBJCMD=[]; // 16.11.29from - OCNAME=Fhead; - OCOPTION=["m","v"];// 16.11.29until - ArrowlineNumber=1; // 16.01.31 - ArrowheadNumber=1; - BezierNumber=1; //16.01.31 - BezierNumber3=1; //16.08.19 - Fnametex=Fhead+".tex"; // 15.04.06 - FnameR=Fhead+".r"; - FnameRbody=Fhead+"body.r"; - Fnameout=Fhead+".txt"; -// Ketinit3d(SUBSCR); // 16.06.20 - Setwindow("Msg=no"); // 16.06.20from - tmp=round(4*SW.y)/4; - xPos=-5;yTh=tmp-0.5;yPh=tmp-1; - Listplot("th",[[xPos,yTh],[xPos+9,yTh]], - ["notex","linecolor->[0,1,0]","Msg=no"]); - Listplot("ph",[[xPos,yPh],[xPos+9,yPh]], - ["notex","linecolor->[0,1,0]","Msg=no"]); - //16.02.10 - PutonCurve("TH",sgth,[xPos,xPos+9,"Msg=no"]); - PutonCurve("FI",sgph,[xPos,xPos+9,"Msg=no"]); - drawtext([xPos-0.8,yTh-0.1],Sprintf((TH.x-xPos)*20,2),align->"right"); //17.05.02 - drawtext([xPos-0.8,yPh-0.1],Sprintf((FI.x-xPos)*40,2),align->"right"); //17.05.02 - tmp="Setangle(" - +format((TH.x-xPos)*20,5)+"," - +format((FI.x-xPos)*40,5)+")"; - GLIST=append(GLIST,tmp); - THETA=(TH.x-xPos)*20*pi/180; - PHI=(FI.x-xPos)*40*pi/180; // 16.06.20until - if(isselected(TH) % isselected(FI), // 17.05.18from - if(length(Ch)>0, - ChNum=Ch_(length(Ch)); - if(ChNum==0, ChNum=1); - , - ChNum=1; - ); - Ch=[0]; - );// 17.05.18until - if(length(VLIST)==0, // 16.06.20 - tmp=remove(allpoints(),[NE,SW,TH,FI,O,X,Y,Z]);//17.06.02 - tmp4=remove(tmp,ptexception); - forall(tmp4,pt, - tmp1=text(pt); - tmp=substring(tmp1,length(tmp1)-1,length(tmp1)); - if(tmp!="z", - tmp=parse(tmp1+"z.y"); - pt3=Xyzcoord(pt.x,pt.y,tmp); - Defvar(tmp1+"3d",pt3); - pt2=Parapt(pt3); // 16.05.28from - Defvar(tmp1+"2d",pt2); // 16.05.28until - ); - ); - , - if(isselected(NE) % isselected(SW), - tmp=remove(allpoints(),[NE,SW,TH,FI]); - tmp4=remove(tmp,ptexception); - forall(tmp4,pt, - tmp1=text(pt); - tmp=substring(tmp1,length(tmp1)-1,length(tmp1)); - if(tmp!="z", - tmp=select(VLIST,#_1==tmp1+"3d"); //17.10.07 - pt3=tmp_1_2; - tmp=tmp1+".xy=Parapt("+pt3+")_[1,2];"; - parse(tmp); -// if(SUBSCR==1, -// tmp=tmp1+"z"+".x=NE.x-SW.x+"+tmp1+".x"; -// parse(tmp); -// ); - ); - ); - , - tmp=remove(allpoints(),[NE,SW,TH,FI]); - tmp4=remove(tmp,ptexception); - forall(tmp4,pt, - tmp1=text(pt); - tmp=substring(tmp1,length(tmp1)-1,length(tmp1)); - if(tmp!="z", - tmp2=parse(tmp1+"z"); - if(isselected(pt) % isselected(tmp2), - Defvar(tmp1+"2d",pt.xy); - tmp=parse(tmp1+"z.y"); - tmp=Xyzcoord(pt.x,pt.y,tmp); - Defvar(tmp1+"3d",tmp); - ); - ); - ); - ); - ); - if(SUBSCR==1, - xmn=SW.x+NE.x-SW.x; - xMx=NE.x+NE.x-SW.x; - ymn=SW.y; - yMx=NE.y; - drawpoly([[xMx,yMx],[xmn,yMx], - [xmn,ymn],[xMx,ymn]],color->[1,1,1]); - connect([[NE.x-SW.x,yMx],[NE.x-SW.x,ymn]], - color->[0.5,0.5,0.5]); - ); - // for Presentation //17.07.01from - letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; - shadowc=[0,0,0,0.5]; mboxc="yellow"; //17.03.02 regional debugged - SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, - letterc,mboxc,mboxc,mboxc,62,2,letterc]; - ThinDense=0.1; //17.07.01until - Ptseg3data(ptexception); //16.08.23 -); - -Setangle(theta,phi):=( //16.12.24 -//help:Setangle(60,30); - regional(xmn,xMx,ymn,yMx,pt,pt3,pt2, - xPos,yTh,yPh,Eps,tmp,tmp1,tmp2,tmp3,tmp4); - tmp=round(4*SW.y)/4; - xPos=-5;yTh=tmp-0.5;yPh=tmp-1; - if(theta=="",theta=THETA*180/pi); // 17.01.19 - if(phi=="",phi=PHI*180/pi); - THETA=theta*pi/180; - TH.x=theta/20+xPos; - PHI=phi*pi/180; - FI.x=phi/40+xPos; -// drawtext([xPos-0.8,yTh-0.1],text(theta)); //17.05.05 -// drawtext([xPos-0.8,yPh-0.1],text(phi)); - tmp="Setangle(" - +format(theta,5)+","+format(phi,5)+")"; - GLIST=append(GLIST,tmp); - if(length(VLIST)==0, // 16.06.20 - tmp=remove(allpoints(),[NE,SW,TH,FI]); - tmp4=remove(tmp,ptexception); - forall(tmp4,pt, - tmp1=text(pt); - tmp=substring(tmp1,length(tmp1)-1,length(tmp1)); - if(tmp!="z", - tmp=parse(tmp1+"z.y"); - pt3=Xyzcoord(pt.x,pt.y,tmp); - Defvar(tmp1+"3d",pt3); - pt2=Parapt(pt3); // 16.05.28from - Defvar(tmp1+"2d",pt2); // 16.05.28until - ); - ); - , - if(isselected(NE) % isselected(SW), - tmp=remove(allpoints(),[NE,SW,TH,FI]); - tmp4=remove(tmp,ptexception); - forall(tmp4,pt, - tmp1=text(pt); - tmp=substring(tmp1,length(tmp1)-1,length(tmp1)); - if(tmp!="z", - tmp=select(VLIST,#_1==tmp1+"3d"); - pt3=tmp_1_2; - tmp=tmp1+".xy=Parapt("+pt3+")_[1,2];"; - parse(tmp); - ); - ); - , - tmp=remove(allpoints(),[NE,SW,TH,FI]); - tmp4=remove(tmp,ptexception); - forall(tmp4,pt, - tmp1=text(pt); - tmp=substring(tmp1,length(tmp1)-1,length(tmp1)); - if(tmp!="z", - tmp2=parse(tmp1+"z"); - if(isselected(pt) % isselected(tmp2), - Defvar(tmp1+"2d",pt.xy); - tmp=parse(tmp1+"z.y"); - tmp=Xyzcoord(pt.x,pt.y,tmp); - Defvar(tmp1+"3d",tmp); - ); - ); - ); - ); - ); - forall(Datalist3d(),#, - tmp1=replace(#,"3d","2d"); - tmp2=Projpara(#,["nodata"]); - tmp=tmp1+"="+textformat(tmp2,5); - parse(tmp); - ); - Ptseg3data(ptexception); -); - -Changestyle3d(nameL,style):=( -//help:Changestyle3d(["geoseg3d","ax3d"],["notex"]); - regional(nmL,name,tmp,tmp1,tmp2); - if(islist(nameL),nmL=nameL,nmL=[nameL]); - tmp1=[]; - forall(nmL,name, - tmp=parse(name); - if(isstring(tmp_1), - tmp1=concat(tmp1,tmp); - , - tmp1=append(tmp1,name); - ); - tmp=apply(tmp1,replace(#,"3d","2d")); - Changestyle(tmp,style); - tmp=apply(tmp,"sub"+#); // 15.05.24 - Changestyle(tmp,style); - ); -); - -Dist3d(pt1):=Dist3d(pt1,[0,0,0]); -Dist3d(pt1,pt2):=( -//help:Dist3d(A3d,B3d); -//help:Dist3d(A,B); -//help:Dist3d("A","B"); - regional(p1,p2); - if(islist(pt1), - p1=pt1; - , - if(ispoint(pt1),p1=text(pt1),p1=pt1); - p1=parse(p1+"3d"); - ); - if(islist(pt2), - p2=pt2; - , - if(ispoint(pt2),p2=text(pt2),p2=pt2); - p2=parse(p2+"3d"); - ); - sqrt((p2-p1)*(p2-p1)); -); - -Findangle(vec):=( -//help:Findangle([2,1,4]); -//help:Findangle([0,0,1,0]); - regional(vec3,vec2,Eps,th,ph,tmp); - Eps=10^(-4); - vec3=vec_(1..3); - vec2=vec_(1..2); - th=arccos(vec_3/|vec3|); - if(|vec2|>Eps, - ph=arccos(vec_1/|vec2|); - if(vec_2<0, - ph=2*pi-ph; // 15.03.28 - ); - , - if(length(vec)>3,ph=vec_4*pi/180,ph=PHI); - ); - [th,ph]; -); - -Cancoordpara(pc):=( -//help:Cancoordpara([1,2,0]); - regional(Xz,Yz,Zz,tmp1,tmp2,tmp3); - Xz=pc_1; Yz=pc_2; Zz=pc_3; - tmp1=-Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA); - tmp2=Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA); - tmp3=Yz*sin(THETA)+Zz*cos(THETA); - [tmp1,tmp2,tmp3]; -); - -Zparapt(cc):=( - regional(x,y,z); - x=cc_1; y=cc_2; z=cc_3; - x*cos(PHI)*sin(THETA)+y*sin(PHI)*sin(THETA)+z*cos(THETA); -); - -Projcoordpara(cc):=( -//help:Projcoordpara([3,1,2]); - regional(tmp); - tmp=Parapt(cc); - [tmp_1,tmp_2,Zparapt(cc)]; -); - -Parapt(pt):=( -//help:Parapt([2,1,5]); - regional(Xz,Yz); - Xz=-pt_1*sin(PHI)+pt_2*cos(PHI); - Yz=-pt_1*cos(PHI)*cos(THETA)-pt_2*sin(PHI)*cos(THETA)+pt_3*sin(THETA); - [Xz,Yz]; -); - -ProjCurve(crv):=( -//help:Projcurve("sl3d1"); - regional(CurveL,Curve,Eps,AnsL,Out,sp,cp,st,,ct,ii,pt, - Xz,Yz,tmp,tmp1,tmp2); - Eps=10^(-6); - sp=sin(PHI); cp=cos(PHI); - st=sin(THETA); ct=cos(THETA); - if(isstring(crv),CurveL=parse(crv),CurveL=crv); - if(MeasureDepth(CurveL)==1,CurveL=[CurveL]); - Out=[]; - forall(CurveL,Curve, - AnsL=[]; - forall(1..length(Curve),ii, - pt=Curve_ii; - if(pt_1!="inf", - Xz=-pt_1*sp+pt_2*cp; - Yz=-pt_1*cp*ct-pt_2*sp*ct+pt_3*st; - tmp=[Xz,Yz]; - if(ii==1, - AnsL=[tmp]; - , - tmp1=AnsL_(length(AnsL)); - if(tmp1_1=="inf" % |tmp-tmp1|>Eps, - AnsL=append(AnsL,tmp); - ); - ); - , - AnsL=append(AnsL,["inf"]); - ); - ); - tmp1=[]; - tmp2=select(1..length(AnsL),AnsL_#==["inf"]); - tmp=1; - forall(tmp2, - if(#>tmp, - tmp1=concat(tmp1,[AnsL_(tmp..(#-1))]) - ); - tmp=#+1; - ); - if(tmp<length(AnsL), - tmp1=concat(tmp1,[AnsL_(tmp..length(AnsL))]); - ); - AnsL=tmp1; - if(length(AnsL)==1,AnsL=AnsL_1); - Out=append(Out,AnsL); - ); - if(length(Out)==1, - Out=Out_1; - ); - Out; -); - -Projpara(ptdata):=Projpara(ptdata,[]); -Projpara(ptdata,options):=( - regional(name2,name3,Ltype,Noflg,opcindy,dtL,ptL,tmp,Out); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - if(islist(ptdata),dtL=ptdata,dtL=[ptdata]); - Out=[]; - forall(dtL,name3, -// name3=#; - if(indexof(name3,"3d")>0, //17.05.24 - name2=replace(name3,"3d","2d"); - , - name2="para"+name3; - ); - ptL=Projcurve(name3); - ptL=select(ptL,length(#)>1);//17.06.02 - if(length(ptL)==1, - ptL=ptL_1; - ); - Out=append(Out,ptL); - if(Noflg<3, - println("generate projparadata "+name2); - tmp=name2+"="+textformat(ptL,5); - parse(tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - ); - ); - if(length(Out)==1,Out=Out_1); -// Out=Flattenlist(Out); - if(length(Out)==1,Out=Out_1); // 15.02.24 - tmp=[]; - forall(Out, - if(length(#)>0,tmp=append(tmp,#)); - ); - Out=tmp; - Out; -); - -InvparaptPp(pt,pd):=( - regional(Eps,fk,nfk,ph,fh,ah,bh,ak,bk,v1,v2, - nn,s0,t2,out,tmp,tmp1,tmp2,flg); - Eps=10^(-4); - if(isstring(pd), - fk=pd; - , - fk=textformat(pd,5); - ); - nfk=Numptcrv(parse(fk)); - flg=0; - tmp=pt; - if(length(tmp)==1, - ph=tmp; - fh=pd; - , - fh=Projpara(fk,["nodata"]); - if(nfk>2, - tmp1=Nearestpt(tmp,fh); - ph=tmp1_2; - , - ah=Ptcrv(1,fh); bh=Ptcrv(2,fh); - v1=tmp-ah; v2=bh-ah; - tmp1=Crossprod(v1,v2); - if(abs(tmp1)>Eps, - println(" Not on the line"); - out=[]; - flg=1; - , - ph=Dotprod(v1,v2)/|v2|^2+1; - ); - ); - ); - if(flg==0, - if(nfk>2, - nn=floor(ph); - s0=ph-nn; - if(ph>Numptcrv(fh)-Eps, - out=[Ptend(fk),Numptcrv(fh)]; - flg=1; - ); - , - nn=1; - s0=ph-1; - ); - ); - if(flg==0, - ak=Ptcrv(nn,fk); bk=Ptcrv(nn+1,fk); - ah=Ptcrv(nn,fh); bh=Ptcrv(nn+1,fh); - ph=(1-s0)*ah+a0*bh; - t2=s0; - pk=(1-t2)*ak+t2*bk; - out=[pk,nn+t2]; - ); - out; -); - -Invparapt(pt,pd):=( - regional(tmp); - tmp=InvparaptPp(pt,pd); - tmp_1; -); - -Subgraph(name,opcindy):=( - regional(tht,tmp,tmp1); - tht=THETA; THETA=pi/2; - tmp=Projpara(name3,["nodata"]); - if(length(tmp)>0, //15.08.17 - tmp=Translatedata("",[tmp],[NE.x-SW.x,0],["nodata"]); - tmp1=replace("sub"+name,"3d","2d"); - tmp=tmp1+"="+Textformat(tmp,5); - parse(tmp); - GCLIST=append(GCLIST,[tmp1,0,opcindy]); - ); - THETA=tht; // 15.11.03 -); - -Spaceline(ptlist):=Spaceline(ptlist,[]); // 16.02.22 from -Spaceline(Arg1,Arg2):=( - regional(name,tmp,tmp1,tmp2); - if(isstring(Arg1), - Spaceline(Arg1,Arg2,[]); - , - tmp=text(Arg1); - tmp=substring(tmp,1,length(tmp)-1); - name="-"+replace(tmp,",",""); - Spaceline(name,Arg1,Arg2); - ); -); // 16.02.22 until -Spaceline(nm,ptlistorg,optionorg):=( -//help:Spaceline("1",[[2,5,1],[4,2,3]]); -//help:Spaceline([A,B]); - regional(name2,name3,options,Out,tmp,tmp1,tmp2, - opstr,opcindy,Ltype,Noflg,eqL,ptlist, Msg); - ptlist=apply(ptlistorg,if(ispoint(#),parse(text(#)+"3d"),#)); // 16.02.10 - if(substring(nm,0,2)=="bz", - name2=replace(nm,"bz","bz2d"); - name3=replace(nm,"bz","bz3d"); - , - if(substring(nm,0,1)=="-", - tmp=substring(nm,1,length(nm)); - if(indexof(tmp,"3d")>0,name3=tmp,name3=tmp+"3d"); - name2=replace(name3,"3d","2d"); - , - name2="sl2d"+nm; - name3="sl3d"+nm; - ); - ); - options=select(optionorg,length(#)>0); // 160415 - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - opcindy=tmp_(length(tmp)); - Msg=1; - forall(eqL, - tmp=substring(#,0,1); - if(Toupper(tmp)=="M", - tmp=indexof(#,"="); - tmp1=substring(#,tmp,tmp+1); - if(Toupper(tmp1)=="N", - Msg=0; - ); - ); - ); - if(Noflg<3, - if(Msg==1, - println("generate Spaceline "+name3); - ); - tmp=name3+"="+ptlist; - parse(tmp); - tmp1=Projpara(name3,["nodata"]); - tmp=name2+"="+textformat(tmp1,5); - parse(tmp); - tmp="["; - forall(ptlist, //17.07.13from - if(isstring(#), - tmp=tmp+#+","; - , - tmp=tmp+textformat(#,5)+","; - ); - ); - tmp=substring(tmp,0,length(tmp)-1)+"]"; - tmp=name3+"=Spaceline("+tmp+")"; //17.07.13until -// tmp=name3+"=Spaceline("+textformat(ptlist,5)+")"; //17.05.24 - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, // 15.02.11 - Subgraph(name3,opcindy); - ); - ); - ptlist; -); - -Spacecurve(nm,funstr,variable):=Spacecurve(nm,funstr,variable,[]); -Spacecurve(nm,funstr,variable,optionorg):=( -//help:Spacecurve("1","[cos(t),sin(t),0.5*t]","t=[0,4*pi]",["Num=200"]); - regional(name2,name3,options,Out,tmp,tmp1,tmp2,vname,tmpfn,str,Rng,Num,Msg, - Ec,Exfun,Dc,opstr,opcindy,Fntmp,Vatmp,Ltype,Noflg,eqL,t1,t2,dt,tt,pa,ke); - if(substring(nm,0,2)=="bz", - name2=replace(nm,"bz","bz2d"); - name3=replace(nm,"bz","bz3d"); - , - name2="sc2d"+nm; - name3="sc3d"+nm; - ); - Eps=10^(-4); - Num=50; - Ec=[]; - Exfun=""; - Dc=1000; - options=select(optionorg,length(#)>0); // 160415 - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - Msg=1; - forall(eqL, - tmp=substring(#,0,1); - if(Toupper(tmp)=="M", - tmp=indexof(#,"="); - tmp1=substring(#,tmp,tmp+2); - if(Toupper(tmp1)=="NO", - Msg=0; - ); - ); - tmp=indexof(#,"N="); - if(tmp>0, - tmp1=substring(#,tmp+1,length(#)); - Num=parse(tmp1); - opstr=opstr+",'"+#+"'"; - ); - tmp=indexof(#,"Num="); - if(tmp>0, - tmp1=substring(#,tmp+3,length(#)); - Num=parse(tmp1); - opstr=opstr+",'"+#+"'"; - ); - tmp=indexof(#,"E="); - if(tmp>0, - tmp1=substring(#,tmp+1,length(#)); - if(substring(tmp1,0,1)=="[", - Ec=parse(tmp1); - , - Exfun=tmp1; - ); - opstr=opstr+",'"+#+"'"; - ); - tmp=indexof(#,"Exc="); - if(tmp>0, - tmp1=substring(#,tmp+3,length(#)); - if(substring(tmp1,0,1)=="[", - Ec=parse(tmp1); - , - Exfun=tmp1; - ); - ); - ); - tmp=indexof(variable,"="); - vname=substring(variable,0,tmp-1); - str=substring(variable,tmp,length(variable)); - Rng=parse(str); - t1=Rng_1; t2=Rng_2; - dt=(t2-t1)/Num; // differ from Scilab - tmp="tmpfn("+vname+"):="+funstr+";"; - parse(tmp); - Out=[]; - Ec=append(sort(Ec),10000); - ke=1; - forall(0..Num, - pt=[]; - tt=Rng_1+#*dt; - if(tt-Ec_ke<-Eps, - pa=tmpfn(tt); - ); - if(abs(tt-Ec_ke)<=Eps, - if(length(Out)>0, - if(Out_(length(Out))_1!="inf", - pa=["inf"]; - ); - ); - ); - if(tt-Ec_ke>Eps, - pa=tmpfn(tt); - ke=ke+1; - ); - if(length(pa)>0, - if(pa_1=="inf", - Out=append(Out,pa); - , - if(length(Out)==0, - Out=[pa]; - , - tmp=Out_(length(Out)); - if(tmp_1=="inf", - Out=append(Out,pa); - , - if(|tmp-pa|<Dc, - Out=append(Out,pa); - , - Out=concat(Out,[["inf"],pa]); - ); - ); - ); - ); - ); - ); - tmp1=[]; - tmp2=select(1..length(Out),Out_#==["inf"]); - tmp=1; - forall(tmp2, - if(#>tmp, - tmp1=concat(tmp1,[Out_(tmp..(#-1))]) - ); - tmp=#+1; - ); - if(tmp<length(Out), - tmp1=concat(tmp1,[Out_(tmp..length(Out))]); - ); - if(length(Out)==1, - Out=Out_1; - ); - if(Noflg<3, - if(Msg==1, - println("generate Spacecurve "+name3); - ); - tmp=name3+"="+textformat(Out,5); - parse(tmp); - tmp1=Projpara(name3,["nodata"]); - tmp=name2+"="+textformat(tmp1,5); - parse(tmp); - tmp=name3+"=Spacecurve(Assign('"+funstr+"'),'"+variable+"'"+opstr+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, // 15.02.11 - tmp=parse(name2); // 15.08.17 - if(length(tmp)>0, - Subgraph(name3,opcindy); - ); // 15.08.17 - ); - ); - Out; -); - -Partcrv3d(nm,pA,pB,PkLstr):=Partcrv3d(nm,pA,pB,PkLstr,[]); -Partcrv3d(nm,pA,pB,PkLstr,options):=( -//help:Partcrv3d("1",A,B,"sl3d1"); -//help:Partcrv3d("1",1.3,2.5,"sl3d1"); - regional(p1,p2,q1,q2,dt1,dts,dt3,tmp,tmp1,tmp2); - if(isreal(pA), - p1=pA; q1=pA; - , - if(islist(pA), - tmp=pA; - , - if(ispoint(pA),tmp=text(pA),tmp=pA); - tmp=parse(tmp+"3d"); - ); - p1=parapt(tmp); - q1=[p1_1,tmp_3]+[NE.x-SW.x,0]; - ); - if(isreal(pB), - p2=pB; q2=pB; - , - if(islist(pB), - tmp=pB; - , - if(ispoint(pB),tmp=text(pB),tmp=pB); - tmp=parse(tmp+"3d"); - ); - p2=parapt(tmp); - q2=[p2_1,tmp_3]+[NE.x-SW.x,0]; - ); - tmp=replace(PkLstr,"3d","2d"); - dt1=partcrv("",p1,p2,tmp,["nodata"]); - dts=partcrv("",q1,q2,"sub"+tmp,["nodata"]); - dt=apply(1..length(dt1), - Xyzcoord(dt1_#_1,dt1_#_2,dts_#_2)); - Spaceline("-part3d"+nm,dt,options); -); - -Joincrvs3d(nm,plotstrL):=Joincrvs3d(nm,plotstrL,[]);//16.10.06 -Joincrvs3d(nm,plotstrL,options):=( -//help:Joincrvs3d("1",["bz3da1","bz3da1"]); - regional(PtL,Eps,QdL,Flg,Ni,Qd,pP,pS,pQ,pR,rMN, - opcindy,tmp,tmp1,tmp2,str,name2,name3,Ltype,Noflg); - name2="join2d"+nm; - name3="join3d"+nm; - QdL=[]; - forall(plotstrL,str, - if(isstring(str), - tmp=parse(str); - , - tmp=str; - ); - QdL=append(QdL,tmp); - ); - Eps=10^(-4); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - tmp1=tmp_6; - if(length(tmp1)>0,Eps=tmp1_1); - Flg=0; - if(length(QdL)==0, - PtL=[]; - Flg=1; - ); - if(Flg==0, - PtL=QdL_1; - forall(2..length(QdL),Ni, - Qd=QdL_Ni; - if(length(Qd)>1, - pP=PtL_1; - pS=PtL_(length(PtL)); - pQ=Qd_1; - pR=Qd_(length(Qd)); - rMN=min([norm(pP-pQ),norm(pP-pR), - norm(pS-pQ),norm(pS-pR)]); - if(rMN==norm(pP-pR), - Qd=reverse(Qd); - , - if(rMN==norm(pS-pQ), - PtL=reverse(PtL); - , - if(rMN==norm(pS-pR), - PtL=reverse(PtL); - Qd=reverse(Qd); - ); - ); - ); - ); - if(rMN>Eps, - PtL=concat(PtL,Qd); - , - PtL=concat(PtL,Qd_(2..length(Qd))); - ); - ); - ); - if(Noflg<3, - println("generate Joincurves3d "+name3); - tmp=name3+"="+textformat(PtL,5); - parse(tmp); - tmp1=Projpara(name3,["nodata"]); - tmp=name2+"="+textformat(tmp1,5); - parse(tmp); - tmp=text(plotstrL); - tmp=substring(tmp,1,length(tmp)-1); - tmp=name3+"=Joincrvs("+tmp+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, // 15.02.11 - tmp=parse(name2); // 15.08.17 - if(length(tmp)>0, - Subgraph(name3,opcindy); - ); // 15.08.17 - ); - ); - PtL; -); - -Xyzax3data(nm,Xrange,Yrange,Zrange):= - Xyzax3data(nm,Xrange,Yrange,Zrange,[]); -Xyzax3data(nm,Xrange,Yrange,Zrange,options):=( -//help:Xyzax3data("","x=[-5,5]","y=[-5,5]","z=[-5,5]"); -//help:Xyzax3data(Options2=["a1","Osw"]); - regional(name2,name3,Out,tmp,tmp1,tmp2,eqL,reL,strL, - opstr,opcindy,Ltype,Noflg,Axname,Arrow,Origin); - name2="ax2d"+nm; - name3="ax3d"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - opcindy=tmp_(length(tmp)); - Axname=1; - Arrow=0; // 16.08.14 - Origin=""; // 16.08.14 - if(length(reL)>0, - Axname=reL_1; - ); - forall(strL, // 16.08.14from - tmp1=Toupper(substring(#,0,1)); - if(tmp1=="A", - tmp=substring(#,1,length(#)); - if(length(tmp)>0, - Arrow=parse(tmp); - , - Arrow=1; - ); - ); - if(tmp1=="O", - tmp=indexof(#,","); - if(tmp>0, - Origin=substring(#,tmp,length(#)); - , - tmp=substring(#,1,length(#)); - if(length(tmp)>0, - Origin=tmp; - , - Origin="sw"; - ); - ); - ); - ); // 16.08.14until - tmp1=indexof(Xrange,"="); - tmp=parse(substring(Xrange,tmp1,length(Xrange))); - Px=[tmp_1,0,0]; Qx=[tmp_2,0,0]; - tmp1=indexof(Yrange,"="); - tmp=parse(substring(Yrange,tmp1,length(Yrange))); - Py=[0,tmp_1,0]; Qy=[0,tmp_2,0]; - tmp1=indexof(Zrange,"="); - tmp=parse(substring(Zrange,tmp1,length(Zrange))); - Pz=[0,0,tmp_1]; Qz=[0,0,tmp_2]; - Out=[[Px,Qx],[Py,Qy],[Pz,Qz]]; - if(Axname>0, - Xyzaxparaname(Xrange,Yrange,Zrange,[Axname]); - ); - if(Noflg<3, - println("generate axes "+name3); - tmp=name3+"="+textformat(Out,5); - parse(tmp); - tmp1=Projpara([name3],["nodata"]); - tmp=name2+"="+textformat(tmp1,5); - parse(tmp); - tmp=name3+"=Xyzax3data("+ - Dq+Xrange+Dq+","+Dq+Yrange+Dq+","+Dq+Zrange+Dq+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(Noflg<1, // 16.08.14from - if(Arrow>0, - tmp1=Parapt(Px); tmp2=Parapt(Qx); - Arrowhead(tmp2,tmp2-tmp1,[Arrow]); - tmp1=Parapt(Py); tmp2=Parapt(Qy); - Arrowhead(tmp2,tmp2-tmp1,[Arrow]); - tmp1=Parapt(Pz); tmp2=Parapt(Qz); - Arrowhead(tmp2,tmp2-tmp1,[Arrow]); - ); - if(length(Origin)>0, - Letter([Parapt([0,0,0]),Origin,"O"]); - ); - ); // 16.08.14until - if(SUBSCR==1, // 15.02.11 - Subgraph(name3,opcindy); - ); - ); - Out; -); - -Xyzaxparaname(Xrange,Yrange,Zrange):= - Xyzaxparaname(Xrange,Yrange,Zrange,[]); -Xyzaxparaname(Xrange,Yrange,Zrange,options):=( - regional(tmp,tmp1,tmp2,Eps,Dr,Noflg,Xname,Yname,Zname, - px,qx,py,qy,pz,qz,ph,qh,rr,ch); - Eps=10.0^(-6); - Dr=0.19*1000/2.54/MilliIn; - Noflg=0; - forall(options, - if(isreal(#),Dr=Dr*#); - ); - tmp=indexof(Xrange,"="); - Xname=substring(Xrange,0,tmp-1); - tmp=parse(substring(Xrange,tmp,length(Xrange))); - px=[tmp_1,0,0]; qx=[tmp_2,0,0]; - tmp=indexof(Yrange,"="); - Yname=substring(Yrange,0,tmp-1); - tmp=parse(substring(Yrange,tmp,length(Yrange))); - py=[0,tmp_1,0]; qy=[0,tmp_2,0]; - tmp=indexof(Zrange,"="); - Zname=substring(Zrange,0,tmp-1); - tmp=parse(substring(Zrange,tmp,length(Zrange))); - pz=[0,0,tmp_1]; qz=[0,0,tmp_2]; - ph=Parapt(px); qh=Parapt(qx); rr=|ph-qh|; - if(rr>Eps, - ch=qh+Dr/rr*(qh-ph); - Expr(ch,"c",Xname); - ); - ph=Parapt(py); qh=Parapt(qy); rr=|ph-qh|; - if(rr>Eps, - ch=qh+Dr/rr*(qh-ph); - Expr(ch,"c",Yname); - ); - ph=Parapt(pz); qh=Parapt(qz); rr=|ph-qh|; - if(rr>Eps, - ch=qh+Dr/rr*(qh-ph); - Expr(ch,"c",Zname); - ); -); - -Datalist3d():=( -//help:Datalist3d(); - regional(out,tmp,tmp2,tmp3); - tmp=apply(GCLIST,#_1); - tmp=select(tmp,indexof(#,"2d")>0); - tmp2=select(tmp,indexof(#,"sub")==0); - tmp3=apply(tmp2,replace(#,"2d","3d")); - out=tmp3; -); - -Datalist2d():=( -//help:Datalist2d(); - regional(out,tmp,tmp2,tmp3); - tmp=apply(GCLIST,#_1); - tmp=select(tmp,indexof(#,"2d")>0); - tmp2=select(tmp,indexof(#,"sub")==0); -// tmp3=apply(tmp2,replace(#,"2d","3d")); - out=tmp2; -); - -Embed(nm,Pd2str,funstr,varstr):= - Embed(nm,Pd2str,funstr,varstr,[]); -Embed(nm,Pd2str,funstr,varstr,options):=( -//help:Embed("1",["gr1"],"A3d+x*(B3d-A3d)+y*(C3d-A3d)","[x,y]"); - regional(name2,name3,Pd2L,Pd2,tmp,tmp1,xstr,ystr, - Ltype,Noflg,opstr,opcindy,Out); - name2="em2d"+nm; - name3="em3d"+nm; - if(!islist(Pd2str),Pd2L=[Pd2str],Pd2L=Pd2str); // 15.03.06 - tmp1=[]; // 15.10.31 - forall(Pd2L, - if(isstring(#),tmp=parse(#),tmp=#); - if(MeasureDepth(tmp)==2, - tmp1=concat(tmp1,tmp); - ); - if(MeasureDepth(tmp)==1, - tmp1=append(tmp1,tmp); - ); - ); - Pd2L=tmp1; - tmp=substring(varstr,0,1); - if(tmp=="[" % tmp=="(", - tmp1=substring(varstr,1,length(varstr)-1); - , - tmp1=varstr; - ); - tmp=indexof(tmp1,","); - xstr=substring(tmp1,0,tmp-1); - ystr=substring(tmp1,tmp,length(tmp1)); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - Out=[]; - forall(Pd2L,Pd2, - tmp1=[]; - forall(Pd2, - tmp=Assign(funstr,xstr,"("+textformat(#_1,5)+")"); - tmp=Assign(tmp,ystr,"("+textformat(#_2,5)+")"); - tmp=parse(tmp); - tmp1=append(tmp1,tmp); - ); - Out=append(Out,tmp1); - ); - if(length(Out)==1, - Out=Out_1; - ); - if(Noflg<3, - println("generate Embed "+name3); - if(length(Out)>0, - tmp=name3+"="+textformat(Out,5); - parse(tmp); - tmp1=Projpara(name3,["nodata"]); - tmp=name2+"="+textformat(tmp1,5); - parse(tmp); - ); - if(!islist(Pd2str), - tmp=Pd2str; - , - tmp=text(Pd2str); - tmp="list("+substring(tmp,1,length(tmp)-1)+")"; - ); - tmp=name3+"=Embed("+tmp+",'"+funstr+"','"+varstr+"'"+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - if(length(Out)>0, - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, // 15.02.11 - Subgraph(name3,opcindy); - ); - ); - ); - Out; -); - -Rotatept3d(point,w1,w2):=Rotate3pt(point,w1,w2); -Rotatept3d(point,w1,w2,center):=Rotate3pt(point,w1,w2,center); -//help:Rotatept3d(pt3d,[0,0,1],pi/2); -//help:Rotatept3d(pt3d,[0,0,1],pi/2,[1,1,1]); -Rotate3pt(point,w1,w2):=Rotate3pt(point,w1,w2,[0,0,0]); -Rotate3pt(point,w1,w2,center):=( -//help:Rotate3pt(pt3d,[0,0,1],pi/2); -//help:Rotate3pt(pt3d,[0,0,1],pi/2,[1,1,1]); - regional(Eps,ct,st,v3,v1,v2,Ans,ns,PtL,num, - pt,tmp,tmp1,tmp2,Retflg,x,y,z,xx,yy,zz,flg); - Eps=10^(-4); - Retflg=0; - if(length(w2)==1, - ct=cos(w2); - st=sin(w2); - v3=1/|w1|*w1; - if(v3_1==0, - tmp=[1,0,0]; - , - tmp=[0,1,0]; - ); - w1=[tmp_2*v3_3-tmp_3*v3_2, - tmp_3*v3_1-tmp_1*v3_3, - tmp_1*v3_2-tmp_2*v3_1]; - v1=1/|w1|*w1; - v2=[v3_2*v1_3-v3_3*v1_2, - v3_3*v1_1-v3_1*v1_3, - v3_1*v1_2-v3_2*v1_1]; - , - tmp=[w1_2*w2_3-w1_3*w2_2, - w1_3*w2_1-w1_1*w2_3, - w1_1*w2_2-w1_2*w2_1]; - if(|tmp|<Eps, - Ans=point; - Retflg=1; - ); - if(Retflg==0, - v1=1/|w1|*w1; - ns=v1_1*w2_1+v1_2*w2_2+v1_3*w2_3; - tmp=w2-ns*v1; - v2=1/|tmp|*tmp; - tmp=[v1_2*v2_3-v1_3*v2_2, - v1_3*v2_1-v1_1*v2_3, - v1_1*v2_2-v1_2*v2_1]; - v3=1/|tmp|*tmp; - ct=ns/|w2|; - st=sqrt(1-ct^2); - ); - ); - if(Retflg==0, - if(|tmp|<Eps, - Ans=point; - Retflg=1; - ); - ); - if(Retflg==0, - if(MeasureDepth(point)>0, - PtL=point; - , - PtL=[point]; - ); - Ans=[]; - flg=0; - forall(1..length(PtL),num, - pt=PtL_num; - if(pt_1=="inf", - Ans=append(Ans,["inf"]); - flg=1; - ); - if(flg==0, - x=pt_1-center_1; y=pt_2-center_2; z=pt_3-center_3; - xx=((v1_1*ct+v2_1*st)*v1_1+ (-v1_1*st+v2_1*ct)*v2_1+v3_1^2)*x - +((v1_1*ct+v2_1*st)*v1_2+(-v1_1*st+v2_1*ct)*v2_2+v3_1*v3_2)*y - +((v1_1*ct+v2_1*st)*v1_3+(-v1_1*st+v2_1*ct)*v2_3+v3_1*v3_3)*z; - yy=((v1_2*ct+v2_2*st)*v1_1+(-v1_2*st+v2_2*ct)*v2_1+v3_1*v3_2)*x - +((v1_2*ct+v2_2*st)*v1_2+(-v1_2*st+v2_2*ct)*v2_2+v3_2^2)*y - +((v1_2*ct+v2_2*st)*v1_3+(-v1_2*st+v2_2*ct)*v2_3+v3_2*v3_3)*z; - zz=((v1_3*ct+v2_3*st)*v1_1+(-v1_3*st+v2_3*ct)*v2_1+v3_1*v3_3)*x - +((v1_3*ct+v2_3*st)*v1_2+(-v1_3*st+v2_3*ct)*v2_2+v3_2*v3_3)*y - +((v1_3*ct+v2_3*st)*v1_3+(-v1_3*st+v2_3*ct)*v2_3+v3_3^2)*z; - Ans=append(Ans,center+[xx,yy,zz]); - ); - ); - if(length(Ans)==1, - Ans=Ans_1; - ); - ); - Ans; -); - -Rotatedata3d(nm,P3data,w1,w2):=Rotate3data(nm,P3data,w1,w2); -Rotatedata3d(nm,P3data,w1,w2,options):= - Rotate3data(nm,P3data,w1,w2,options); -//help:Rotatedata3d("1",["sl3d1","sc3d2"],[0,0,1],pi/3); -Rotate3data(nm,P3data,w1,w2):=Rotate3data(nm,P3data,w1,w2,[]); -Rotate3data(nm,P3data,w1,w2,options):=( - regional(name3,name2,center,pdata,Pd3,Pd,Out,tmp,tmp1, - Ltype,Noflg,opcindy,opstr); - name3="rot3d"+nm; - name2="rot2d"+nm; - center=[0,0,0]; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - tmp1=tmp_6; - if(length(tmp1)>0, - center=tmp1_1; - ); - if(islist(P3data) & isstring(P3data_1),Pd3=P3data,Pd3=[P3data]); - Out=[]; - forall(Pd3,Pd, - if(isstring(Pd),Pd=parse(Pd)); - if(MeasureDepth(Pd)==1,Pd=[Pd]); - Ans=[]; - forall(Pd, - tmp=Rotate3pt(#,w1,w2,center); - Ans=append(Ans,tmp); - ); - Out=append(Out,Ans); - ); - Out=Flattenlist(Out); - if(length(Out)==1,Out=Out_1); - if(Noflg<3, - println("generate Rotate3data "+name3); - tmp=name3+"="+textformat(Out,5); - parse(tmp); - tmp1=Projpara(name3,["nodata"]); - tmp=name2+"="+textformat(tmp1,5); - parse(tmp); - tmp=textformat(P3data,5); // 17.12.23 - tmp=RSform(tmp); // 17.12.23 -// tmp=replace(tmp,"[","list("); -// tmp=replace(tmp,"]",")"); - tmp=name3+"=Rotate3data("+tmp+"," - +textformat(w1,5)+","+textformat(w2,5)+opstr+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, // 15.02.11 - Subgraph(name3,opcindy); - ); - ); - Out; -); - -Translatept3d(point,w1):=Translate3pt(point,w1); -//help:Translatept3d(pt3d,[1,2,3]); -Translate3pt(point,w1):=( - regional(Eps,Ans,PtL,pt,num,xx,yy,zz,flg); - Eps=10^(-4); - if(MeasureDepth(point)>0, - PtL=point; - , - PtL=[point]; - ); - Ans=[]; - flg=0; - forall(1..length(PtL),num, - pt=PtL_num; - if(pt_1=="inf", - Ans=append(Ans,["inf"]); - flg=1; - ); - if(flg==0, - xx=pt_1+w1_1; yy=pt_2+w1_2; zz=pt_3+w1_3; - Ans=append(Ans,[xx,yy,zz]); - ); - ); - if(length(Ans)==1, - Ans=Ans_1; - ); - Ans; -); - -Translatedata3d(nm,P3data,w1):=Translate3data(nm,P3data,w1); -Translatedata3d(nm,P3data,w1,options):= - Translate3data(nm,P3data,w1,options); -//help:Translatedata3d("1",["sl3d1"],[1,2,3]); -Translate3data(nm,P3data,w1):=Translate3data(nm,P3data,w1,[]); -Translate3data(nm,P3data,w1,options):=( - regional(name3,name2,pdata,Pd3,Pd,Out,tmp,tmp1, - Ltype,Noflg,opcindy); - name3="tra3d"+nm; - name2="tra2d"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - if(islist(P3data) & isstring(P3data_1),Pd3=P3data,Pd3=[P3data]); - Out=[]; - forall(Pd3,Pd, - if(isstring(Pd),Pd=parse(Pd)); - if(MeasureDepth(Pd)==1,Pd=[Pd]); - Ans=[]; - forall(Pd, - tmp=Translate3pt(#,w1); - Ans=append(Ans,tmp); - ); - Out=append(Out,Ans); - ); - Out=Flattenlist(Out); - if(length(Out)==1,Out=Out_1); - if(Noflg<3, - println("generate Translate3data "+name3); - tmp=name3+"="+textformat(Out,5); - parse(tmp); - tmp1=Projpara(name3,["nodata"]); - tmp=name2+"="+textformat(tmp1,5); - parse(tmp); - tmp=textformat(P3data,5); // 17.12.23 - tmp=RSform(tmp); // 17.12.23 -// tmp=text(P3data); -// tmp=replace(tmp,"[","list("); -// tmp=replace(tmp,"]",")"); - tmp=name3+"=Translate3data("+tmp+","+textformat(w1,5)+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, // 15.02.11 - Subgraph(name3,opcindy); - ); - ); - Out; -); - -Reflectpoint3d(point,vecL):=Reflect3point(point,vecL); -Reflectpt3d(point,vecL):=Reflect3pt(point,vecL); -//help:Reflectpoint3d(pt3d,[v1,v2,v3]); -Reflect3point(point,vecL):=Reflect3pt(point,vecL); -Reflect3pt(point,vecL):=( - regional(ans,v1,v2,v3,tmp,tmp1); - if(length(vecL)==1, - v1=vecL_1; - ans=2*v1-point; - ); - if(length(vecL)==2, - v1=vecL_1; - v2=vecL_2; - v3=(v2-v1)/|v2-v1|; - tmp=v1+Dotprod(point-v1,v3)*v3; - ans=2*tmp-point; - ); - if(length(vecL)==3, - v1=vecL_1; - v2=vecL_2; - v3=vecL_3; - tmp=Crossprod(v2-v1,v3-v1); - tmp1=point-Dotprod(tmp,point-v1)/|tmp|^2*tmp; - ans=2*tmp1-point; - ); - ans; -); - -Xyzcoord(X,Y,z):=( -//help:Xyzcoord(A.x,A.y,Az.y); - regional(Eps,x3d,y3d,z3d); - x3d=(-X*sin(PHI)*cos(THETA)-Y*cos(PHI)+z*cos(PHI)*sin(THETA))/cos(THETA); - y3d=(X*cos(PHI)*cos(THETA)-Y*sin(PHI)+z*sin(PHI)*sin(THETA))/cos(THETA); - z3d=z; - [x3d,y3d,z3d]; -); - -PutonCurve3d(name,pdstr):=( -//help:PutonCurve3d("T","sc3d1"); - regional(pt,pd2str,tmp,tmp1,tmp2); - pd2str=replace(pdstr,"3d","2d"); - PutonCurve(name,pd2str); - pt=parse(name+".xy"); - tmp=Nearestpt(pt,pd2str); // 15.03.13 - tmp1=ParamonCurve(tmp_1,tmp_2,pd2str); - tmp="sub"+pd2str; - tmp2=PointonCurve(tmp1,tmp); - pt=append(pt,tmp2_2); - pt=Xyzcoord(pt_1,pt_2,pt_3); // 15.03.13 - tmp=name+"z.xy="+textformat(tmp2,5); - parse(tmp); - VLIST=select(VLIST,#_1!=name+"3d"); - Defvar(name+"3d",pt); -); - -Mkpointlist():=Mkpointlist([]); //16.11.12 -Mkpointlist(options):=( //16.11.12 - regional(Eps,pos,ptL,plist,ilist,plistrest, - inforest,free,pt,pt3,ptz,par,vlistpre, - tmp,tmp1,tmp2,tmp3,tmp4,p1,p2,flg); - Eps=10^(-4); - tmp=Finddef(NE); - free=tmp_1; - pos=[NE.x+1,NE.y]; - tmp=remove(allpoints(),[NE,SW,TH,FI]); - tmp=remove(tmp,options); //16.11.12 - plist=select(tmp, - substring(text(#),length(text(#))-1,length(text(#)))!="z" - ); - if(SUBSCR==0,plist=[]); - ptL=[]; - plistrest=[]; - inforest=[]; - forall(plist,pt, - inspect(pt,"ptsize",3); - inspect(pt,"color",2); - inspect(pt,"textsize",TSIZE); - ptz=text(pt)+"z"; - tmp=Finddef(pt); - if(indexof(tmp_1,free)>0, // free point - tmp=select(VLIST,#_1==text(pt)+"3d"); - if(length(tmp)==0, - tmp=pt.x+NE.x-SW.x; - Putpoint(ptz,[tmp,0],[tmp,parse(ptz+".y")]); - pt3=Xyzcoord(pt.x,pt.y,parse(text(ptz)+".y")); - Defvar(text(pt)+"3d",pt3); - Defvar(text(pt)+"fix",0); - vlistpre=VLIST; //16.08.20 - ); - flg=0; - if(isselected(pt), - if(parse(text(pt)+"fix")!=1, // 15.03.01 - tmp=pt.x+NE.x-SW.x; - Putpoint(ptz,[tmp,0],[tmp,parse(ptz+".y")]); - pt3=Xyzcoord(pt.x,pt.y,parse(text(ptz)+".y")); - VLIST=select(VLIST,#_1!=text(pt)+"3d"); - Defvar(text(pt)+"3d",pt3); - vlistpre=VLIST; //16.08.20 - flg=1; - ); - ); - inspect(parse(ptz),"ptsize",3); - inspect(parse(ptz),"color",3); - inspect(parse(ptz),"textsize",TSIZEZ); - if(isselected(parse(ptz)), - if(parse(ptz+"fix")!=1, // 15.03.01 - tmp=select(vlistpre,#_1==text(pt)+"3d"); //16.08.20 - pt3=tmp_1_2; - pt3_3=parse(ptz+".y"); - pt.xy=Parapt(pt3); - tmp=ptz+".x=pt.x+NE.x-SW.x"; - parse(tmp); - VLIST=select(VLIST,#_1!=text(pt)+"3d"); - Defvar(text(pt)+"3d",pt3); - flg=2; - ); - ); - if(flg==0, - tmp=select(VLIST,#_1==text(pt)+"3d"); - if(length(tmp)>0, //17.10.07 - pt3=tmp_1_2; - pt.xy=Parapt(pt3); - tmp=ptz+".x=pt.x+NE.x-SW.x"; - parse(tmp); - ); //17.10.07 - ); - if(isselected(pt) % isselected(parse(ptz)), - drawtext(pos,text(pt3)); - ); - if(!contains(["p","q"],text(pt)), - ptL=append(ptL,pt); - ); - , - tmp=Findgeoinfo(pt); - tmp1=[parse(tmp_1),parse(tmp_2),parse(tmp_3)]; - plistrest=append(plistrest,pt); - inforest=append(inforest,tmp); - ); - ); - if(length(plistrest)>0, - tmp=Sortpointlist([plistrest,inforest]); - plist=tmp_1; - ilist=tmp_2; - forall(1..length(plist), - pt=plist_#; - ptz=text(pt)+"z"; - tmp=ilist_#; - p1=parse(tmp_3); - p2=p1+parse(tmp_2)-parse(tmp_1); - tmp1=p2-p1; - tmp2=pt-p1; - if(abs(tmp1_1)>abs(tmp1_2), - par=tmp2_1/tmp1_1; - , - par=tmp2_2/tmp1_2; - ); - tmp=ilist_#; - tmp1=parse(tmp_1+"3d"); - tmp2=parse(tmp_2+"3d"); - tmp3=parse(tmp_3+"3d"); - tmp1=(1-par)*tmp3+par*(tmp3+tmp2-tmp1); - Putpoint(ptz,[pt.x+NE.x-SW.x,tmp1_3]); - inspect(parse(ptz),"ptsize",3); - inspect(parse(ptz),"color",3); - inspect(parse(ptz),"textsize",TSIZEZ); - pt3=Xyzcoord(pt.x,pt.y,parse(text(ptz)+".y")); - VLIST=select(VLIST,#_1!=tmp1+"3d"); - Defvar(text(pt)+"3d",pt3); - vlistpre=VLIST; //16.08.20 - if(isselected(pt) % isselected(parse(ptz)), - drawtext(pos,text(pt3)); - ); - if(!contains(["p","q"],text(pt)), - ptL=append(ptL,pt); - ); - ); - ); - ptL; -); - -Mkseg3d():=Mkseg3d([]); -Mkseg3d(options):=( - regional(seg,nmseg,def,ptA,ptB,segL,opstr,opcindy, - name,strg,Ltype,Noflg,tht,tmp,tmp1,tmp2,tmp3); - name="geoseg3d"; - strg=name+"=list("; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - segL=[]; - forall(allsegments(),seg, - inspect(seg,"labeled",false); - tmp=Finddef(seg); - def=tmp_1; - ptA=tmp_2; - ptB=tmp_3; - if(ispoint(parse(ptA)) & ispoint(parse(ptB)), - tmp1=select(VLIST,indexof(#_1,ptA+"3d")>0); - tmp2=select(VLIST,indexof(#_1,ptB+"3d")>0); - if(length(tmp1)>0 & length(tmp2)>0, - tmp1="["+ptA+"3d,"+ptB+"3d]"; - nmseg=ptA+ptB; -// Spaceline(nmseg,parse(tmp1),append(options,"Msg=nodisp")); //15.06.15 - Spaceline("-"+nmseg+"3d",[ptA+"3d",ptB+"3d"], // 16.04.07 - append(options,"Msg=nodisp")); //15.06.15 - segL=append(segL,nmseg+"3d");// 16.04.07 - strg=strg+nmseg+"3d,";// 16.04.07 - ); - ); - ); - println("generate totally "+name); - if(length(segL)>0, // 15.03.06 - strg=substring(strg,0,length(strg)-1)+")"; - if(Noflg<3, - GLIST=append(GLIST,strg); - ); - tmp1=apply(segL,Dq+#+Dq); //15.03.02 - tmp=name+"="+text(tmp1); - parse(tmp); - ); - segL; -); - -Ptseg3data():=Ptseg3data([]); -//help:Ptseg3data(); -//help:Ptseg3data([A,B]); -Ptseg3data(options):=( - regional(pt,pt3,plist,tmp,tmp1,tmp2); - if(isselected(TH) % isselected(FI), - tmp=remove(allpoints(),[NE,SW,TH,FI]); - tmp=remove(tmp,options); //16.11.12 - tmp=apply(tmp,text(#)); - plist=select(tmp,substring(#,length(#)-1,length(#))!="z"); - forall(plist,pt, - tmp1=text(pt); - tmp=select(VLIST,#_1==tmp1+"3d"); //17.10.07 - if(length(tmp)>0, - pt3=tmp_1_2; - tmp=tmp1+".xy=Parapt("+pt3+")_[1,2];"; - parse(tmp); - if(SUBSCR==1, - tmp=tmp1+"z"+".x=NE.x-SW.x+"+tmp1+".x"; - parse(tmp); - ); - ); - ); - , - Mkpointlist(options); // 16.12.18 - ); - forall(alllines(), - #.color=[0.5,0.5,1]; - ); - SEG3dlist=Mkseg3d(options); - SEG3dlist; -); - -Putonseg3d(name,ptL):=Putonseg3d(name,ptL_1,ptL_2,[]); -Putonseg3d(name,Arg1,Arg2):=( - if(islist(Arg1), - Putonseg3d(name,Arg1_1,Arg1_2,Arg2); - , - Putonseg3d(name,Arg1,Arg2,[]); - ); -); -Putonseg3d(name,pt1,pt2,options):=( -//help:Putonseg3d("C",[A,B]); -//help:Putonseg3d("C",A,B); - regional(par,pn1,pn2,tmp,tmp1,tmp2,tmp3); - par=0.5; - tmp=divoptions(options); - if(length(tmp_6)>0, - par=tmp_6_1; - ); - Putonseg(name,pt1,pt2,[par]); - inspect(parse(name),"ptsize",3); - inspect(parse(name),"color",2); - inspect(parse(name),"textsize",TSIZEZ); - Putpoint(name+"z",[parse(name+".x"),0]); - inspect(parse(name+"z"),"ptsize",3); - inspect(parse(name+"z"),"color",3); - inspect(parse(name+"z"),"textsize",TSIZEZ); - pn1=text(pt1); - pn2=text(pt2); - tmp1=replace("PTCz.y=PTAz.y+|PTC-PTA|/|PTB-PTA|*(PTBz.y-PTAz.y)","PTC",name); - tmp1=replace(tmp1,"PTA",pn1); - tmp1=replace(tmp1,"PTB",pn2); - tmp2=replace("PTCz.x=PTAz.x+|PTC-PTA|/|PTB-PTA|*(PTBz.x-PTAz.x)","PTC",name); - tmp2=replace(tmp2,"PTA",pn1); - tmp2=replace(tmp2,"PTB",pn2); - parse(tmp2); - parse(tmp1); - tmp1=parse(name+".x"); - tmp2=parse(name+".y"); - tmp3=parse(name+"z.y"); - tmp=Xyzcoord(tmp1,tmp2,tmp3); - Defvar(name+"3d",tmp); -); - -Putpoint3d(ptslist):=Putpoint3d(ptslist,"",0); -Putpoint3d(Arg1,Arg2):=( // 16.03.02 from - if(islist(Arg1), - Putpoint3d(Arg1,Arg2,0); - , - Putpoint3d(Arg1,Arg2,"fix"); - ); -); -Putpoint3d(Arg1,Arg2,Arg3):=( -//help:Putpoint3d(["A",[2,1,3]]); -//help:Putpoint3d(["A",[2,1,3]],"fix"); -//help:Putpoint3d("A",[2,1,3]); -//help:Putpoint3d(["A",[2,1,3]],["fix"]); - regional(nn,kk,pt,pt3,ptslist,fixstr,tmp,tmp1,tmp2,tmp3); //16.08.19 - if(isstring(Arg1), - ptslist=[Arg1,Arg2]; - fixstr=Arg3; - , - ptslist=Arg1; - fixstr=Arg2; - ); - if(islist(fixstr),fixstr=fixstr_1);// 16.03.02 until - nn=length(ptslist)/2; - forall(1..nn,kk, // 16.08.19from - tmp1=ptslist_(2*kk-1); - pt3=ptslist_(2*kk); // 16.08.19until - VLIST=select(VLIST,#_1!=tmp1+"3d"); - tmp2=parse(tmp1); - if(ispoint(tmp2), // 16.05.26from - if(islist(fixstr),tmp=fixstr_1,tmp=fixstr); - tmp=Toupper(tmp); - if(tmp!="FIX", - tmp=Xyzcoord(tmp2.x,tmp2.y,parse(tmp1+"z").y); - , - tmp=pt3; - ); - Defvar(tmp1+"3d",tmp); - , - Defvar(tmp1+"3d",pt3); - ); // 16.05.26until - Defvar(tmp1+"fix",0); - pt=Parapt(pt3); - Putpoint(tmp1,pt,parse(tmp1+".xy")); - inspect(parse(tmp1),"ptsize",3); - inspect(parse(tmp1),"color",2); - inspect(parse(tmp1),"textsize",TSIZE); - if(SUBSCR==1, - tmp2=tmp1+"z"; - tmp=[pt.x+NE.x-SW.x,pt3_3]; - tmp1="[NE.x-SW.x+"+tmp1+".x,"+tmp2+"y]"; - Putpoint(tmp2,tmp,parse(tmp1)); - inspect(parse(tmp2),"ptsize",3); - inspect(parse(tmp2),"color",3); - inspect(parse(tmp2),"textsize",TSIZEZ); - ); - ); - if(islist(fixstr),tmp=fixstr_1,tmp=fixstr); - if(tmp=="fix" % tmp=="Fix", - Fixpoint3d(ptslist); - ); -); - -Fixpoint3d(ptlist):=( -// help:Fixpoint3d(["O",[0,0,0],"X",[1,0,0]]); - regional(name,pt3,pt2,tmp,tmp1,tmp2); - forall(1..(length(ptlist)/2), - name=ptlist_(2*#-1); - Defvar(name+"fix",1); - pt3=ptlist_(2*#); - pt2=Parapt(pt3); - tmp1=textformat(pt2_1,5); - tmp2=textformat(pt2_2,5); - tmp=name+".xy=["+tmp1+","+tmp2+"]"; - parse(tmp); - tmp1=name+".x+NE.x-SW.x"; - tmp2=textformat(pt3_3,5); - tmp=name+"z.xy=["+tmp1+","+tmp2+"];"; - parse(tmp); - ); -); - -Perppt(name,ptstr,pLstr):=Putperp(name,ptstr,pLstr,"draw"); -Perppt(name,ptstr,pLstr,option):=Putperp(name,ptstr,pLstr,option); -Putperp(name,ptstr,pLstr):=Putperp(name,ptstr,pLstr,"put"); -Putperp(name,ptstr,pLstr,option):=( -//help:Perppt("N","O","A-B-C"); -//help:Perppt("N","O","A-B-C","put"); -//help:Perppt("N","O","A-B","none"); - regional(out,Eps,N3d,sgstr,pP,pA,pB,pC,tmp,tmp1,flgpL); - Eps=10^(-4); - pP=parse(ptstr+"3d"); - tmp=indexof(pLstr,"-"); - pA=parse(substring(pLstr,0,tmp-1)+"3d"); - tmp1=substring(pLstr,tmp,length(pLstr)); - tmp=indexof(tmp1,"-"); - if(tmp>0, - pB=parse(substring(tmp1,0,tmp-1)+"3d"); - pC=parse(substring(tmp1,tmp,length(tmp1))+"3d"); - flgpL=1; - , - pB=parse(tmp1+"3d"); - flgpL=0; - ); - if(flgpL==1, - tmp=Crossprod(pB-pA,pC-pA); - if(abs(tmp)<Eps, - err("not a plane"); - , - tmp=tmp/|tmp|; - N3d=pP+tmp; - Defvar("tmp3d",N3d); // temporary - sgstr=ptstr+"-tmp"; - tmp=IntersectsgpL(name,sgstr,pLstr,"none"); - VLIST=select(VLIST,#_1!="tmp3d"); - out=tmp_1; - Defvar(name+"3d",tmp_1); - ); - , - if(|pB-pA|<Eps, - err("on the line"); - , - tmp1=(pB-pA)/|pB-pA|; - tmp=Dotprod(pP-pA,tmp1); - out=pA+tmp*tmp1; - Defvar(name+"3d",out); - ); - ); - if(islist(option),tmp=option_1,tmp=option); - tmp=substring(tmp,0,1); - if(tmp=="P" % tmp=="p", - Putpoint3d([name,out]); - Fixpoint3d([name,out]); - ); - if(tmp=="D" % tmp=="d", - Drawpoint3d(out); - ); - out; -); - -Perpplane(name,ptstr,nvec):= - Perpplane(name,ptstr,nvec,"draw"); -Perpplane(name,ptstr,nstr,option):=( -//help:Perpplane("A-B","P",[1,3,2]); -//help:Perpplane("A-B","P",[0,0,1,0]); - regional(Eps,nvec,sgstr,pP,v1,v2,v3, - th,ph,pA,pB,tmp,tmp1,tmp2); - Eps=10^(-4); - if(isstring(nstr),nvec=parse(nstr+"3d"),nvec=nstr); - pP=parse(ptstr+"3d"); - v3=nvec/|nvec|; - th=THETA; ph=PHI; - tmp=findangle(v3); - THETA=tmp_1; PHI=tmp_2; - v1=Cancoordpara([1,0,0]); - v2=Cancoordpara([0,1,0]); - THETA=th; PHI=ph; - tmp=indexof(pLstr,"-"); - pA=pP+v1; - pB=pP+v2; - if(islist(option),tmp=option_1,tmp=option); - tmp=Toupper(substring(tmp,0,1)); // 16.06.19 - if(tmp=="P", - tmp=indexof(name,"-"); - tmp1=substring(name,0,tmp-1); - tmp2=substring(name,tmp,length(name)); - Putpoint3d([tmp1,pA,tmp2,pB],["fix"]); - ); - if(tmp=="D", - Drawpoint3d(pA); - Drawpoint3d(pB); - ); - [pA,pB]; -); - -Drawpoint3d(pt3):=( -//help:Drawpoint3d(pt3d); - regional(ptL,tmp,tmp1,tmp2); - if(MeasureDepth(pt3)==0,ptL=[pt3],ptL=pt3); - forall(ptL, - tmp=parapt(#); - draw(tmp_(1..2)); - if(SUBSCR==1, - draw([tmp_1+NE.x-SW.x, #_3]); - ); - ); -); - -Putaxes3d(size):=( -//help:Putaxes3d(5); -//help:Putaxes3d([1,2,3]); - regional(sL); - if(islist(size),sL=size,sL=[size,size,size]); - Putpoint3d(["O",[0,0,0]],"fix"); //17.06.02from - Putpoint3d(["X",[sL_1,0,0]],"fix"); - Putpoint3d(["Y",[0,sL_2,0]],"fix"); - Putpoint3d(["Z",[0,0,sL_3]],"fix"); -// Fixpoint3d(["O",[0,0,0]]); -// Fixpoint3d(["X",[sL_1,0,0],"Y",[0,sL_2,0],"Z",[0,0,sL_3]]);//17.06.02funtil -); - -IntersectsgpL(name,sgstr,pLstr):= - IntersectsgpL(name,sgstr,pLstr,"draw"); -IntersectsgpL(name,sgstr,pLstr,option):=( -//help:IntersectsgpL("R","P-Q","A-B-C"); -//help:IntersectsgpL("R","P-Q","A-B-C","put"); -//// help:IntersectsgpL("","P-Q","A-B-C","none"); -//help:IntersectsgpL("",[p1,p2],[p3,p4,p5],"draw"); - regional(opstr,out,pP,pQ,pA,pB,pC,pH,pK,pR,tseg,tt,ss,Eps,flg, - nvec,tmp,tmp1,tmp2,tmp3,tmp4); - if(islist(option),opstr=option_1,opstr=option); - Eps=10^(-4); - flg=0; - if(!isstring(sgstr), // 15.05.29 - pP=sgstr_1; - pQ=sgstr_2; - , - tmp=indexof(sgstr,"-"); - if(tmp>0, // 15.05.28 - pP=parse(substring(sgstr,0,tmp-1)+"3d"); - pQ=parse(substring(sgstr,tmp,length(sgstr))+"3d"); - , - tmp1=parse(sgstr); - pP=tmp1_1; - pQ=tmp1_2; - ); - ); - if(!isstring(pLstr), // 16.02.02 - pA=pLstr_1; - pB=pLstr_2; - pC=pLstr_3; - , - tmp=indexof(pLstr,"-"); - pA=parse(substring(pLstr,0,tmp-1)+"3d"); - tmp1=substring(pLstr,tmp,length(pLstr)); - tmp=indexof(tmp1,"-"); - pB=parse(substring(tmp1,0,tmp-1)+"3d"); - pC=parse(substring(tmp1,tmp,length(tmp1))+"3d"); - ); - nvec=Crossprod(pB-pA,pC-pA); - if(abs(Dotprod(nvec,pQ-pP))>Eps, - pH=(Reflect3point(pP,[pA,pB,pC])+pP)/2; - pK=(Reflect3point(pQ,[pA,pB,pC])+pQ)/2; - tmp1=pP-pH; - tmp2=tmp1+pK-pQ; - tmp=select(tmp2,abs(#)==max(apply(tmp2,abs(#)))); - tmp=select(1..3,tmp2_#==tmp_1); - tmp=tmp_1; - tseg=tmp1_tmp/tmp2_tmp; - pR=(1-tseg)*pH+tseg*pK; - tmp=substring(opstr,0,1); - if(Toupper(tmp)=="P", - Putpoint3d([name,pR]); - Fixpoint3d([name,pR]); - ); - if(Toupper(tmp)=="D", - Drawpoint3d(pR); - ); - tmp=Dotprod(pB-pA,pC-pA); - tmp1=Dotprod(pB-pA,pB-pA); - tmp2=Dotprod(pC-pA,pC-pA); - tmp3=Dotprod(pR-pA,pB-pA); - tmp4=Dotprod(pR-pA,pC-pA); - ss=-(tmp*tmp4-tmp3*tmp2)/(tmp1*tmp2-tmp^2); - tt=(tmp1*tmp4-tmp*tmp3)/(tmp1*tmp2-tmp^2); - out=[pR,tseg,ss,tt]; - , - if(Toupper(substring(opstr,0,1))!="N", - println(" "+sgstr+","+pLstr+" are parallel"); - ); - out=[]; - ); - out; -); - -Bezier3d(nm,ptctrlist):=Bezier3(nm,ptctrlist); -Bezier3d(nm,Ag1,Ag2):=Bezier3(nm,Ag1,Ag2); -Bezier3d(nm,ptlistorg,ctrlistorg,options):= - Bezier3(nm,ptlistorg,ctrlistorg,options); -//help:Bezier3d("1",["A","B","C"],["D","E","F","G"]); -Bezier3(nm,ptctrlist):=Bezier3(nm,ptctrlist_1,ptctrlist_2,[]); -Bezier3(nm,Ag1,Ag2):=( - if(MeasureDepth(Ag1)==0, - Bezier3(nm,Ag1,Ag2,[]); - , - if(MeasureDepth(Ag1)>1, - Bezier3(nm,Ag1_1,Ag1_2,Ag2); - , - if(isstring(Ag_1_1), - Bezier3(nm,Ag1,Ag2,[]); - , - Bezier3(nm,Ag1_1,Ag1_2,Ag2); - ); - ); - ); -); -Bezier3(nm,ptlistorg,ctrlistorg,options):=( //17.10.08 greatly changed - regional(name,name3,name2,tmp,tmp1,tmp2, - Ltype,Noflg,opstr,eqL,Num,ii,knt,ctr,out); - name="bz"+nm; - name3="bz3d"+nm; - name2="bz2d"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - opcindy=tmp_(length(tmp)); - Num=20; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="N", - Num=parse(tmp2); - ); - ); - ptlist=ptlistorg; - if(isstring(ptlistorg_1),ptlist=apply(ptlistorg,parse(#+"3d"))); - ctrlist=ctrlistorg; - if(isstring(ctrlistorg_1),ctrlist=apply(ctrlistorg,parse(#+"3d"))); - out=[]; - forall(1..(length(ptlist)-1),ii, - knt=[ptlist_ii,ptlist_(ii+1)]; - ctr=[ctrlist_(2*ii-1),ctrlist_(2*ii)]; - tmp="Bezierpt(T,ptlist,ctrlist)";//17.01.04 - tmp=Assign(tmp,"ptlist",knt); - tmp=Assign(tmp,"ctrlist",ctr); - Spacecurve(name+text(ii),tmp,"T=[0,1]",append(eqL,"nodisp")); - GLIST=GLIST_(1..(length(GLIST)-2)); - out=append(out,name3+text(ii)); - ); - tmp1=[]; - forall(1..length(out), - tmp=parse(out_#); - if(#==1,tmp1=tmp,tmp1=concat(tmp1,tmp_(2..length(tmp)))); - ); - if(Noflg<3, - println("generate Beziercurve "+name3); - tmp=name3+"="+tmp1; - parse(tmp); - tmp1=Projpara(name3,["nodata"]); - tmp=name2+"="+textformat(tmp1,5); - parse(tmp); - ptlist=apply(ptlistorg,#+"3d"); - ptlist=RSform(text(ptlist),1); - ctrlist=[]; - forall(1..(length(ctrlistorg)/2), - tmp=[ctrlistorg_(2*#-1),ctrlistorg_(2*#)]; - tmp=apply(tmp,#+"3d"); - ctrlist=append(ctrlist,tmp); - ); - ctrlist=RSform(text(ctrlist),0); - tmp=name3+"=Bezier("+ptlist+","+ctrlist+","+Dq+"Num="+text(Num)+Dq+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, // 15.02.11 - Subgraph(name3,opcindy); - ); - ); - out; -); - -Putbezier3data(name,pt3Lorg):=Putbezier3data(name,pt3Lorg,[]); -Putbezier3data(name,pt3Lorg,options):=( // 17.10.08 greatly changed - regional(pt3L,psize,Deg,nn,numstr, - tmp,tmp1,tmp2,tmp3,pts,ctrpts); - tmp=Divoptions(options); - Deg=3; - tmp1=tmp_5; - forall(tmp1, - if(substring(#,0,1)=="D", - tmp=indexof(#,"="); - Deg=parse(substring(#,tmp,length(#))); - ); - ); - pt3L=pt3Lorg; - if(isstring(pt3L_1),pt3L=apply(pt3L,parse(#+"3d"))); - ctrpts=[]; - forall(2..length(pt3L),nn, // 16.08.19from - numstr=text(nn-1); // 16.08.19 - if(Deg==3, - tmp1=name+numstr+"p"; - tmp2=(2*pt3L_(nn-1)+pt3L_(nn))/3; - VLIST=select(VLIST,#_1!=tmp1+"3d"); // 16.08.19from - Putpoint3d([tmp1,tmp2]); - ctrpts=append(ctrpts,tmp1); - tmp1=name+numstr+"q"; - tmp3=(pt3L_(nn-1)+2*pt3L_nn)/3; - VLIST=select(VLIST,#_1!=tmp1+"3d"); - Putpoint3d([tmp1,tmp3]); - ctrpts=append(ctrpts,tmp1); - , - tmp1=name+numstr+"p"; - tmp2=(pt3L_(nn-1)+pt3L_nn)/2; - VLIST=select(VLIST,#_1!=tmp1+"3d"); // 16.08.19until - Putpoint3d([tmp1,tmp2]); - ctrpts=append(ctrpts,tmp1); - ); - ); - ctrpts; -); - -Mkbezierptcrv3d(ptdata):=Mkbezierptcrv3(ptdata); -Mkbezierptcrv3d(ptdata,options):=Mkbezierptcrv3(ptdata,options); -//help:Mkbezierptcrv3d(["A","B","C","D"]); -Mkbezierptcrv3(ptdata):=Mkbezierptcrv3(ptdata,[]); -Mkbezierptcrv3(ptdata,options):=( //17.10.08 greatly changed - regional(Eps,name,bz,pt,p1,p2,p13d,p23d,pt3, - Out,tt,pos,tmp,tmp1,tmp2); - Eps=10^(-4); - pos=[NE.x+1,NE.y]; - Out=[]; - tmp=floor((BezierNumber3-1)/26);// 15.02.23 from - if(tmp==0,tmp="",tmp=text(tmp)); - tmp2=mod(BezierNumber3,26); - if(tmp2==0,tmp2=26); - name=unicode(text(96+tmp2),base->10)+tmp; - tmp2=Putbezier3data(name,ptdata,options); - Bezier3(name,ptdata,tmp2,options); - Out=append(Out,tmp2); - BezierNumber3=BezierNumber3+1; - Out; -); - -/////////////////////////////////////////// - -Readobj(filename):=Readobj(filename,[]); -Readobj(filename,options):=( -//help:Readobj("file.obj",["size=-3"]); - regional(eqL,size,vL,fnL,tmp,tmp1,tmp2); - size=1; - tmp=Divoptions(options); - eqL=tmp_5; - forall(eqL, - if(Toupper(substring(#,0,1))=="S", - tmp=indexof(#,"="); - size=parse(substring(#,tmp,length(#))); - ); - ); - tmp=load(filename); - tmp=tokenize(tmp,"v"); - tmp1=tmp_(2..(length(tmp)-1)); - tmp2=tmp_(length(tmp)); - tmp2=tokenize(tmp2,"f"); - tmp1=append(tmp1,tmp2_1); - tmp1=apply(tmp1,Removespace(#)); - tmp1=apply(tmp1,replace(#," "," ")); - tmp1=apply(tmp1,"["+replace(#," ",",")+"]"); - vL=apply(tmp1,size*parse(#)); - tmp2=tmp2_(2..(length(tmp2))); - tmp2=apply(tmp2,Removespace(#)); - tmp2=apply(tmp2,replace(#," "," ")); - tmp2=apply(tmp2,"["+replace(#," ",",")+"]"); - fnL=apply(tmp2,parse(#)); - [vL,fnL]; -); - -///////////////////////////////////////// - -Readobj(filename,options):=( -//help:Readobj("file.obj",["size=-3"]); - regional(eqL,size,vL,fnL,dtL,numer,flg,flg2, - tmp,tmp1,tmp2,tmp3,tmp4,tmp5); - size=1; - tmp=Divoptions(options); - eqL=tmp_5; - forall(eqL, - if(Toupper(substring(#,0,1))=="S", - tmp=indexof(#,"="); - size=parse(substring(#,tmp,length(#))); - ); - ); - numer="-0123456789"; - tmp=load(filename); - dtL=tokenize(tmp,"v "); - vL=[]; - fnL=[]; - flg=0; - flg2=0; - forall(dtL,dt, - tmp1=Removespace(dt); - if(indexof(numer,substring(tmp1,0,1))>0, - tmp2=""; - tmp=indexof(tmp1,"f"); - if(tmp>0, - tmp2=substring(tmp1,tmp-1,length(tmp1)); - tmp1=substring(tmp1,0,tmp-1); - if(substring(tmp1,length(tmp1)-1,length(tmp1))=="#", - tmp2="#"+tmp2; - tmp1=substring(tmp1,0,length(tmp1)-1); - ); -// tmp=indexof(tmp2,"#"); -// if(tmp>0, -// tmp2=substring(tmp2,0,tmp-1); -// ); - ); - if(flg==1, - tmp1=""; - flg=0; - ); - if(length(tmp1)>0, - tmp=indexof(tmp1,"#"); - if(tmp>0, - tmp1=substring(tmp1,0,tmp-1); - flg=1; - ); - tmp=indexof(tmp1,"vt"); - if(tmp>0, - tmp1=substring(tmp1,0,tmp-1); - ); - tmp1=replace(tmp1," ",","); - tmp1=replace(tmp1," ",","); - tmp1="["+tmp1+"]"; - tmp1=size*parse(tmp1); - vL=append(vL,tmp1); - ); - if(length(tmp2)>0, - tmp2=tokenize(tmp2,"f"); - if(length(tmp2_1)==0, - tmp2=tmp2_(2..length(tmp2)); - // , - // if(tmp2_1=="#", -// tmp2=tmp2_(2..length(tmp2)); -// tmp2_1="#"+tmp2_1; -// ); - ); - forall(1..length(tmp2),tmp3, - tmp=tmp2_tmp3; - if(substring(tmp,length(tmp)-1,length(tmp))=="#", - tmp2_(tmp3+1)="#"+Removespace(tmp2_(tmp3+1)); - tmp2_tmp3=substring(tmp,0,length(tmp)-1); - ); - tmp5=""; - if(length(tmp2_tmp3)>0, - tmp4=tokenize(tmp2_tmp3," "); - forall(tmp4, - if(length(text(#))>0, - if(indexof(text(#),"/")==0, - tmp=text(#); - , - tmp=tokenize(text(#),"/"); - tmp=tmp_1; - ); - if(length(tmp)>0, - tmp5=tmp5+tmp+","; - ); - ); - ); - tmp5=substring(tmp5,0,length(tmp5)-1); - if(length(tmp5)>0, - if(substring(tmp5,0,1)!="#", - tmp5="["+tmp5+"]"; - fnL=append(fnL,parse(tmp5)); - ); - ); - ); - ); - ); - ); - ); - [vL,fnL]; -); - -Concatobj(objL):=Concatobj(objL,[]); -Concatobj(objL,options):=( -//help:Concatobj([polyhed,triangle]); -//help:Concatobj([polyhed,triangle],["Rmf=no"]); -//help:Concatobj([[A,B,C],[A,C,D]]); - regional(obj,vL,fL,vadd,vtx,faces,fnew,face,jj,kk,vctr,eps, - tmp,tmp1,tmp2,tmp3,eqL,rmf); - tmp=divoptions(options); - eqL=tmp_5; - rmf="y"; // 16.08.19 - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=Toupper(substring(#,tmp,tmp+1)); - if(tmp1=="R", - if(tmp2=="Y",rmf="y"); // 16.08.14 - ); - ); - eps=10^(-4); - vL=[]; - fL=[]; - vctr=0; - forall(objL,obj, - if(isstring(obj), - tmp1=parse(obj); - , - tmp1=obj; - ); - if(length(tmp1)>2, // 16.02.28 - tmp=1..length(tmp1); - tmp1=[tmp1,[tmp]]; - ); - vtx=tmp1_1; // 16.02.11 from - faces=tmp1_2; - fnew=faces; - vctr=0; - vadd=[]; - forall(1..length(vtx),jj, - tmp1=vtx_jj; - tmp=select(1..length(vL),dist3d(vL_#,tmp1)<eps); - if(length(tmp)==0, - vadd=append(vadd,tmp1); - vctr=vctr+1; - tmp2=length(vL)+vctr; - , - tmp2=tmp_1; - ); - forall(1..length(faces),kk, - face=faces_kk; - tmp=select(1..length(face),face_#==jj); - if(length(tmp)>0, - tmp1=tmp_1; - fnew_kk_tmp1=tmp2; - ); - ); - ); - vL=concat(vL,vadd); - fL=concat(fL,fnew); // 16.02.11 until - ); - tmp2=apply(1..length(fL),1); - if(rmf=="y", - forall(1..length(fL),jj, - tmp=fL_jj; - tmp1=select((jj+1)..length(fL),fL_#==tmp); - forall(tmp1,tmp2_#=0); - ); - tmp=select(1..length(tmp2),tmp2_#==1); - fL=fL_tmp; - ); - [vL,fL]; -); - -if(1==0, - -Mkobjfile(fname,objL):=Mkobjfile(Dirwork,fname,objL); -Mkobjfile(path,fnameorg,objL):=( -//help:Mkobj(filename,objlist); - regional(fname,obj,vtx,face,tmp,tmp1,tmp2); - fname=fnameorg; - if(indexof(fname,".")==0,fname=fname+".obj"); - vtx=objL_1; - face=objL_2; - setdirectory(path); - SCEOUTPUT = openfile(fname); - forall(vtx,tmp1, - tmp2=tmp1; - if(ispoint(tmp1), - tmp2=parse(text(tmp1)+"3d"); - ); - tmp="v "+format(tmp2_1,5)+" "+format(tmp2_2,5)+" "+format(tmp2_3,5); - println(SCEOUTPUT,tmp); - ); - forall(face,tmp1, - tmp="f"; - forall(tmp1, - tmp=tmp+" "+text(#); - ); - println(SCEOUTPUT,tmp); - ); - closefile(SCEOUTPUT); - setdirectory(Dirwork); -); - -); - -VertexandEdge(nm,vfnL):=VertexEdgeFace(nm,vfnL,[]); -VertexandEdge(nm,vfnL,options):=VertexEdgeFace(nm,vfnL,options); -VertexEdgeFace(nm,vfnL):=VertexEdgeFace(nm,vfnL,[]); // 16.02.10 -//help:VertexEdgeFace("1",[vL,fnL]); -//help:VertexEdgeFace("1",["A","B","C"]); -//help:VertexEdgeFace(options=["Pt=fix","Edg=geo"]); -VertexEdgeFace(nm,vfnLorg,optionorg):=( - regional(name3,namev,namee,namef,vfnL,options,Noflg,eqL,strL, - vL,eL,enL,face,edge,vtx,vname,fixflg,edgflg,tmp,tmp1,tmp2); - name3="phvef"+nm; - namev="phv3d"+nm; - namee="phe3d"+nm; - namef="phf3d"+nm; - options=optionorg; - vfnL=vfnLorg; // 16.06.19from - if(length(vfnL)>2, - vfnL=[vfnL,[1..length(vfnL)]]; - ); - if(length(vfnL)==1, - vfnL=[vfnL_1,[1..length(vfnL_1)]]; - ); // 16.06.19until - tmp=Divoptions(options); - Noflg=tmp_2; - eqL=tmp_5; - strL=tmp_7; - fixflg=1; - edgflg=1; - forall(eqL, - tmp1=Toupper(substring(#,0,1)); - tmp=indexof(#,"="); - tmp2=Toupper(substring(#,tmp,length(#))); - if(tmp1=="P", - if(tmp2=="FREE", fixflg=0); - options=remove(options,[#]); - ); - if(tmp1=="E", - if(substring(tmp2,0,1)=="N", edgflg=0); - options=remove(options,[#]); - ); - ); - forall(strL, - if(Toupper(#)=="FREE", - fixflg=0; - options=remove(options,[#]); - ); - ); - vL=[]; - forall(1..length(vfnL_1), - vtx=vfnL_1_#; // 16.02.10 from - if(isstring(vtx),vtx=parse(vtx)); // 16.06.19 - if(ispoint(vtx), - tmp=parse(text(vtx)+"3d"); - vname=text(vtx); -// tmp=parse(text(vtx)+"3d"); -// tmp="v"+text(#)+"3d="+textformat(tmp,5); -// parse(tmp); - , - vname="v"+text(#); - if(fixflg==1, - Putpoint3d(["v"+text(#),vtx],"fix"); - ); - ); - vL=append(vL,vname); // 16.02.10 until - ); - eL=[]; - forall(vfnL_2,face, - forall(1..length(face), - tmp1=face_#; - if(#<length(face), - tmp2=face_(#+1); - , - tmp2=face_1; - ); - if(tmp2<tmp1, - tmp=tmp2; tmp2=tmp1; tmp1=tmp; - ); -// tmp1="v"+text(tmp1)+"3d"; -// tmp2="v"+text(tmp2)+"3d"; - tmp1=vL_tmp1+"3d"; - tmp2=vL_tmp2+"3d"; - tmp=select(eL,#==[tmp1,tmp2] % #==[tmp2,tmp1]); - if(length(tmp)==0, - eL=append(eL,[tmp1,tmp2]); - ); - ); - ); - if(Noflg<3, - enL=[]; - forall(eL,edge, - if(edgflg==0, - if(Noflg<2, - tmp1=edge_1;//parse(edge_1); - tmp2=edge_2;//parse(edge_2); - tmp="sl3d"+edge_1+edge_2; - if(islist(parse(tmp)), - Changestyle3d([tmp],["nodisp"]); - ); - tmp="sl3d"+edge_2+edge_1; - if(islist(parse(tmp)), - Changestyle3d([tmp],["nodisp"]); - ); - tmp=replace(edge_1+edge_2,"3d",""); - options=append(options,"Msg=no"); - Spaceline("-"+tmp,[tmp1,tmp2],options); //16.02.28 - ); - enL=append(enL,tmp+"3d"); //16.02.29 - , - tmp1=replace(edge_1,"3d",""); - tmp2=replace(edge_2,"3d",""); - tmp=tmp1+tmp2; - create([tmp],"Segment",[parse(tmp1),parse(tmp2)]); - enL=append(enL,tmp+"3d");//16.02.29 - ); - ); - if(Noflg<2, - println("generate "+name3); - println(" generate totally "+namee); - println(" generate vertexes "+namev); - println(" generate faces "+namef); - ); - tmp1=""; - forall(enL, - tmp1=tmp1+Dq+#+Dq+","; - ); - tmp1=substring(tmp1,0,length(tmp1)-1); - tmp=namee+"=["+tmp1+"]"; - parse(tmp); - tmp=namee+"=list("+tmp1+")"; - tmp=replace(tmp,Dq,""); - GLIST=append(GLIST,tmp); - tmp1=apply(vL,Dq+#+"3d"+Dq); - tmp1=text(tmp1); - tmp1=substring(tmp1,1,length(tmp1)-1); - tmp=namev+"=["+tmp1+"]"; - parse(tmp); - tmp1=replace(tmp1,Dq,""); - tmp=namev+"=list("+tmp1+")"; - GLIST=append(GLIST,tmp); - tmp1=text(vfnL_2); - tmp1=substring(tmp1,1,length(tmp1)-1); - tmp=namef+"=["+tmp1+"]"; - parse(tmp); - tmp=namef+"=list("+tmp1+")"; - GLIST=append(GLIST,tmp); - ); - [namev,namee,namef]; -); - -Phparadata(nm,nmvf):=( - regional(tmp1,tmp2); - tmp1=parse("phv3d"+nmvf); - tmp2=parse("phf3d"+nmvf); - Phparadata(nm,nmvf,[tmp1,tmp2]); -); -Phparadata(nm,nmvf,Arg1):=( - regional(vfL,options,tmp1,tmp2); - if(islist(Arg1) & !islist(Arg1_1), - tmp1=parse("phv3d"+nmvf); - tmp2=parse("phf3d"+nmvf); - vfL=[tmp1,tmp2]; - options=Arg1; - , - vfL=Arg1; - options=[]; - ); - Phparadata(nm,nmvf,vfL,options); -); -Phparadata(nm,nmvf,vfL,options):=( -//help:Phparadata("1","1",["do"]); - regional(name2,name3,nameh2,nameh3,Ltype,Noflg,eqL,Hidden, - opstr,opcindy,Outflg,Inflg,pdata1,tmp,tmp1,tmp2); - name2="php2d"+nm; - name3="php3d"+nm; - nameh2="phh2d"+nm; - nameh3="phh3d"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - Inflg=tmp_3; - Outflg=tmp_4; - if(Inflg==0 & Outflg==0, Inflg=1;Outflg=1); // 15.05.15 - eqL=tmp_5; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - Hidden=""; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="H", - Hidden=tmp2; - ); - ); - if(Noflg<3, - if(Outflg>=1, - println("Output Phparadata "+name3); - if(isstring(vfL_1), // 2015.05.27 from - tmp1=vfL_1; - , - tmp1="list("; - forall(vfL_1, - tmp1=tmp1+#+","; - ); - tmp1=substring(tmp1,0,length(tmp1)-1)+")"; - ); - if(isstring(vfL_2), - tmp2=vfL_2; - , - tmp2="list("; - forall(vfL_2, - tmp2=tmp2+text(#)+","; - ); - tmp2=substring(tmp2,0,length(tmp2)-1)+")"; - ); // 2015.05.27 until - tmp=name3+"=Phparadata("+tmp1+","+tmp2+opstr+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - tmp=nameh3+"=PhHiddenData()"; - GLIST=append(GLIST,tmp); - tmp=nameh2+"=Projpara("+nameh3+")"; - GLIST=append(GLIST,tmp); - ); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - if(Inflg==1, -// tmp=apply(pltdata1,replace(#,"3d","2d")); // 15.05.18 from - Changestyle3d("phe3d"+nmvf,["nodisp"]); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - ); - ); - if(Hidden!="", - Drawlinetype(nameh2,Hidden); - if(Inflg==1, - tmp1=Toupper(substring(Hidden,0,2)); - if(tmp1=="DR",Ltype=0); - if(tmp1=="DA",Ltype=1); - if(tmp1=="DO",Ltype=3); - if(tmp1=="ID",Ltype=1); - GCLIST=append(GCLIST,[nameh2,Ltype,opcindy]); - ); - ); -); - -Nohiddenseg(seg,rng,triang):=( -// help:Nohiddenseg("1",seg1,[0,1],["v1","v2","v3"]); - regional(Eps,pA3,pB3,pC3,pA,pB,pC,sg1,sg2,ss1,ss2,parL,flgL,flg1,flg2, - veB,veC,sgnoh,sghid,added,tristr,tmp,tmp1,tmp2,tmp3,tmp4,tmp5); - Eps=10^(-4); - sgnoh=[0,1]; - pA3=if(isstring(triang_1),parse(triang_1+"3d"),triang_1); //16.06.19 - pA=Parapt(pA3); - pB3=if(isstring(triang_2),parse(triang_2+"3d"),triang_2); //16.06.19 - pB=Parapt(pB3); - pC3=if(isstring(triang_3),parse(triang_3+"3d"),triang_3); //16.06.19 - pC=Parapt(pC3); - sg1=seg_1+rng_1*(seg_2-seg_1); - sg2=seg_1+rng_2*(seg_2-seg_1); - ss1=Parapt(sg1); - ss2=Parapt(sg2); - tristr=replace(text(triang),",","-"); - tristr=substring(tristr,1,length(tristr)-1); - if(|ss2-ss1|>Eps & abs(Crossprod(pB-pA,pC-pA))>Eps, - tmp=IntersectcrvsPp([ss1,ss2],[pA,pB,pC,pA]); - parL=apply(tmp,#_2-1); - parL=sort(parL); - if(length(parL)==0, - parL=[0,1]; - , - if(parL_1>Eps,parL=prepend(0,parL)); - if(parL_(length(parL))<1-Eps,parL=append(parL,1)); - ); - tmp1=Crossprod(pB3-pA3,pC3-pA3); - if(abs(Dotprod(tmp1,sg2-sg1))>Eps, - tmp=IntersectsgpL("",[sg1,sg2],tristr,["nodisp"]); - if(tmp_2>-Eps & tmp_2<1+Eps, - if(tmp_3>-Eps & tmp_4>-Eps & tmp_3+tmp_4<1+Eps, - tmp1=select(parL,abs(tmp_2-#)<Eps); - if(length(tmp1)==0, - parL=sort(append(parL,tmp_2)); - ); - ); - ); - ); - flgL=[]; - forall(parL, - tmp1=sg1+#*(sg2-sg1); - tmp=Projcoordpara(tmp1); - tmp_3=tmp_3+1; - tmp2=Cancoordpara(tmp); - tmp=IntersectsgpL("",[tmp1,tmp2],tristr,["nodisp"]); - tmp1=Projcoordpara(tmp1); - tmp2=Projcoordpara(tmp_1); - flg1=0; - if(tmp1_3<tmp2_3-Eps,flg1=-1); - if(tmp1_3>tmp2_3+Eps,flg1=1); - flgL=append(flgL,flg1); - ); - sgnoh=[]; - forall(2..length(flgL), - added=[]; - flg1=flgL_(#-1); - flg2=flgL_#; - if(max([flg1,flg2])==1 % flg1+flg2==0, - added=[parL_(#-1),parL_#]; - , - sghid=[parL_(#-1),parL_#]; - tmp1=ss1+sghid_1*(ss2-ss1); - tmp2=ss1+sghid_2*(ss2-ss1); - tmp=IntersectcrvsPp([tmp1,tmp2],[pA,pB,pC,pA]); - if(length(tmp)<2, - veB=pB-pA; - veC=pC-pA; - tmp3=tmp1-pA; - tmp4=tmp2-pA; - tmp5=Crossprod(veB,veC); - tmp1=(tmp3_1*veC_2-tmp3_2*veC_1)/tmp5; - tmp2=(-tmp3_1*veB_2+tmp3_2*veB_1)/tmp5; - if(tmp1>-Eps & tmp2>-Eps & tmp1+tmp2<1+Eps,flg1=1,flg1=0); - tmp1=(tmp4_1*veC_2-tmp4_2*veC_1)/tmp5; - tmp2=(-tmp4_1*veB_2+tmp4_2*veB_1)/tmp5; - if(tmp1>-Eps & tmp2>-Eps & tmp1+tmp2<1+Eps,flg2=1,flg2=0); - if(flg1==1 & flg2==0, - if(length(tmp)>0, - tmp1=tmp_1_2-1; - tmp1=sghid_1+(sghid_2-sghid_1)*tmp1; - , - tmp1=sghid_1; - ); - added=[tmp1,sghid_2]; -// added=[tmp1+Eps,sghid_2]; // <--- USUI 2016.02.27 - ); - if(flg1==0 & flg2==1, - if(length(tmp)>0, - tmp1=tmp_1_2-1; - tmp1=sghid_1+(sghid_2-sghid_1)*tmp1; - , - tmp1=sghid_2; - ); - added=[sghid_1,tmp1]; - ); - if(flg1+flg2==0, - added=sghid; - ); - ); - if(length(tmp)==2, - if(min([flg1,flg2])>=0,added=sghid,added=[]); - ); - ); - if(length(added)>0, - if(length(sgnoh)==0, - sgnoh=added; - , - if(sgnoh_(length(sgnoh))<added_1-Eps, - sgnoh=concat(sgnoh,added); - , - sgnoh=sgnoh_(1..(length(sgnoh)-1)); - sgnoh=concat(sgnoh,added_(2..length(added))); - ); - ); - ); - ); - ); - sgnoh=apply(sgnoh,rng_1+#*(rng_2-rng_1)); - sgnoh; -); - -Nohiddensegs(seg,range,faceno,vtxL):=( - regional(Eps,rng,face,vtx,out,ra,rb,tmp,tmp1,tmp2); - Eps=10^(-4); - face=apply(faceno,vtxL_#); // 16.02.10 - rng=range; - out=rng; - forall(2..(length(face)-1),vtx, - tmp1=[face_1,face_vtx,face_(vtx+1)]; - forall(1..(length(rng)/2), - tmp=[rng_(2*#-1),rng_(2*#)]; - out=remove(out,tmp); - tmp2=Nohiddenseg(seg,tmp,tmp1); - if(length(tmp2)>0, - out=remove(out,tmp); - out=concat(out,tmp2); - ); - ); - tmp=sort(out); - out=[]; - forall(1..(length(tmp)/2), - ra=tmp_(2*#-1); - rb=tmp_(2*#); - if(ra<rb-Eps, - if(length(out)==0, - out=[ra,rb]; - , - if(out_(length(out))<ra-Eps, - out=concat(out,[ra,rb]); - , - out_(length(out))=rb; - ); - ); - ); - ); - rng=out; - ); - rng; -); - -Nohiddenbyfaces(nm,facestr):= - Nohiddenbyfaces(nm,Datalist3d(),facestr,[],["do"]); -Nohiddenbyfaces(nm,Arg1,Arg2):=( - regional(segstr,facestr,options); - if(islist(Arg2), - segstr=Datalist3d(); - facestr=Arg1; - options=Arg2; - , - segstr=Arg1; - facestr=Arg2; - options=[]; - ); - Nohiddenbyfaces(nm,segstr,facestr,options,["do"]); -); -Nohiddenbyfaces(nm,Arg1,Arg2,Arg3):=( - regional(segstr,facestr,options,optionsh); - if(islist(Arg2), - segstr=Datalist3d(); - facestr=Arg1; - options=Arg2; - optionsh=Arg3; - , - segstr=Arg1; - facestr=Arg2; - options=Arg3; - optionsh=["do"]; - ); - Nohiddenbyfaces(nm,segstr,facestr,options,optionsh); // 16.02.21 -); -Nohiddenbyfaces(nm,segstr,facestr,optionorg,optionsh):=( -//help:Nohiddenbyfaces("1","phf3d1"); -//help:Nohiddenbyfaces("1","ax3d","phf3d1"); -//help:Nohiddenbyfaces(options1=["dr"]); -//help:Nohiddenbyfaces(options2=["do"]); - regional(Eps,namen,nameh,options,segL,faceL,vtxL,rng,seg,face, - flg,ctr,tmp,tmp1,tmp2,Ltype,Noflg,eqL,opstr,opcindy,frnL,frhL); - Eps=10^(-4); - namen="frn"+nm; - nameh="frh"+nm; - if(isstring(segstr), -// segL=parse(segstr); - segL=[segstr]; // 16.08.19 - , - segL=segstr; - ); - tmp2=[]; // 16.02.29 from - forall(segL,seg, - tmp=replace(seg,"3d","2d"); - tmp1=select(GCLIST,#_1==tmp); - tmp1=tmp1_1; - if(tmp1_2==0, - tmp2=append(tmp2,seg); - ); - ); - segL=tmp2; - Changestyle3d(segL,["nodisp"]); // 16.02.29 until - if(islist(segL), - if(isstring(segL_1), - segL=apply(segL,parse(#)); - ); - ); - segL=Flattenlist(segL); - flg=0; - if(isstring(facestr), - if(substring(facestr,0,3)=="phf", // 16.08.19from - faceL=parse(facestr); - tmp=replace(facestr,"phf","phv"); // 16.02.10 from - tmp=parse(tmp); - vtxL=apply(tmp,replace(#,"3d","")); // 16.02.10 until - flg=1; - , - faceL=parse(facestr); - ); - ); - if(flg==0, - if(length(faceL)==2, // 16.08.19until - vtxL=facestr_1; - faceL=facestr_2; - , - vtxL=facestr; - faceL=[1..length(vtxL)]; - ); - ); -// Hidden=""; - options=optionorg; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); -// forall(eqL, -// tmp=indexof(#,"="); -// tmp1=Toupper(substring(#,0,1)); -// tmp2=substring(#,tmp,length(#)); -// if(tmp1=="H", -// Hidden=tmp2; -// ); -// ); - - ctr=1; - frnL=[]; - frhL=[]; - forall(segL,seg, - rng=[0,1]; - forall(faceL,face, - rng=Nohiddensegs(seg,rng,face,vtxL); - ); - forall(1..length(rng)/2, - tmp=rng_(2*#-1); - tmp1=seg_1+tmp*(seg_2-seg_1); - tmp=rng_(2*#); - tmp2=seg_1+tmp*(seg_2-seg_1); -// tmp=remove(options,eqL); - tmp=append(options,"Msg=nodisp"); // 15.06.22 - Spaceline("-"+namen+"n"+text(ctr),[tmp1,tmp2],tmp); - frnL=append(frnL,namen+"n"+text(ctr)+"3d"); - ctr=ctr+1; - ); - if(length(rng)==0, - rng=[0,1]; - , - if(rng_1>0+Eps, - rng=prepend(0,rng); - , - rng=rng_(2..length(rng)); - ); - if(rng_(length(rng))<1-Eps, - rng=append(rng,1); - , - rng=rng_(1..(length(rng)-1)); - ); - ); - forall(1..length(rng)/2, - tmp=rng_(2*#-1); - tmp1=seg_1+tmp*(seg_2-seg_1); - tmp=rng_(2*#); - tmp2=seg_1+tmp*(seg_2-seg_1); - if(length(optionsh)>0,tmp=optionsh,tmp=["do"]); - tmp=append(tmp,"Msg=nodisp"); // 15.06.22 - Spaceline("-"+nameh+"n"+text(ctr),[tmp1,tmp2],tmp); - frhL=append(frhL,nameh+"n"+text(ctr)+"3d"); - ctr=ctr+1; - ); - ); - tmp1=apply(frnL,Dq+#+Dq); - tmp="frn3d"+nm+"="+text(tmp1); - parse(tmp); - println(" generate totally "+"frn3d"+nm); - tmp1=apply(frhL,Dq+#+Dq); - tmp="frh3d"+nm+"="+text(tmp1); - parse(tmp); - println(" generate totally "+"frh3d"+nm); -); - -Faceremovaldata(nm,vfdata,crvdata):=Faceremovaldata(nm,vfdata,crvdata,[]); -Faceremovaldata(nm,vfdata,crvdata,options):=( - regional(name2,name3,nameh2,nameh3,Ltype,Noflg,eqL,Hidden, - opstr,opcindy,Outflg,Inflg,tmp,tmp1,tmp2); - name2="frc2d"+nm; - name3="frc3d"+nm; - nameh2="frch2d"+nm; - nameh3="frch3d"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - Inflg=tmp_3; - Outflg=tmp_4; - if(Inflg==0 & Outflg==0, Inflg=1;Outflg=1); // 15.05.15 - eqL=tmp_5; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - Hidden=""; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="H", - Hidden=tmp2; - ); - ); - if(Noflg<3, - if(Outflg>=1, - println("Output Faceremovaldata "+name3); - if(MeasureDepth(vfdata)==1, - tmp1=text(apply(vfdata,#_[1,3])); - , - tmp1=text([vfdata_[1,3]]); - ); - tmp1=replace(tmp1,"[","list("); - tmp1=replace(tmp1,"]",")"); - tmp2=text(crvdata); - tmp2=replace(tmp2,"[","list("); - tmp2=replace(tmp2,"]",")"); -// tmp2="Flattenlist("+tmp2+")"; - tmp=name3+"=Faceremovaldata("+tmp1+","+tmp2+opstr+","+Dq+"para"+Dq+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - tmp=nameh3+"=PhHiddenData()"; - GLIST=append(GLIST,tmp); - tmp=nameh2+"=Projpara("+nameh3+")"; - GLIST=append(GLIST,tmp); - ); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - if(Inflg==1, - if(MeasureDepth(vfdata)==1, - tmp1=apply(vfdata,parse(#_2)); - , - tmp1=[parse(vfdata_2)]; - ); - forall(tmp1, - Changestyle3d(#,["nodisp"]); - ); - Changestyle3d(crvdata,["nodisp"]); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - ); - ); - if(Hidden!="", - Drawlinetype(nameh2,Hidden); - if(Inflg==1, - tmp1=Toupper(substring(Hidden,0,2)); - if(tmp1=="DR",Ltype=0); - if(tmp1=="DA",Ltype=1); - if(tmp1=="DO",Ltype=3); - if(tmp1=="ID",Ltype=1); - GCLIST=append(GCLIST,[nameh2,Ltype,opcindy]); - ); - ); -); - -Fullformfunc(FdL):=( - regional(Out,nn,ii,Jrg,flg,Urg,Vrg,kk,Uname, - Zf,Xname,Xf,Yname,Yf,tmp,tmp1,tmp2); - Out=[FdL_1]; - nn=length(FdL); - flg=0; - forall(1..nn, - if(flg==0, - tmp=FdL_#; - if(substring(tmp,length(tmp)-1,length(tmp))=="]", - Jrg=#; - Urg=FdL_Jrg; - flg=1; - ); - ); - ); - kk=indexof(Urg,"="); - Uname=Removespace(substring(Urg,0,kk-1)); - tmp=substring(Urg,kk,length(Urg)); - Urg=Uname+"="+tmp; -// tmp1=parse(tmp); -// Urg=Uname+"="+textformat(tmp1,5); - Vrg=FdL_(Jrg+1); - kk=indexof(Vrg,"="); - Vname=Removespace(substring(Vrg,0,kk-1)); - tmp=substring(Vrg,kk,length(Vrg)); - Vrg=Vname+"="+tmp; -// tmp1=parse(tmp); -// Vrg=Vname+"="+textformat(tmp1,5); - if(Jrg==2, - tmp=FdL_1; - kk=indexof(tmp,"="); - Zf=substring(tmp,kk,length(tmp)); - tmp=[Uname,Vname,Zf,Urg,Vrg]; - Out=concat(Out,tmp); - , - if(Jrg==4, - tmp=FdL_1; - kk=indexof(tmp,"="); - Zf=substring(tmp,kk,length(tmp)); - tmp=FdL_2; - kk=indexof(tmp,"="); - Xname=Removespace(substring(tmp,0,kk-1)); - Xf=substring(tmp,kk,length(tmp)); - tmp=FdL_3; - kk=indexof(tmp,"="); - Yname=Removespace(substring(tmp,0,kk-1)); - Yf=substring(tmp,kk,length(tmp)); - tmp=replace(Zf,Xname,"("+Xf+")"); - Zf=replace(tmp,Yname,"("+Yf+")"); - Tmp=[Xf,Yf,Zf,Urg,Vrg]; - Out=concat(Out,Tmp); - , - tmp=FdL_2; - kk=indexof(tmp,"="); - Xf=substring(tmp,kk,length(tmp)); - tmp=FdL_3; - kk=indexof(tmp,"="); - Yf=substring(tmp,kk,length(tmp)); - tmp=FdL_4; - kk=indexof(tmp,"="); - Zf=substring(tmp,kk,length(tmp)); - tmp=[Xf,Yf,Zf,Urg,Vrg]; - Out=concat(Out,tmp); - ); - ); - DrwS="enws"; - BdyL=[]; - forall((Jrg+2)..length(FdL),ii, - tmp=FdL_ii; - if(isstring(tmp), - if(length(tmp)==0, - tmp=" "; - ); - DrwS=tmp; - ); - if(islist(tmp) & length(tmp_1)>1, - BdyL=tmp; - ); - ); - tmp=[DrwS,BdyL]; - Out=concat(Out,tmp); -); - -Surffun(nm,Fd):=( - regional(name,coord,var1,var2,rng1,rng2,bdy,tmp,tmp1,tmp2); - tmp=Fullformfunc(Fd); - rng1=tmp_5; - rng2=tmp_6; - bdy=tmp_7; - coord="["+tmp_2+","+tmp_3+","+tmp_4+"]"; - tmp=indexof(rng1,"="); - var1=substring(rng1,0,tmp-1); - rng1=substring(rng1,tmp,length(rng1)); - tmp=indexof(rng2,"="); - var2=substring(rng2,0,tmp-1); - rng2=substring(rng2,tmp,length(rng2)); - name="Sfn"+nm+"("+var1+","+var2+")"; - Deffun(name,["regional(tmp)","tmp="+coord,"tmp"]); - [name,var1,rng1,var2,rng2,bdy]; -); - -Sf3data(nm,fdata):=Sf3data(nm,fdata,[]); -Sf3data(nm,fdata,optionorg):=( - regional(tmp,tmp1,tmp2); - tmp=Surffun(nm,fdata); - tmp1=tmp_2+"="+tmp_3; - tmp2=tmp_4+"="+tmp_5; - Sf3data(nm,tmp_1,tmp1,tmp2,optionorg); -); -Sf3data(nm,funstr,var1,var2):=Sf3data(nm,funstr,var1,var2,[]); -Sf3data(nm,funstr,var1org,var2org,optionorg):=( -//help:Sf3data("1",Fd); -//help:Sf3data(options=["Num=[25,25]","Wire=[20,20]"]); - regional(name2,name3,var1,var2,Ltype,Noflg,opstr,opcindy,eqL,Num, - Wire,varu,varv,rngu,rngv,sfdtuL,sfdtvL,options, - tmp,tmp1,tmp2,tmp3); - var1=replace(var1org,"%pi","pi"); - var2=replace(var2org,"%pi","pi"); - tmp=Divoptions(optionorg); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - options=optionorg; - Num=[25,25]; - Wire=[20,20]; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); // 16.05.25 - tmp=Toupper(substring(tmp1,0,1)); - if(tmp=="N", - tmp2=parse(tmp2); - if(!islist(tmp2),tmp2=[tmp2,tmp2]); - Num=tmp2; - options=remove(options,[#]); - ); - if(tmp=="W", - tmp2=parse(tmp2); - if(!islist(tmp2),tmp2=[tmp2,tmp2]); - Wire=tmp2; - options=remove(options,[#]); - ); - ); - tmp=indexof(var1,"="); - varu=substring(var1,0,tmp-1); - rngu=parse(substring(var1,tmp,length(var1))); - tmp=indexof(var2,"="); - varv=substring(var2,0,tmp-1); - rngv=parse(substring(var2,tmp,length(var2))); - sfdtuL=[]; - forall(0..Wire_2, - tmp=rngv_1+#/Wire_2*(rngv_2-rngv_1); - tmp1=replace(funstr,varv,textformat(tmp,5)); - tmp="Num="+text(Num_2); - tmp2=concat(options,["Msg=no",tmp]); - Spacecurve(nm+"u"+#,tmp1,var1,tmp2); - sfdtuL=append(sfdtuL,"sc3d"+nm+"u"+#); - ); - sfdtvL=[]; - forall(0..Wire_1, - tmp=rngu_1+#/Wire_1*(rngu_2-rngu_1); - tmp1=replace(funstr,varu,textformat(tmp,5)); - tmp="Num="+text(Num_1); - tmp2=concat(options,["Msg=no",tmp]); - Spacecurve(nm+"v"+#,tmp1,var2,tmp2); - sfdtvL=append(sfdtvL,"sc3d"+nm+"v"+#); - ); - if(Noflg<3, - println(" generate totally "+"sf3d"+nm); - tmp1=""; - forall(sfdtuL, - tmp1=tmp1+Dq+#+Dq+","; - ); - tmp1=substring(tmp1,0,length(tmp1)-1); - tmp2=""; - forall(sfdtvL, - tmp2=tmp2+Dq+#+Dq+","; - ); - tmp2=substring(tmp2,0,length(tmp2)-1); - tmp="sf3d"+nm+"=[["+tmp1+"],["+tmp2+"]]"; - parse(tmp); - ); - [sfdtuL,sfdtvL]; -); - -Sfbdparadata(nm,fd):= - Sfbdparadata(nm,fd,[],["nodisp"]); -Sfbdparadata(nm,fd,options):= - Sfbdparadata(nm,fd,options,["nodisp"]); -Sfbdparadata(nm,fdorg,optionorg,optionsh):=( -//help:Sfbdparadata("1",Fd); -//help:Sfbdparadata(options2=["Wait=60",division(c(50,50)),Eps1(c(0.01,1)), Eps2(0.05)]); - regional(fd,options,name2,name3,name2h,name3h,waiting, - eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg); - name2="sfbd2d"+nm; - name3="sfbd3d"+nm; - name2h="sfbdh2d"+nm; - name3h="sfbdh3d"+nm; - fname=Fhead+"sfbd"+nm+".txt"; - tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); - tmp=text(tmp); - fd=RSform(tmp,2); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=120; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - options=remove(options,reL); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - tmp=["fd"+nm]; - if(length(reL)>0, - reL=textformat(reL,4); - reL=substring(reL,1,length(reL)-1); - reL=Rsform(reL); - tmp=append(tmp,reL); - ); - tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2]; - tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]); -// tmp1=concat(tmp1,[Dqq("CUSPPT"),"CUSPPT"]); -// tmp1=concat(tmp1,[Dqq("OTHERPARTITION"),"OTHERPARTITION"]); - tmp2=replace(fname,".txt",".dat"); //18.02.18 - cmdL=[ - "print",[Dqq("fd"+nm)], //18.02.22 - "fd"+nm+"="+fd,[], - name3+"=Sfbdparadata",tmp, - name2+"=Projpara",[name3], - name3h+"=HIDDENDATA",[], - name2h+"=Projpara",[name3h], - "WriteOutData",tmp1, - "save",["CUSPPT","OTHERPARTITION","file='"+tmp2+"'"] - ]; - tmp=replace(fname,".txt","end.txt"); - options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); - if(wflg==1,options=append(options,"m")); - if(wflg==-1,options=append(options,"r")); - if(ErrFlag==0, - CalcbyR("sfbd"+nm,cmdL,options); - ); - if(ErrFlag==1, - err("Sfbdparadata not completed"); - , - ReadOutData(fname); - if(islist(parse(name2)), - Extractdata(name2,options); - if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); - Extractdata(name2h,tmp); - , - ErrFlag=1; - ); - ); -); - -Addpoints():=(//18.02.20 - if(isstring(ADDPOINT), - ADDPOINT; - , - "list()"; - ); -); -Addpoints(ptlist):=( -//help:Addpoints(list of 3d points); - if(length(ptlist)==0, - ADDPOINT="list()"; - , - ADDPOINT=Rsform(textformat(ptlist,6),2); - ); - ADDPOINT; -); - -Wireparadata(nm,sf,wr1,wr2,fd):= - Wireparadata(nm,sf,fd,wr1,wr2,[],["nodisp"]); -Wireparadata(nm,sf,fd,wr1,wr2,options):= - Wireparadata(nm,sf,fd,wr1,wr2,options,["nodisp"]); -Wireparadata(nm,sfstr,fdorg,wr1,wr2,optionorg,optionsh):=( -//help:Wireparadata("1","sfbd3d1",fd,5,5); -//help:Wireparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]); - regional(fd,options,name2,name3,name2h,name3h,outreg, - eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,flg,wflg); - name2="wire2d"+nm; - name3="wiref3d"+nm; - name2h="wireh2d"+nm; - name3h="wireh3d"+nm; - fname=Fhead+"wire"+nm+".txt"; - rfname=Fhead+sfstr+".txt"; - rfname=replace(rfname,"3d",""); - tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); - tmp=text(tmp); - fd=RSform(tmp,2); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=600; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - options=remove(options,reL); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - tmp1=textformat(wr1,6); - tmp1=Rsform(tmp1,1); - tmp2=textformat(wr2,6); - tmp2=Rsform(tmp2,1); - tmp=[sfstr,"fd"+nm,tmp1,tmp2]; - reL=RSform(text(reL),2); - reL=substring(reL,5,length(reL)-1); - if(length(reL)>0, - reL=textformat(reL,4); - reL=substring(reL,1,length(reL)-1); - reL=Rsform(reL); - tmp=append(tmp,reL); - ); - tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2]; - tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]); - tmp2=replace(rfname,".txt",".dat"); - cmdL=[ - "print",[Dqq("wire"+nm)], //18.02.22 - "fd"+nm+"="+fd,[], - "ReadOutData",[Dqq(rfname)], - "load",[Dqq(tmp2)], - "Addpoints",[Addpoints()], - name3+"=Wireparadata",tmp, - name2+"=Projpara",[name3], - name3h+"=WIREHIDDENDATA",[], - name2h+"=Projpara",[name3h], - "WriteOutData",tmp1 - ]; - tmp=replace(fname,".txt","end.txt"); - options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); - if(wflg==1,options=concat(options,["m"])); - if(wflg==-1,options=concat(options,["r"])); - if(ErrFlag==0, - CalcbyR("wire"+nm,cmdL,options); - ); - if(ErrFlag==1, - err("Wireparadata not completed"); - , - ReadOutData(fname); - if(islist(parse(name2)), - Extractdata(name2,options); - if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); - Extractdata(name2h,tmp); - , - ErrFlag=1; - ); - ); -); - -Crvsfparadata(nm,crv,sf,fd):= - Crvsfparadata(nm,crv,sf,fd,[],["nodisp"]); -Crvsfparadata(nm,crv,sf,fd,options):= - Crvsfparadata(nm,crv,sf,fd,options,["nodisp"]); -Crvsfparadata(nm,crvstr,sfstr,fdorg,optionorg,optionsh):=( -//help:Crvsfparadata("1","ax3d","sfbd3d1",fd); -//help:Crvsfparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]); - regional(gd,out,fd,options,name2,name3,name2h,name3h, - eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,tmp3,flg,wflg); - tmp=replace(crvstr,"3d","2d"); - Changestyle(tmp,["nodisp"]); - name2="crvsf2d"+nm; - name3="crvsf3d"+nm; - name2h="crvsfh2d"+nm; - name3h="crvsfh3d"+nm; - fname=Fhead+"crvsf"+nm+".txt"; - rfname=Fhead+sfstr+".txt"; - rfname=replace(rfname,"3d",""); - tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); - tmp=text(tmp); - fd=RSform(tmp,2); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=120; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - options=remove(options,reL); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - reL=RSform(text(reL),2); - reL=substring(reL,5,length(reL)-1); - tmp=[crvstr,sfstr,"fd"+nm]; - if(length(reL)>0, - reL=textformat(reL,4); - reL=substring(reL,1,length(reL)-1); - reL=Rsform(reL); - tmp=append(tmp,reL); - ); - tmp1=[DqDq(fname),DqDq(name3),name3,DqDq(name2),name2]; - tmp1=concat(tmp1,[DqDq(name3h),name3h,DqDq(name2h),name2h]); - tmp2=replace(rfname,".txt",".dat"); - cmdL=[ - "print",[Dqq("crv"+nm)], //18.02.22 - "fd"+nm+"="+fd,[], - "ReadOutData",[Dqq(rfname)], - "load",[Dqq(tmp2)], - "Addpoints",[Addpoints()] - ]; - tmp3=select(GLIST,indexof(#,crvstr+"=")>0); //18.02.22from - if(length(tmp3)==0, - tmp3=Fhead+crvstr+".txt"; - tmp3=replace(tmp3,"3d",""); - cmdL=concat(cmdL,[ - "ReadOutData",[Dqq(tmp3)] - ]); - ); //18.02.22until - cmdL=concat(cmdL,[ - name3+"=Crvsfparadata",tmp, - name2+"=Projpara",[name3], - name3h+"=CRVSFHIDDENDATA",[], - name2h+"=Projpara",[name3h], - "WriteOutData",tmp1 - ]); - tmp=replace(fname,".txt","end.txt"); - options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); - if(wflg==1,options=append(options,"m")); - if(wflg==-1,options=append(options,"r")); - if(ErrFlag==0, - CalcbyR("crvsf"+nm,cmdL,options); - ); - if(ErrFlag==1, - err("Crvsfparadata not completed"); - , - ReadOutData(fname); - if(islist(parse(name2)), - Extractdata(name2,options); - if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); - Extractdata(name2h,tmp); - , - ErrFlag=1; - ); - ); -); - -Crvonsfparadata(nm,crv2d,sf,fd):= - Crvsonfparadata(nm,crv2d,sf,fd,[],["nodisp"]); -Crvonsfparadata(nm,crv2d,sf,fd,options):= - Crvonsfparadata(nm,crv2d,sf,fd,options,["nodisp"]); -Crvonsfparadata(nm,crv2dstr,sfstr,fdorg,optionorg,optionsh):=( -//help:Crvonsfparadata("1",["[1,t]","t=[0,2*pi]","Num=50"],"sfbd3d1",fd); -//help:Crvonsfparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]); - regional(gd,out,fd,options,name2,name3,name2h,name3h, - eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,tmp3,flg,wflg); - name2="crvonsf2d"+nm; - name3="crvonsf3d"+nm; - name2h="crvonsfh2d"+nm; - name3h="crvonsfh3d"+nm; - fname=Fhead+"crvonsf"+nm+".txt"; - rfname=Fhead+sfstr+".txt"; - rfname=replace(rfname,"3d",""); - tmp=apply(fdorg,if(isstring(#),Dqq(#),#)); - tmp=text(tmp); - fd=RSform(tmp,2); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=120; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - options=remove(options,reL); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - if(isstring(crv2dstr), - crv=Rsform(crv2dstr); - , - crv=apply(crv2dstr,Dqq(#)); - crv=Rsform(text(crv)); - crv="Paramplot"+substring(crv,1,length(crv)); - ); - reL=RSform(text(reL),2); - reL=substring(reL,5,length(reL)-1); - tmp=["crv",sfstr,"fd"+nm]; - if(length(reL)>0, - reL=textformat(reL,4); - reL=substring(reL,1,length(reL)-1); - reL=Rsform(reL); - tmp=append(tmp,reL); - ); - tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2]; - tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]); - tmp2=replace(rfname,".txt",".dat"); - cmdL=[ - "print",[Dqq("crvonsf"+nm)], //18.02.22 - "fd"+nm+"="+fd,[], - "ReadOutData",[Dqq(rfname)], - "load",[Dqq(tmp2)], - "Addpoints",[Addpoints()], - "crv="+crv,[], - name3+"=Crvonsfparadata",tmp, - name2+"=Projpara",[name3], - name3h+"=HIDDENDATA",[], - name2h+"=Projpara",[name3h], - "WriteOutData",tmp1 - ]; - tmp=replace(fname,".txt","end.txt"); - options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); - if(wflg==1,options=append(options,"m")); - if(wflg==-1,options=append(options,"r")); - if(ErrFlag==0, - CalcbyR("crvonsf"+nm,cmdL,options); - ); - if(ErrFlag==1, - err("Crvonsfparadata not completed"); - , - ReadOutData(fname); - if(islist(parse(name2)), - Extractdata(name2,options); - if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); - Extractdata(name2h,tmp); - , - ErrFlag=1; - ); - ); -); - -Intersectcrvsf(nm,crv,fd):=Intersectcrvsf(nm,crv,fd,"",[]); -Intersectcrvsf(nm,crv,fd,Arg):=( - if(isstring(Arg), - Intersectcrvsf(nm,crv,fd,Arg,[]); - , - Intersectcrvsf(nm,crv,fd,"",Arg); - ); -); -Intersectcrvsf(nm,crvstr,fdorg,bdyeq,optionorg):=( -//help:Intersectcrvsf("1",curve,fd); -//help:Intersectcrvsf("1",curve,fd,curveequation); -//help:Intersectcrvsf(options=[Np([50,50]),Eps(0.01)]); - regional(name,crv,fd,options,reL,fname,crvfname,argR, - waiting,tmp,tmp1,tmp2,flg,wflg,pts); name="crvsf"+nm; - name="crvsf"+nm; - fname=Fhead+name+".txt"; - crvfname=Fhead+"crv"+nm+".txt"; -// crv=parse(crvstr); -// crv=textformat(crv,6); -// crv=Rsform(crv,2); - fd=apply(fdorg,if(isstring(#),Dqq(#),#)); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=120; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - options=remove(options,reL); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); - tmp=text(tmp); - fd=RSform(tmp,2); - tmp=textformat(reL,4); - tmp=substring(tmp,1,length(tmp)-1); - tmp=Rsform(tmp); - if(length(bdyeq)>0, - argR=","+Dqq(bdyeq); - , - argR=""; - ); - if(length(tmp)>0, - argR=argR+","+tmp; - ); - tmp1=[Dqq(fname),Dqq(name),"tmp"]; - cmdL=[ - "print",[Dqq("crvsf"+nm)], //18.02.22 - "crv="+crvstr,[], - "fd="+fd,[], - "tmp1=Intersectcrvsf(crv,fd"+argR+")",[], - "tmp=c()",[], - "for(j in Looprange(1,length(tmp1))){",[], - " tmp=Appendrow(tmp,tmp1[[j]])",[], - "}",[], - "WriteOutData",tmp1, - "tmp",[] - ]; - tmp=replace(fname,".txt","end.txt"); - options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); - if(wflg==1,options=append(options,"m")); - if(wflg==-1,options=append(options,"r")); - if(ErrFlag==1, - err("Crvsfparadata not completed"); - , - CalcbyR("ans",cmdL,options); - ReadOutData(fname); - ); - println("generate "+name); - parse(name); -); - -Sfcutparadata(nm,eqstr,sf,fd):= - Sfcutparadata(nm,eqstr,sf,fd,[]); -Sfcutparadata(nm,eqstr,sf,fd,options):= - Sfcutparadata(nm,eqstr,sf,fd,options,["nodisp"]); -Sfcutparadata(nm,eqstr,sf,fdorg,optionorg,optionsh):=( -//help:Sfcutparadata("1","x+y+z=1","sfbd3d1",fd,"x+y+z=1"); -//help:Sfcutparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]); - regional(gd,out,fd,options,name2,name3,name2h,name3h, - eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,tmp3,flg,wflg); - tmp=replace(sfcut,"3d","2d"); - Changestyle(tmp,["nodisp"]); - name2="sfcut2d"+nm; - name3="sfcut3d"+nm; - name2h="sfcuth2d"+nm; - name3h="sfcuth3d"+nm; - fname=Fhead+"sfcut"+nm+".txt"; - rfname=Fhead+sf+".txt"; - rfname=replace(rfname,"3d",""); - tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); - tmp=text(tmp); - fd=RSform(tmp,2); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=120; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - options=remove(options,reL); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - reL=RSform(text(reL),2); - reL=substring(reL,5,length(reL)-1); - tmp=[Dqq(eqstr),sf,"fd"+nm]; - if(length(reL)>0, - reL=textformat(reL,4); - reL=substring(reL,1,length(reL)-1); - reL=Rsform(reL); - tmp=append(tmp,reL); - ); - tmp1=[DqDq(fname),DqDq(name3),name3,DqDq(name2),name2]; - tmp1=concat(tmp1,[DqDq(name3h),name3h,DqDq(name2h),name2h]); - tmp2=replace(rfname,".txt",".dat"); - cmdL=[ - "print",[Dqq("sfcut"+nm)], //18.02.22 - "fd"+nm+"="+fd,[], - "ReadOutData",[Dqq(rfname)], - "load",[Dqq(tmp2)], - name3+"=Sfcutparadata",tmp, - name2+"=Projpara",[name3], - name3h+"=CRVONSFHIDDENDATA",[], - name2h+"=Projpara",[name3h], - "WriteOutData",tmp1 - ]; - tmp=replace(fname,".txt","end.txt"); - options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); - if(wflg==1,options=append(options,"m")); - if(wflg==-1,options=append(options,"r")); - if(ErrFlag==0, - CalcbyR("sfcut"+nm,cmdL,options); - ); - if(ErrFlag==1, - err("Sfcutparadata not completed"); - , - ReadOutData(fname); - if(islist(parse(name2)), - Extractdata(name2,options); - if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); - Extractdata(name2h,tmp); - , - ErrFlag=1; - ); - ); -); - -Skeletonparadata(nm):=Skeletondatacindy(nm,[]); -Skeletonparadata(nm,options):=Skeletondatacindy(nm,options); -Skeletonparadata(nm,pltdata1,pltdata2):=Skeletondatacindy(nm,pltdata1,pltdata2); -Skeletonparadata(nm,pltdata1org,pltdata2org,options):= - Skeletondatacindy(nm,pltdata1org,pltdata2org,options); - - -////////////// new skeleton 2018.01.04 not completed and slow//////////////// - -Skeletondatacindy(nm):=Skeletondatacindy(nm,[]); -Skeletondatacindy(nm,options):=( - regional(tmp); - tmp=Datalist3d(); - Skeletondatacindy(nm,tmp,tmp,options); -); -Skeletondatacindy(nm,pltdata1,pltdata2):= - Skeletondatacindy(nm,pltdata1,pltdata2,[]); -Skeletondatacindy(nm,pltdata1org,pltdata2org,options):=( -//help:Skeletonparadata("1"); -//help:Skeletonparadata("1",[pdata1,pdata2],[pdata3]); -//help:Skeletondata(options2=[1(width)]); - regional(Eps,Eps2,name2,name3,Ltype,Noflg,reL,opcindy, - Data,Out,ObjL,Plt3L,Rr,pltdata1,pltdata2,Plt2L,ObjL,ii,Data, - Obj3,jj,Gd,PtD,size,tmp,tmp1,tmp2); - name2="sk2d"+nm; - name3="sk3d"+nm; - pltdata1=[];// 16.01.31 - forall(pltdata1org,tmp1, - tmp=parse(tmp1); - pltdata1=append(pltdata1,tmp); - ); - pltdata2=[];// 16.01.31 - forall(pltdata2org,tmp1, - tmp=parse(tmp1); - pltdata2=append(pltdata2,tmp); - ); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - reL=tmp_6; //16.02.28 - opcindy=tmp_9; - Rr=0.15*1000/2.54/MilliIn; - size=1; - Eps2=0.05; - if(length(reL)>0, //16.02.28 - size=reL_1; - Rr=size*Rr; - if(length(reL)>1,Eps2=reL_2); - ); - Eps=10^(-4); - ObjL=Flattenlist(pltdata1); - PltL=Flattenlist(pltdata2); - Data=Makeskeletondata(ObjL,PltL,Rr); - Out=select(Data,length(Projcurve(#))>0); - Out=Flattenlist(Out); - tmp1=apply(Out,textformat(#,5)); - tmp=name3+"="+tmp1; - parse(tmp); - tmp=name2+"=Projcurve("+name3+");"; - parse(tmp); - Changestyle3d(pltdata1org,["nodisp"]); - if(Noflg<3, - println("generate skeleton :"+name3); - tmp1=text(pltdata1org); - tmp1="list("+substring(tmp1,1,length(tmp1)-1)+")"; - tmp2=text(pltdata2org); - tmp2="list("+substring(tmp2,1,length(tmp2)-1)+")"; - tmp=name3+"=Skeletonpara3data("+tmp1+","+tmp2+","; - tmp=tmp+text(size)+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, - Subgraph(name3,opcindy); - ); - ); - Out; -); - -Makeskeletondata(ObjL,PltL,R0):=( - regional(Allres,res,Eps1,obj,plt,obj2,remov,flg,koc,z1,z2,Rr,str, - mm,nn,kk,ptk,pL,pt,ptL,tmp,tmp1,tmp2,tmp3,tmp3d); - Eps1=10.0^(-2); - Allres=[]; - forall(1..(length(ObjL)),mm, - obj=ObjL_mm; - remov=[]; - obj2=Projcurve(obj); - forall(1..(length(PltL)),nn, - plt=PltL_nn; - tmp=Projcurve(plt); - koc=IntersectcurvesPp(obj2,tmp); - forall(1..(length(koc)),kk, - ptk=koc_kk; - tmp=PointonCurve(ptk_2,obj); - z1=Zparapt(tmp); - tmp=PointonCurve(ptk_3,plt); - z2=Zparapt(tmp); - if(z1<z2-Eps1, - tmp=max([sqrt(1-(ptk_5)^2),0.75]); - Rr=R0/tmp; - tmp2=[]; - flg=0; - tmp=reverse(1..(floor(ptk_2))); - forall(tmp, - if(flg==0, - if(|obj2_#-ptk_1|>Rr, - tmp2=[#]; - flg=1; - ); - ); - ); - if(length(tmp2)==0,tmp2=[1]); - flg=0; - tmp=(ceil(ptk_2))..(length(obj2)); - forall(tmp, - if(flg==0, - if(|obj2_#-ptk_1|>Rr, - tmp2=append(tmp2,#); - flg=1; - ); - ); - ); - if(length(tmp2)==1,tmp2=append(tmp2,length(obj2))); - tmp=obj2_((tmp2_1)..(tmp2_2)); - tmp1=Circledata("",[ptk_1,ptk_1+[Rr,0]],["Num=8","nodata"]); - tmp1=Intersectcurves(tmp,tmp1); - if(length(tmp1)==2, - tmp=sort([tmp1_1_2,tmp1_2_2]); - tmp=[[tmp2_1-1+tmp_1,1],[tmp2_1-1+tmp_2,-1]]; - remov=concat(remov,tmp); - ); - if(length(tmp1)==1, - if(tmp2_1==1, - tmp=[[1,1],[tmp2_1-1+tmp1_1_2,-1]]; - , - tmp=[[tmp2_1-1+tmp1_1_2,1],[length(obj2),-1]]; - ); - remov=concat(remov,tmp); - ); - ); - ); - ); - if(length(remov)==0, - res=obj; - , - res=[]; - remov=sort(remov,[#_1,#_2]); - tmp=select(remov,#_1<1-Eps1); - if(length(tmp)==0, - flg=0; - res=[1]; - , - flg=length(tmp); - res=[]; - ); - forall(remov, - tmp=flg; - if(#_2==-1, - flg=flg-1; - if(flg==0,res=append(res,#_1)); - ); - if(#_2==1, - flg=flg+1; - if(tmp==0,res=append(res,#_1)); - ); - ); - if((flg==0)&(res_(length(res))<length(obj)), - res=append(res,length(obj)); - ); - tmp=res; - res=[]; - forall(1..(length(tmp)/2),nn, - tmp1=tmp_(2*nn-1); - tmp2=tmp_(2*nn); - pL=(ceil(tmp1))..(floor(tmp2)); - if(tmp1<ceil(tmp1)-Eps1,pL=prepend(tmp1,pL)); - if(tmp2>floor(tmp2)+Eps1,pL=append(pL,tmp2)); - ptL=[]; - forall(pL, - pt=PointonCurve(#,obj); - ptL=append(ptL,pt); - ); - res=append(res,ptL); - ); - ); - Allres=append(Allres,res); - ); - Allres; -); - -////////////// current skeleton 2018.01.04 //////////////// - -Skeletondatacindy(nm):=Skeletondatacindy(nm,[]); -Skeletondatacindy(nm,options):=( - regional(tmp); - tmp=Datalist3d(); - Skeletondatacindy(nm,tmp,tmp,options); -); -Skeletondatacindy(nm,pltdata1,pltdata2):= - Skeletondatacindy(nm,pltdata1,pltdata2,[]); -Skeletondatacindy(nm,pltdata1org,pltdata2org,options):=( -//help:Skeletondatacindy("1"); -//help:Skeletondatacindy("1",[pdata1,pdata2],[pdata3]); -//help:Skeletondatacindy(options2=[1(width)]); - regional(Eps,Eps2,name2,name3,Ltype,Noflg,reL,opcindy, - Out,ObjL,Plt3L,Rr,pltdata1,pltdata2,Plt2L,ObjL,ii,Data, - Obj3,jj,Gd,PtD,size,tmp,tmp1,tmp2); - name2="sk2d"+nm; - name3="sk3d"+nm; - pltdata1=[];// 16.01.31 - forall(pltdata1org,tmp1, - tmp=parse(tmp1); - pltdata1=append(pltdata1,tmp); - ); - pltdata2=[];// 16.01.31 - forall(pltdata2org,tmp1, - tmp=parse(tmp1); - pltdata2=append(pltdata2,tmp); - ); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - reL=tmp_6; //16.02.28 - opcindy=tmp_9; - Rr=0.075*1000/2.54/MilliIn; - size=1; - Eps2=0.05; - if(length(reL)>0, //16.02.28 - size=reL_1; - Rr=size*Rr; - if(length(reL)>1,Eps2=reL_2); - ); - Eps=10^(-4); - ObjL=Flattenlist(pltdata1); - Plt3L=Flattenlist(pltdata2); - tmp=apply(Plt3L,ProjcoordCurve(#)); - Plt2L=Flattenlist(tmp); -/////////// tmp=apply(pltdata1,replace(#,"3d","2d")); - Out=[]; - forall(1..(length(ObjL)),ii, - Obj3=ObjL_ii; - tmp=ProjcoordCurve(Obj3); - Data=Makeskeletondata([tmp],Plt2L,Rr,Eps2); - forall(1..(length(Data)),jj, - Gd=Data_jj; - if((length(Gd)>1) - & (norm(Ptcrv(1,Gd)-Ptcrv(2,Gd))>Eps), - PtD=[]; - forall(1..(length(Gd)), - tmp=Gd_#; - tmp1=Invparapt(tmp,Obj3); - PtD=append(PtD,tmp1); - ); - Out=append(Out,PtD); - ); - ); - ); - Out=select(Out,length(Projcurve(#))>0); // 16.12.19 - tmp1=apply(Out,textformat(#,5)); - tmp=name3+"="+tmp1; - parse(tmp); - tmp=name2+"=Projcurve("+tmp1+");"; - parse(tmp); - Changestyle3d(pltdata1org,["nodisp"]); - if(Noflg<3, - println("generate skeleton :"+name3); - tmp1=text(pltdata1org); - tmp1="list("+substring(tmp1,1,length(tmp1)-1)+")"; - tmp2=text(pltdata2org); - tmp2="list("+substring(tmp2,1,length(tmp2)-1)+")"; - tmp=name3+"=Skeletonpara3data("+tmp1+","+tmp2+","; - tmp=tmp+text(size)+")"; - GLIST=append(GLIST,tmp); - tmp=name2+"=Projpara("+name3+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name2); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name2,Ltype,opcindy]); - if(SUBSCR==1, - Subgraph(name3,opcindy); - ); - ); - Out; -); - -Makeskeletondata(Obj2L,Plt2L,R0,Eps2):=( - regional(Allres,Eps,Dmat,Dind,ii,Dt,nn1,nn2,Nind,Nobj, - Plt2,PhL,ClipL,ns,pt1,pt2,pt,pta,ptb,za,zb,z1,z2,t1,t2,te, - koc,KukanL,nn,tt,Rr,Flg,ii,jj,ptq,hh,Ku,Res,contflg,breakflg); - Eps=10.0^(-4); - Dmat=[]; - Dind=[]; - forall(1..(length(Plt2L)),ii, - Dt=Plt2L_ii; - nn1=length(Dmat)+1; - Dmat=concat(Dmat,Dt); - nn2=length(Dmat); - Dind=append(Dind,[nn1,nn2]); - ); - Nind=length(Dind); - Allres=[]; - forall(1..(length(Obj2L)),Nobj, - Plt2=Obj2L_Nobj; - PhL=Columnlist(Plt2,1..2); - ClipL=[]; - forall(1..(length(PhL)-1),ns, - pt1=PhL_(ns..(ns+1)); - forall(1..(length(Dind)),ii, - tmp=Dind_ii; - tmp=Dmat_(Dind_ii_1..Dind_ii_2); - pt2=Columnlist(tmp,1..2); - koc=IntersectcrvsPp(pt1,pt2,[Eps]); - if(length(koc)>0, - breakflg=0; - forall(1..(length(koc)),jj, - contflg=0; - if(breakflg==0, - pt=Op(1,Op(jj,koc)); - tmp=Op(2,Op(jj,koc)); - if((tmp<1+Eps) & (ns==1), - contflg=1; - ); - if(contflg==0, - if((tmp>length(pt1)-Eps) - & (ns==length(PhL)-1), - contflg=1; - ); - ); - if(contflg==0, - nn1=ns; - nn2=Op(3,Op(jj,koc)); - tmp=Plt2_nn1; - pta=tmp_(1..2); - za=tmp_3; - tmp=Plt2_(nn1+1); - ptb=tmp_(1..2); - zb=tmp_3; - if(norm(pta-ptb)<Eps, - contflg=1; - ); - ); - if(contflg==0, - t1=norm(pta-pt)/norm(pta-ptb); - z1=(1-t1)*za+t1*zb; - tmp=Dmat_(Dind_ii_1..Dind_ii_2); - tmp1=tmp_nn2; - pta=tmp1_(1..2); - za=tmp1_3; - tmp2=tmp_(nn2+1); - ptb=tmp2_(1..2); - zb=tmp2_3; - if(norm(pta-ptb)<Eps, - contflg=1; - ); - ); - if(contflg==0, - t2=norm(pta-pt)/norm(pta-ptb); - z2=(1-t2)*za+t2*zb; - if(z1<z2-Eps2, - if(length(ClipL)==0, - tmp=1; - , - tmp1=column(ClipL,1); - tmp1=apply(tmp1,#-pt_1); - tmp2=column(ClipL,2); - tmp2=apply(tmp2,#-pt_2); - tmp3=apply(tmp1,#^2)+apply(tmp2,#^2); - tmp=min(tmp3); - ); - if(tmp>Eps^2, - tmp1=pt1_2-pt1_1; - tmp2=ptb-pta; - tmp3=Dotprod(tmp1,tmp2); - tmp3=tmp3/norm(tmp1)/norm(tmp2); - tmp=1-0.5*tmp3^2; - tmp1=concat(pt,[nn1,t1,R0/tmp]); - ClipL=append(ClipL,tmp1); - ); - ); - ); - ); - ); - ); - ); - ); - te=length(Plt2); - KukanL=[[1.0,te]]; - pt1=PhL; - if(length(ClipL)>0, - forall(1..(length(ClipL)),ii, - tmp=ClipL_ii; - pt=tmp_(1..2); - nn=tmp_3; - tt=nn+tmp_4; - Rr=tmp_5; - Flg=0; - breakflg=0; - forall(reverse(1..nn),jj, - contflg=0; - if(breakflg==0, - ptq=PointonCurve(jj,pt1); - if(norm(pt-ptq)<Rr, - contflg=1; - ); - if(contflg==0, - Flg=jj; - breakflg=1; - contflg=1; - ); - ); - ); - if(Flg==0, - t1=1; - , - t1=Flg; t2=tt; - hh=t2-t1; - forall(1..10, - hh=hh*0.5; - ptq=PointonCurve(t1+hh,pt1); - if(norm(pt-ptq)<Rr, - t2=t2-hh; - , - t1=t1+hh; - ); - ); - ); - Ku=[t1]; - Flg=0; - breakflg=0; - forall((nn+1)..te,jj, - contflg=0; - if(breakflg==0, - ptq=PointonCurve(jj,pt1); - if(norm(pt-ptq)<Rr, - contflg=1; - ); - if(contflg==0, - Flg=jj; - breakflg=1; - contflg=1; - ); - ); - ); - if(Flg==0, - t2=te; - , - t1=tt; t2=Flg; - hh=t2-t1; - forall(1..10, - hh=hh*0.5; - ptq=PointonCurve(t1+hh,pt1); - if(norm(pt-ptq)<Rr, - t1=t1+hh; - , - t2=t2-hh; - ); - ); - ); - Ku=append(Ku,t2); - KukanL=Kukannozoku(Ku,KukanL); - ); - ); - Res=[]; - forall(1..(length(KukanL)),ii, - tmp=KukanL_ii; - t1=tmp_1; nn1=floor(t1); - t2=tmp_2; nn2=floor(t2); - PtL=[]; - if(t1-nn1<1-Eps, - tmp=PointonCurve(t1,pt1); - PtL=[tmp]; - ); - forall((nn1+1)..nn2,jj, - tmp=PointonCurve(jj,pt1); - PtL=append(PtL,tmp); - ); - if(t2-nn2>Eps, - tmp=PointonCurve(t2,pt1); - PtL=append(PtL,tmp); - ); - tmp=Listplot("",PtL,["nodata"]); - Res=append(Res,tmp); - ); - Allres=concat(Allres,Res); - ); - Allres; -); - -Kukannozoku(Jokyo,KukanL):=( - regional(Res,Eps,nn,ii,t1,t2,Ku,Flg,contflg,tmp,tmp1); - Eps=10^(-6); - nn=length(KukanL); - t1=Jokyo_1; t2=Jokyo_2; - tmp=KukanL_1; - t1=max(t1,tmp_1); - tmp=KukanL_nn; - t2=min(t2,tmp_2); - Res=[]; - Flg=0; - contflg=0; - forall(1..nn,ii, - if(contflg==0, - Ku=KukanL_ii; - if(Flg==0, - if(Ku_2<t1, - Res=append(Res,Ku); - , - Flg=1; - if(Ku_1<t1-Eps, - tmp=[Ku_1,t1]; - Res=append(Res,tmp); - ); - if(Ku_2>t2+Eps, - tmp=[t2,Ku_2]; - Res=append(Res,tmp); - ); - ); - , - if(Flg==1, - if(Ku_2<t2, - contflg=1; - , - if(contflg==0, - Flg=2; - if(Ku_1<t2-Eps, - Ku=[t2,Ku_2]; - ); - Res=append(Res,Ku); - ); - ); - , - if(contflg==0, - Res=append(Res,Ku); - ); - ); - ); - ); - ); - Res; -); - -////////////////// end of current skeleton////////////// - -ProjcoordCurve(Curve):=( - regional(SP,CP,ST,CT,Out,jj,pt,x,y,z,xz,yz,zz); - SP=sin(PHI); CP=cos(PHI); - ST=sin(THETA); CT=cos(THETA); - Out=[]; - forall(1..(length(Curve)),jj, - pt=Curve_jj; - x=pt_1; y=pt_2; z=pt_3; - xz=-x*SP+y*CP; - yz=-x*CP*CT-y*SP*CT+z*ST; - zz=x*CP*ST+y*SP*ST+z*CT; - Out=append(Out,[xz,yz,zz]); - ); - Out; -); - -Divnohidhid(nm,dt3dorg,nvec):=Divnohidhid(nm,dt3dorg,nvec,[],["do"]); -Divnohidhid(nm,dt3dorg,nvec,optionorg,options2):=( -//help:Divnohidhid("1","sc3d1",nvec,["Num=100"],["Num=100","do"]); - regional(name,dt3d,options,pvec,disp,nohid,hid,flg,tmp,tmp1,eqL); - name="nh"+nm; - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - disp="Y"; - forall(eqL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="D", - tmp=indexof(#,"="); - disp=Toupper(substring(#,tmp,tmp+1)); - options=remove(options,[#]); - ); - ); - if(isstring(dt3dorg),dt3d=parse(dt3dorg),dt3d=dt3dorg); - pvec=[sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)]; - nohid=[]; - hid=[]; - flg=0; - forall(1..(length(dt3d)-1), - p1=dt3d_#; - p2=dt3d_(#+1); - tmp=assign(nvec,["x",p1_1,"y",p1_2,"z",p1_3]); - tmp=parse(tmp); - if(Dotprod(tmp,pvec)>0, - if(flg==0 % flg==-1, - nohid=append(nohid,[p1,p2]); - flg=1; - ); - if(flg==1, - nohid_(length(nohid))=append(nohid_(length(nohid)),p2); - ); - , - if(flg==0 % flg==1, - hid=append(hid,[p1,p2]); - flg=-1; - ); - if(flg==-1, - hid_(length(hid))=append(hid_(length(hid)),p2); - ); - ); - ); - if(disp=="Y", - Changestyle3d([dt3dorg],["nodisp"]); - forall(1..length(nohid), - Spaceline(name+"nh"+text(#),nohid_#,options); - ); - forall(1..length(hid), - Spaceline(name+"h"+text(#),hid_#,options2); - ); - ); - tmp1="["; - forall(nohid,tmp1=tmp1+textformat(#,5)+","); - tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; - parse(name+"nh="+tmp1); - tmp1="["; - forall(hid,tmp1=tmp1+textformat(#,5)+","); - tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; - parse(name+"h="+tmp1); - [nohid,hid]; -); - -Beziersurf(nm,m,n,pL):=( -//help:Beziersurf("pt",2,2,pL); - regional(p3dL,ptlistx,ptlilsty,ptlistz); - factorial(n):=( - regional(out); - out=1; - forall(1..n, - out=out*#; - ); - out; - ); - Deffun("Comb(n,r)",[ - "regional(y)", - "y=factorial(n)/(factorial(r)*factorial(n-r))", - "y" - ]); - Deffun("Bterm(u,v,m,n,i,j)",[ - "regional(y)", - "y=Comb(m,i)*u^i*(1-u)^(m-i)", - "y=y*Comb(n,j)*v^j*(1-v)^(n-j)", - "y" - ]); - Deffun("Ball(u,v,m,n,pL)",[ - "regional(y,ii,jj,tmp,tmp1)", - "y=0", - "forall(0..m,ii, - forall(0..n,jj, - tmp=(n+1)*ii+jj+1; - tmp1=Op(tmp,pL); - tmp1=tmp1*Bterm(u,v,m,n,ii,jj); - y=y+tmp1; - ) - )", - "y" - ]); - if(ispoint(pL_1), - p3dL=apply(pL,parse(text(#)+"3d")); - , - p3dL=apply(pL,parse(#+"3d")); - ); - ptlistx=apply(p3dL,#_1); - ptlisty=apply(p3dL,#_2); - ptlistz=apply(p3dL,#_3); - Defvar(nm+"x",ptlistx); - Defvar(nm+"y",ptlisty); - Defvar(nm+"z",ptlistz); - tmp=[ - "p", - "x=Ball(U,V,2,2,"+nm+"x)", - "y=Ball(U,V,2,2,"+nm+"y)", - "z=Ball(U,V,2,2,"+nm+"z)", - "U=[0,1]", - "V=[0,1]" - ]; - tmp; -); - -//help:end(); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1logr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1logr.txt deleted file mode 100644 index d815618a..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1logr.txt +++ /dev/null @@ -1,90 +0,0 @@ -//20180408 -// Divoptions changed ( to remove null string ) -// Changework changed (nkfwin) -// Hyperbolaplot debugged -// Derivative debugged -//20180405 -// Ketinit changed (order of changesettiing, Dircdy) -//20180402 -// Implicitplot, Connectseg added -//20180329 -// Ketinit changed (changing of Dircdy) -// Changesetting added -// Derivative changed ( Numerical method supportted ) -//20180328 -// Cindyname (=Cdyname ) added -// Cindyfile,Cindypath deleted -//20180317 -// IntersectcurvesPp changed -// Collectsameseg added, Collectnear commented out -// 2018.02.11 -// Dqq added ( = DqDq) -// 2018.02.06 -// Intersectpartseg debugged -// 2018.02.02 -// Enclosing2 changed (for distanted curves, startpt option removed ) -// 2018.02.01 -// Makehatch changed ( in accordance with Intersectseg ) -// 2018.01.30 -// Intersectseg changed ( for the case of no intersect ) -// 2018.01.29 -// Intersectpartseg changed ( for the case curves are strings ) -// Textformat changed ( for null list ) -// 2018.01.26 -// Enclosing2 (new enclosing ), Makehatch, Hatchdatacindy added -// 2018.01.15 -// Setunitlen changed ( as R ) -// Ketinit changed (Marklennow,... added as R ) -// 2018.01.07 -// Collectnear added -// Intersectcurves changed (Collectnear used) -// 2018.01.05 -// Intersectcurves changed (LLcrd) -// Intersectcurvespt added -// Intersectpartseg debugged -// Intersectline changed -// s:2018.01.04 -// PointonCurve debugged ( t >=1, t<=length(g) ) -// Intersectcurves.... added -// s:2017.12.27 -// Getcdyname(Cdyname) changed -// s:2017.12.03 -// Ketinit changed (definition of LibnameS ) -// s:2017.12.01 -// Ketinit changed (to modify Dircdy ) -// s:2017.11.27 -// Setparent added ( for Texparent) -// Getcdyname added ( name of the current cdy file) -// s:2017.11.24 -// Changework changed ( for the case of double pathsep() in dir, subdir ) -// s:2017.11.20 -// Changework changed ( for the case of (ex) dir=".../" ) -// s:2017.11.12 -// Ketinit debugged (Fhead) -// s:2017.10.24 -// Ketinit changed (Slidename added) -// s:2017.10.23 -// Pointdata changed (for string ) -// s:2017.10.14 -// Ketinit() changed (Fhead) -// s:2017.10.13 -// Ketinit() changed (definition of Shellparent,Shellchild) -// s:2017.10.07 -// Pointdata debugged -// s:2017.10.07 -// Setcolor debugged ( \ => \\ ) -// s:2017.10.06 -// Deqplot changed -// s:2017.08.29 -// Ketinit changed (LibnameS) -//2017.09.22 -// Texcom debugged -// Setcolor changed ( Texcom used ) -//2017.09.18 -// SCIWR,SCIRE removed -// 2017.09.17 -// Ketinit changed ( PathS=6... removed ) -// 2017.09.13 -// Changed to FnameR - - diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1r.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1r.cs deleted file mode 100644 index f45ffee8..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic1r.cs +++ /dev/null @@ -1,5932 +0,0 @@ -// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -// -//This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU General Public License as published by -// the Free Software Foundation; either version 3 of the License, or -// (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with this program. If not, see <http://www.gnu.org/licenses/> -// - -println("KETCindy V.3.2.0(20180409)"); -println(ketjavaversion());//17.06.05 -println("ketcindylibbasic1(20180408) loaded"); - -//help:start(); - -//help:drawimage([0,0],"picture.png",scale->2,alpha->0.4); -//help:drawtext((2,1),"Text",size->2); -//help:system(list=append(list,"a");); -//help:system(list=concat(list,["a","b"]);); -//help:system(arccos,arcsin,arctan); -//help:system(abs,round,floor,ceil); - -//help:Option1(["dr","dr,2","da","da,2,1","do","do,1,2"]); -//help:Option2(["notex","nodisp","nodata"]); - -//help:getdirhead(); -//help:gedirhead("/Applications"); -//help:gedirhead("C:\Users\(username)"); -//help:setpath(); - -Ch=[0]; ChNum=1; - -Ketinit():=Ketinit(1); -//help:Ketinit(); -Ketinit(sy):=Ketinit(sy,[-5,5],[-5,5]); -Ketinit(sy,rangex,rangey):=( - regional(pt,tmp,tmp1,tmp2,letterc,boxc,shadowc,mboxc); - PenThickInit=8; - ULEN="1cm"; - MEMORI=0.05;//18.01.15from - MEMORIInit=MEMORI; - MEMORINow=MEMORI; - MARKLEN=0.05; - MARKLENInit=MARKLEN: - MARKLENNow= MARKLEN; - GENTEN=[0,0];//18.01.15until - KETPICLAYER=20; - MilliIn=1/2.54*1000; - PenThick=round(MilliIn*0.02); - PenThickInit=PenThick; - TenSizeInit=0.02; - TenSize=TenSizeInit; - YaSize=1; YaAngle=18; YaPosition=1; - YaThick=1; YaStyle='tf'; - KETPICCOUNT=1; - KCOLOR=[0,0,0]; - GLIST=[]; - GCLIST=[]; -// GDATALIST=[]; - GOUTLIST=[]; - POUTLIST=[]; - VLIST=[]; - FUNLIST=[]; - LETTERlist=[]; - COM0thlist=[]; - COM1stlist=[]; - COM2ndlist=[]; - ADDAXES="1"; - LFmark=unicode("000a"); - CRmark=unicode("000d");//16.12.13 - Dq=unicode("0022"); - WaitUnit=10; - CONTINUED=0; - OutComList=[]; - OutFileLIst=[]; // 15.10.22 - FigPdfList=[]; // 16.04.08 - ADDPACK=[]; // 16.05.16 - ErrFlag=0; - setdirectory(Dirwork); - if(!isstring(Fhead), // 17.10.13from, 17.11.12 - Fhead=text(curkernel()); - Fhead=replace(Fhead,".cdy",""); - Slidename=Fhead; //17.10.24 - );//17.11.12 - Dircdy=replace(Dircdy,"%E3%80%80"," ");//180405 - tmp1=Indexall(Dircdy,"%"); //180329from - if(length(tmp1)>0, - tmp1=append(tmp1,length(Dircdy)); - tmp2=substring(Dircdy,0,tmp1_1-1); - forall(1..(length(tmp1)-1), - tmp=substring(Dircdy,tmp1_#,tmp1_#+2); - tmp2=tmp2+unicode(tmp); - tmp2=tmp2+substring(Dircdy,tmp1_#+2,tmp1_(#+1)-1); - ); - Dircdy=tmp2; - ); //180329to - if(iswindows(), //17.12.01 - Dircdy=replace(Dircdy,"/",pathsep()); - if(substring(Dircdy,0,1)==pathsep(), - Dircdy=substring(Dircdy,1,length(Dircdy)); - ); - Changesetting([gethome(), gethome()+"\Desktop","C:"]); //180405 - , - Changesetting([gethome(),gethome()+"/Desktop"]); - ); - Changework(Dircdy+pathsep()+"fig"); //180329to - Fnametex=Fhead+".tex"; - FnameR=Fhead+".r"; - FnamebodyR=Fhead+"body.r"; - Fnameout=Fhead+".txt"; // 17.10.13until - if(!isstring(Mackc),// 16.06.07 - Mackc="sh"; - ); - if(iswindows(), - Batparent="\kc.bat"; - , - Shellparent="/kc.sh"; - if(!isexists(Dirwork,""), - println(Dirwork+" not exists"); - , - if(!iskcexists(Dirwork), - setdirectory(Dirwork); - SCEOUTPUT = openfile(Shellparent); - closefile(SCEOUTPUT); - println(Shellparent+" generated"); - ); - println(setexec(Dirwork,Shellparent)); - ); - ); - ArrowlineNumber=1; // 15.01.05 - ArrowheadNumber=1; - BezierNumber=1; //15.01.03 - SCALEX=1; - SCALEY=sy; -// Setscaling(sy); - XMIN=rangex_1/SCALEX; - XMAX=rangex_2/SCALEX; - YMIN=rangey_1/SCALEY; - YMAX=rangey_2/SCALEY; - Setwindow("Msg=n"); // 16.05.31 - // for Presentation - letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; - shadowc=[0,0,0,0.5]; mboxc="yellow"; //17.03.02 regional debugged - SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, - letterc,mboxc,mboxc,mboxc,62,2,letterc]; - ThinDense=0.1;//17.01.08 - if(indexof(PathS,"-5.")>0,//17.12.03from - LibnameS=Dirlib+pathsep()+"ketpicsciL5"; - , - LibnameS=Dirlib+pathsep()+"ketpicscifiles6"; - ); - if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")>0, - LibnameS=replace(LibnameS,"ketpic","ketpic2e"); - );//17.12.03until -); - -Changesetting(dirL):=( //180329 - regional(fname,tmp1,flg); - fname="changesetting.txt"; - tmp1=apply(dirL,#+pathsep()+"ketcindy"); - tmp1=prepend(Dircdy,tmp1); - flg=0; - forall(tmp1, - if(flg==0, - if(isexists(#,fname), - setdirectory(#); - import(fname); - println(fname+" imported from "+#); - flg=1; - ); - ); - ); - if(flg==0, - println(fname+" not exists in "+text(tmp1)); - println(" Put "+fname+" in one of folders above"); - ); -); - -Cindyname():=Getcdyname(); -Cdyname():=Getcdyname(); -Getcdyname():=( //17.12.27 -//help:Cdyname(); - regional(out); - out=text(curkernel()); - out=replace(out,".cdy",""); -); - -Setwindow():=Setwindow("Msg=yes"); -Setwindow(str):=( - regional(tmp,tmp1,tmp2,msg); - msg="y"; - tmp=indexof(str,"="); // 16.02.10 - tmp1=Toupper(substring(str,tmp,tmp+1)); - if(tmp1=="N",msg="n"); - if((ispoint(SW) & ispoint(NE)), - tmp1=Lcrd(SW); - tmp2=Lcrd(NE); - XMIN=tmp1_1; XMAX=tmp2_1; - YMIN=tmp1_2; YMAX=tmp2_2; - , -// XMIN=-5; XMAX=5; -// YMIN=Lcrdy(-5); YMAX=Lcrdy(5); -// createpoint("SW",Pcrd([XMIN,YMIN])); -// createpoint("NE", Pcrd([XMAX,YMAX])); - Putpoint("SW",Pcrd([XMIN,YMIN])); - Putpoint("NE", Pcrd([XMAX,YMAX])); - ); - if(msg=="y", - println("Setwindow(["+XMIN+","+XMAX+"],["+YMIN+","+YMAX+"])"); - ); - layer(KETPICLAYER); - autoclearlayer(KETPICLAYER,true); - drawpoly([Pcrd([XMIN,YMIN]), Pcrd([XMAX,YMIN]), - Pcrd([XMAX,YMAX]),Pcrd([XMIN,YMAX])],color->[1,1,1]); -); -Setwindow(xrange,yrange):=( -//help:Setwindow([2,3],[-1,1]); - XMIN=xrange_1; - XMAX=xrange_2; - YMIN=yrange_1; - YMAX=yrange_2; - Putpoint("SW",Pcrd([XMIN,YMIN]));//17.05.30 - Putpoint("NE",Pcrd([XMAX,YMAX]));//17.05.30 -// Ketinit(); -); - -Setfiles(file):=( // 17.01.16 -//help:Setfiles(file); - Fhead=file; - Fnametex=Fhead+".tex"; - FnameR=Fhead+".r"; //17.10.14 - FnamebodyR=Fhead+"body.sce"; - Fnameout=Fhead+".txt"; -); - -Setparent(file):=( // 17.11.27 -//help:Setparent(file); - Texparent=file; -); - -Dqq(str):=DqDq(str); //18.02.11 -DqDq(str):=( -//help(Dqq("ab"); => Dq+"ab"+Dq) - unicode("0022")+str+unicode("0022"); -); - -Tab2list(dtstr):=Tab2list(dtstr,[]); -Tab2list(dtstrorg,options):=( -//help:Tab2list(datastr); -//help:Tab2list(options=["Blank=(null)","Sep=tab"]); - regional(dtstr,dtall,dt,rep,out,crm,lfm,htm,first,eqL,sep, - tmp,tmp1,tmp2); - crm=unicode("000d"); - lfm=unicode("000a"); - htm=unicode("0009"); - tmp=Divoptions(options); - eqL=tmp_5; - rep=""; - sep=htm; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="B", - tmp1="0123456789+-."; // 16.09.28from - tmp=substring(tmp2,0,1); - if(indexof(tmp1,tmp)>0,rep=parse(tmp2),rep=tmp2); // 16.09.28until - ); - if(tmp1=="S", // 16.12.04 - if(tmp2!="tab",sep=tmp2); - ); - ); - first=lfm; // 16.09.05from - if(indexof(dtstr,crm)>0, - first=crm; - if(indexof(dtstr,crm+lfm)>0, - first=first+lfm; - ); // 16.09.05until - ); - dtstr=dtstrorg;// 16.09.19from - tmp=substring(dtstr,length( dtstr)-1,length(dtstr)); - if(tmp!=lfm, - dtstr=dtstr+first; - );// 16.09.19until - tmp1=Indexall(dtstr,first); - tmp1=prepend(0,tmp1); - tmp1=append(tmp1,length(dtstr)); - dtall=[]; - forall(1..(length(tmp1)-1), - tmp=substring(dtstr,tmp1_#,tmp1_(#+1)-1); - if(length(tmp)>0, - dtall=append(dtall,tmp); - ); - ); - out=[]; - forall(dtall,dt, - tmp1=tokenize(dt,sep); //16.12.04 - tmp2=[]; - forall(tmp1, - if(isstring(#),tmp=parse(#),tmp=#); - if(!isreal(tmp), - if(length(#)>0,tmp=#,tmp=rep); - ); - tmp2=append(tmp2,tmp); - ); - out=append(out,tmp2); - ); - out; -); - -Columnlist(dt,list):=( // 16.09.04 -//help:Columnlist(dt,1..3); - apply(dt,#_list); -); - -Dispmat(dt):=( // 16.09.16 -//help:Dispmat(dt); - regional(htm,crm,lfm,row,tmp,tmp1,tmp2); - htm=unicode("0009"); - crm=unicode("000d"); - lfm=unicode("000a"); - tmp2=""; - forall(dt,row, - tmp1=""; - forall(row, - if(isstring(#), - tmp1=tmp1+#+htm; - , - tmp1=tmp1+text(#)+htm; - ); - ); - tmp1=substring(tmp1,0,length(tmp1)-1); - tmp1=tmp1+lfm; - tmp2=tmp2+tmp1; - ); - print(tmp2); - println(); -); - -Sep1000(va):=( //17.07.18 -//help:Sep1000(1344555); -//help:Sep1000([12456,55567]); - regional(str,nall,out); - if(islist(va), - out=apply(va,Sep1000(#)); - , - str=text(va); - nall=length(str); - out=""; - forall(1..nall, - out=str_(nall+1-#)+out; - if((#<nall)&(mod(#,3)==0), - out=","+out; - ); - ); - ); - out; -); - -factorial(n):=( -//help:factorial(5); - regional(out); - out=1; - forall(1..n, - out=out*#; - ); - out; -); - -norm(v1):=( // 16.09.01 -//help:norm([2,1,3]); - regional(out,tmp,tmp1,tmp2); - out=0; - forall(1..(length(v1)), - out=out+(v1_#)^2; - ); - out=sqrt(out); - out; -); -norm(v1,v2):=( - norm(v2-v1); -); - -// 16.03.28 -Removespace(str):=( -//help:Removespace(" a b c "); - regional(tmp,flg,out); - tmp=length(str)+1; - flg=0; - forall(1..(length(str)), - if(flg==0, - if((str_#)!=" ", - tmp=#; - flg=1; - ); - ); - ); - out=substring(str,tmp-1,length(str)); - flg=0; - tmp=0; - forall(reverse(1..(length(out))), - if(flg==0, - if((out_#)!=" ", - tmp=#; - flg=1; - ); - ); - ); - out=substring(out,0,tmp); -); - -Indexall(str,key):=( - regional(rest,out,flg,tmp,tmp1,); - out=[]; - rest=str; - flg=0; - forall(1..(length(str)), - if(flg==0, - tmp=indexof(rest,key); - if(tmp>0, - tmp1=tmp+length(str)-length(rest); - out=append(out,tmp1); - rest=substring(rest,tmp,length(rest)); - , - flg=1; - ); - ); - ); - out; -); - -Parlevel(str):=Bracket(str); // 16.05.22from -Bracket(str):=Bracket(str,"()"); -Bracket(str,br):=( -//help:Bracket(string,"()"); - regional(ph,pt,out,noL,ncL,nall,level,tmp); - ph=substring(br,0,1); - pt=substring(br,1,2); - noL=Indexall(str,ph); - ncL=Indexall(str,pt); // 16.05.22until - nall=sort(concat(noL,ncL)); - level=0; - out=[]; - forall(nall, - if(contains(noL,#), - level=level+1; - tmp=[#,level]; - , - tmp=[#,-level]; - level=level-1; - ); - out=append(out,tmp); - ); - out; -); - -Pardiagram(str):=Pardiagram(str,[20]); -Pardiagram(str,options):=( -//help:Pardiagram(exprstr); -//help:Pardiagram(options=[20,"Disp=y","Fig=y"]); - regional(reL,eqL,len,disp,scheme,bra,nn,sta,out, - opos,cpos,all,dx,dh,mxh,start,nn,p1,p2,p3,p4,tmp,tmp1,tmp2,tmp3); - len=20; - disp=1; - scheme=1; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=Toupper(substring(#,tmp,tmp+1)); - if(tmp1=="D", - if(tmp2=="N" % tmp2=="F",disp=0); - ); - if(tmp1=="F", - if(tmp2=="N" % tmp2=="F",scheme=0); - ); - ); - forall(reL, - len=#; - ); - bra=Bracket(str); - tmp1=select(bra,#_2>0); - tmp2=select(bra,#_2<0); - out=[]; - forall(1..(length(tmp1)),nn, - sta=tmp1_nn; - tmp=select(tmp2,#_2==-sta_2 & #_1>sta_1); - tmp=tmp_1; - out=append(out, [substring(str,sta_1-1,tmp_1), - nn,sta_2,sta_1,tmp_1, - substring(str,sta_1-1,sta_1+len-1), - substring(str,tmp_1-len,tmp_1)] ); - ); - if(disp==1, - println("Printing from 2 to 7. (Extract full string using _1)"); - apply(out,println(#_(2..7))); - ); - if(scheme==1, - opos=sort(apply(out,#_4)); - cpos=sort(apply(out,#_5)); - tmp=concat(opos,cpos); - all=sort(tmp); - mxh=max(apply(out,#_3)); - dx=1; - dh=1; - start=[-5,5]; - forall(1..(length(all)),nn, - tmp=select(out,#_4==all_nn); - if(length(tmp)>0, - tmp1=tmp_1_3; - tmp2=tmp_1_4; - tmp3=tmp_1_5; - tmp=select(1..(length(all)),all_#==tmp3); - tmp4=tmp_1; - p1=start+[(nn-1)*dx,-0.5]; - p2=p1+[0,(tmp1-mxh-1)*dh]; - p3=p2+[(tmp4-nn)*dx,0]; - p4=p3+[0,(mxh+1-tmp1)*dh]; - Listplot("ch"+text(nn),[p1,p2,p3,p4],["Message=n"]); - Letter([p2,"s",text(tmp2),p3,"s",text(tmp3)]); - tmp=select(1..(length(opos)),opos_#==tmp2); - tmp=tmp_1; - if(tmp==1, - tmp=substring(str,tmp2-1,tmp2); - , - if(opos_(tmp-1)==opos_tmp-1, - tmp=substring(str,tmp2-1,tmp2); - , - tmp=substring(str,tmp2-2,tmp2); - ); - ); - tmp=replace(tmp,"^","**"); - Expr(p1,"n",tmp); - tmp=select(1..(length(cpos)),cpos_#==tmp3); - tmp=tmp_1; - if(tmp==length(cpos), - tmp=substring(str,tmp3-1,tmp3); - , - if(cpos_(tmp+1)==cpos_tmp+1, - tmp=substring(str,tmp3-1,tmp3); - , - tmp=substring(str,tmp3-1,tmp3+1); - ); - ); - tmp=replace(tmp,"^","**"); - Expr(p4,"n",tmp); - ); - ); - ); - out; -); - -Changework(dirorg):=( //16.10.21 -//help:Changework(directory); - regional(dir,subdir,tmp); - dir=replace(dirorg,"/",pathsep());//17.11.20from - dir=replace(dir,"\",pathsep()); - dir=replace(dir,pathsep()+pathsep(),pathsep());//17.11.24 - tmp=length(dir); - if(substring(dir,tmp-1,tmp)==pathsep(), - dir=substring(dir,0,tmp-1); - );//17.11.20until - tmp=Indexall(dir,pathsep()); //17.11.24from - subdir=""; - if(length(tmp)>0, - tmp=tmp_(length(tmp)); - subdir=substring(dir,tmp,length(dir)); - dir=substring(dir,0,tmp-1); - ); //17.11.24until - if(dir=="" % !isexists(dir,""), - println("Directory "+dir+" not exist, so set to "+Dirwork); - ErrFlag=-1; - , - if(length(subdir)>0, //17.11.24from - println(makedir(dir,subdir)); - Dirwork=dir+pathsep()+subdir; - , - Dirwork=dir; - ); //17.11.24until - setdirectory(Dirwork); - if(!iswindows(), //17.04.11 - if(!iskcexists(Dirwork), - SCEOUTPUT = openfile("/kc.sh"); - closefile(SCEOUTPUT); - println(setexec(Dirwork,"/kc.sh")); - ); - , - if(isincludefull(Dirwork),//180408from - SCEOUTPUT = openfile("utf8.txt"); - println(SCEOUTPUT,"tmp="+Dqq(Dirwork)+";"); - closefile(SCEOUTPUT); - nkfwin("C:",Dirwork,"utf8.txt","sjis.txt");//180408to - ); - ); - ); -); - -Changestyle(nameL,style):=( -//help:Changestyle(["sgAB"],["da"]); - regional(nmL,name,Ltype,Ltypeorg,Noflg,opcindy,tmp); - tmp=Divoptions(style); - Ltypeorg=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - if(islist(nameL),nmL=nameL,nmL=[nameL]); - forall(nmL,name, - Ltype=Ltypeorg; - GCLIST=select(GCLIST,#_1!=name); - COM2ndlist=select(COM2ndlist, - (indexof(#,"("+name)==0)%(indexof(#,"Shade")>0)); // 15.05.23,16.12.13 - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - ); -); - -Op(n,object):=( // 16.05.25 -//help:Op(4,[1,2,3,4]); -//help:Op(3,"abcd"); - regional(out); - if(islist(object), - out=object_n; - , - if(isstring(object), - out=substring(object,n-1,n); - ); - ); - out; -); - -Finddef(G):=( - regional(def,tmp,tmp1,tmp2,tmp3); - if(isstring(G),tmp=parse(G),tmp=G); - def=text(inspect(tmp,"definition")); - tmp1=indexof(def,"("); - tmp2=indexof(def,";"); - tmp3=indexof(def,")"); - tmp=[substring(def,0,tmp1-1)]; - if(tmp2>0, - tmp=append(tmp,substring(def,tmp1,tmp2-1)); - if(indexof(def,")",tmp3+1)==0, - tmp=append(tmp,substring(def,tmp2,tmp3-1)); - , - tmp=append(tmp,substring(def,tmp2,tmp3)); - ); - , - tmp=append(tmp,substring(def,tmp1-1,tmp3)); - ); - tmp; -); - -Findgeoinfo(geo):=( - regional(out,tmp,tmp1,tmp2); - tmp=Finddef(geo); - if(ispoint(parse(tmp_2)), - out=[tmp_2,tmp_3]; - , - tmp1=Findgeoinfo(parse(tmp_2)); - if(ispoint(parse(tmp1_1)), - out=[tmp1_1,tmp1_2]; - , - tmp2=Findgeoinfo(parse(tmp1_2)); - out=[tmp2_1,tmp2_2]; - ); - ); - if(ispoint(geo), - if(!ispoint(parse(tmp_2)), - tmp1=Finddef(parse(tmp_2)); - , - tmp1=tmp; - ); - out=append(out,tmp1_3); - , - out=append(out,tmp_3); - ); - out; -); - -Dependgeo(geo):=( - regional(tmp,tmp1,tmp2,out); - tmp=Finddef(geo); - if(!iscircle(geo), - out=[text(geo)]; - , - out=[geo]; - ); - if(length(tmp)<3, - out=concat(out,[tmp_1,[]]); - , - out=concat(out,[tmp_1]); - tmp1=[tmp_2,tmp_3]; - tmp=parse(tmp1_2); - if(islist(tmp) % isreal(tmp), - tmp1=[tmp1_1]; - ); - out=append(out,tmp1); - ); - out; -); - -Workprocess():=Workprocess(300); -Workprocess(nn):=Drawprocess(nn); -Drawprocess():=Drawprocess(300); -Drawprocess(nn):=( -//help:Workprocess(); - regional(All,added,remain,out,flg,tmp,tmp1,tmp2); - tmp=remove(allpoints(),[NE,SW,TH,FI]); - tmp1=select(tmp, - substring(text(#),length(text(#))-1,length(text(#)))!="z"); - tmp1=concat(tmp1,alllines()); -// tmp1=concat(tmp1,allcircles()); - All=apply(tmp1,Dependgeo(#)); - added=select(All,length(#_3)==0); - out=sort(apply(added,#_1)); - remain=remove(All,added); - flg=0; - repeat(nn, - if(flg==0, - tmp1=select(remain,remove(#_3,out)==[]); - tmp2=sort(apply(tmp1,#_1)); - out=concat(out,tmp2); - remain=remove(remain,tmp1); - if(length(remain)==0,flg=1); - ); - ); - println("Process of drawing"); - forall(out, - println(Dependgeo(parse(#))); - ); - out; -); - -Sortpointlist(list):=( - regional(plist,ilist,jj,kk,flg,p1,p2,in1,in2, - tmp,tmp1,tmp2,out); - out=list; - plist=list_1; - ilist=list_2; - flg=0; - forall(1..(length(plist)),jj, - p1=plist_jj; - in1=ilist_jj; - forall((jj+1)..(length(plist)),kk, - if(flg==0, - p2=plist_kk; - in2=ilist_kk; - if(contains(in1,p2), - tmp1=plist_(1..(jj-1)); - tmp1=append(tmp1,p2); - tmp1=concat(tmp1,plist_((jj+1)..(kk-1))); - tmp1=append(tmp1,p1); - tmp1=concat(tmp1,plist_((kk+1)..(length(plist)))); - tmp2=ilist_(1..(jj-1)); - tmp2=append(tmp2,in2); - tmp2=concat(tmp2,ilist_((jj+1)..(kk-1))); - tmp2=append(tmp2,in1); - tmp2=concat(tmp2,ilist_((kk+1)..(length(plist)))); - out=Sortpointlist([tmp1,tmp2]); - flg=1; - ); - ); - ); - ); - out; -); - -Toupper(str):=( -//help:Toupper("Abc"); - regional(alphabet,out,tmp,tmp1); - alphabet="abcdefghijklmnopqrstuvwxyz"; - out=""; - forall(1..(length(str)), - tmp=substring(str,#-1,#); - tmp1=indexof(alphabet,tmp); - if(tmp1>0, - out=out+unicode(text(tmp1+64),base->10); - , - out=out+tmp; - ); - ); - out; -); - -Textformat(value,dig):=( -//help:Textformat(2/3,4); -//help:Textformat([gr1,gr2],5); - regional(vv,tmp,tmp1); - if(islist(value), - tmp1="["; - forall(value, - tmp1=tmp1+Textformat(#,dig)+","; - ); - if(length(tmp1)>1, //18.01.29from - tmp1=substring(tmp1,0,length(tmp1)-1); - ); - tmp1=tmp1+"]"; //18.01.29until - , - if(ispoint(value) % isstring(value), -// vv=Lcrd(value); -// tmp1=Textformat(vv,dig); -// tmp1=text(value); // 15.04.07 - if(isstring(value),tmp1=Dq+value+Dq,tmp1=text(value)); // 15.10.02 - , - tmp1=format(value,dig); - ); - ); - tmp1; -); - -Sprintf(value,dig):=( -//help:Sprintf(5.1,4); - regional(vv,tmp,tmp1); - if(!islist(value), // 17.03.12from - if(isstring(value), - vv=value; - , - vv=Textformat(value,dig); - ); // 17.03.12from - if(indexof(vv,".")==0,vv=vv+"."); - vv=vv+"0000000000000000"; - tmp=indexof(vv,".")+dig; - vv=substring(vv,0,tmp); - , - vv=apply(value,Sprintf(#,dig)); - ); - vv; -); - -Assign(str):=( // old - regional(out); - out=str; - forall(VLIST, - tmp=substring(#_1,0,length(#_1)-1); - out=replace(out,tmp,"("+#_2+")"); - ); - out; -); - -Assign(funstr,vrL):=( - regional(nn,out,tmp,tmp1); - nn=length(vrL)/2; - out=funstr; - forall(1..nn, - out=Assign(out,vrL_(2*#-1),vrL_(2*#)); - ); - out; -); - -Assign(funstr,varname,rep):=( -//help:Assign("x^2+a*x","a",1.3); -//help:Assign("a*x^2+b*x",["a",1,"b",2]); - regional(repstr,ii,jj,tmp,tmp1,tmp2,Notvar,Flg); - if(isstring(rep),repstr=rep,repstr="("+Textformat(rep,6)+")"); - // 15.02.09, 07.06,17.08.24 - tmp=[46]; // 12.20 - tmp=concat(tmp,48..57); - tmp=concat(tmp,65..90); - tmp=concat(tmp,97..122); - Notvar=apply(tmp,unicode(text(#),base->10)); - tmp2=""; - forall(1..100, - ii=indexof(funstr,varname); - if(ii>0, - Flg=0; - if(ii>1, - tmp=substring(funstr,ii-2,ii-1); - if(contains(Notvar,tmp), - tmp2=tmp2+substring(funstr,0,ii); - funstr=substring(funstr,ii,length(funstr)); - Flg=1; - ); - ); - if(Flg==0, - jj=ii-1+length(varname); - if(jj<length(funstr), - tmp=substring(funstr,jj,jj+1)); - if(contains(Notvar,tmp), - tmp2=tmp2+substring(funstr,0,jj); - funstr=substring(funstr,jj,length(funstr)); - Flg=1; - ); - ); - if(Flg==0, - tmp2=tmp2+substring(funstr,0,ii-1)+repstr; - funstr=substring(funstr,jj,length(funstr)); - ); - ); - ); - funstr=tmp2+funstr; - funstr; -); - -MeasureDepth(list):=( - regional(tmp,tmp1,Depth,Flg); - Flg=0; - Depth=0; - if(ispoint(list), // 15.01.22 - Depth=0; - Flg=1; - , - tmp1=select(1..(length(list)),length(list_#)>0);//17.05.21from - tmp=list_(tmp1_1);//17.05.21until - ); - repeat(4, - if(Flg==0, - if(islist(tmp), - tmp=tmp_1; - Depth=Depth+1; - , - if(ispoint(tmp),Depth=Depth+1); - Flg=1; - ); - ); - ); - Depth; -); - -Flattenlist(pltlist):=( -//help:Flattenlist([[2,3],[[1,2],[5,6]]]); - regional(Out,nn,Dt,ii,tmp,flg); - Out=[]; - if(MeasureDepth(pltlist)==1, - Out=[pltlist]; - , - forall(1..(length(pltlist)),nn, - Dt=pltlist_nn; - if(MeasureDepth(Dt)<2, - Out=append(Out,Dt); - , - forall(1..(length(Dt)),ii, - tmp=Flattenlist(Dt_ii); - Out=concat(Out,tmp); - ); - ); - ); - ); - Out; -); - -Divoptions(options):=( -//help:Divoptions(options); - regional(Ltype,Noflg,Inflg,Outflg,eqL,realL,strL,opstr,opcindy,flg,tmp,tmp1); - Ltype="dr"; // 2015.01.13 - Noflg=0; - Inflg=0; - Outflg=0; - eqL=[]; - realL=[]; - strL=[]; - opstr=""; - opcindy=""; - forall(options, - flg=0; - if(flg==0, - if(isreal(#) % ispoint(#) % islist(#), - realL=append(realL,#); - opstr=opstr+","+text(#); - flg=1; - ); - ); - if(flg==0, - if(indexof(#,"=")>0, - eqL=append(eqL,#); - flg=1; - ); - ); - if(flg==0, - if(indexof(#,"no")+indexof(#,"No")>0, - if(indexof(#,"tex")>0,Noflg=1); - if(indexof(#,"disp")>0,Noflg=2); - if(indexof(#,"data")>0,Noflg=3); - flg=1; - ); - ); - if(flg==0, - if(indexof(#,"->")>0, - opcindy=opcindy+","+#; - flg=1; - ); - ); - if(flg==0, - if(indexof(#,"out")+indexof(#,"Out")>0, - if(indexof(#,"-")==0, - Outflg=1; - , - Outflg=2; - ); - flg=1; - ); - ); - if(flg==0, - if(indexof(#,"in")+indexof(#,"In")>0, - if(indexof(#,"-")==0, - Inflg=1; - , - Inflg=2; - ); - flg=1; - ); - ); - if(flg==0, - tmp=substring(#,0,2); - tmp1=indexof(tmp,"dr")+indexof(tmp,"Dr"); - tmp1=tmp1+indexof(tmp,"da")+indexof(tmp,"Da"); - tmp1=tmp1+indexof(tmp,"id")+indexof(tmp,"Id"); - tmp1=tmp1+indexof(tmp,"do")+indexof(tmp,"Do"); - tmp1=tmp1+indexof(tmp,"dp")+indexof(tmp,"Dp"); - if(tmp1>0, - Ltype=#; - flg=1; - ); - if(flg==0, - if(length(#)>0, //180408 - strL=append(strL,#); - opstr=opstr+","+Dq+#+Dq; - ); - ); - ); - ); - if(indexof(opcindy,"color->")==0,// 16.10.07from - opcindy=opcindy+",color->[0,0,0]"; - ); - [Ltype,Noflg,Inflg,Outflg,eqL,realL,strL,opstr,opcindy]; -); - -Dotprod(vec1,vec2):=( -//help:Dotprod(vec1,vec2); - regional(v1,v2,tmp); - if(ispoint(vec1),v1=vec1.xy,v1=vec1); - if(ispoint(vec2),v2=vec2.xy,v2=vec2); - v1*v2; -); - -Crossprod(a,b):=( -//help:Crossprod(vec1,vec2); - regional(tmp1,tmp2,tmp3,Out); - if(length(a)==3, - tmp1=a_2*b_3-a_3*b_2; - tmp2=a_3*b_1-a_1*b_3; - tmp3=a_1*b_2-a_2*b_1; - Out=[tmp1,tmp2,tmp3]; - , - Out=a_1*b_2-a_2*b_1; - ); - Out; -); - -Ptstart(Fig):=( -//help:Ptstart("gr1"); - regional(tmp); - if(isstring(Fig),tmp=parse(Fig),tmp=Fig); // 16.01.21 - tmp_1; -); - -Ptend(Fig):=( -//help:Ptend("gr1"); - regional(tmp); - if(isstring(Fig),tmp=parse(Fig),tmp=Fig); - tmp_(length(tmp)); // 15.04.12 -); - -Numptcrv(Fig):=( -//help:Numptcrv("gr1"); - regional(tmp); - if(isstring(Fig),tmp=parse(Fig),tmp=Fig); // 15.12.23 - length(tmp); -); - -Ptcrv(Num,Fig):=( -//help:Ptcrv(10,"gr1"); - regional(tmp); - if(isstring(Fig),tmp=parse(Fig),tmp=Fig); - tmp_Num; -); - -Invert(Fig):=( -//help:Invert("gr1"); - regional(tmp); - if(isstring(Fig),tmp=parse(Fig),tmp=Fig); // 16.01.27 - reverse(tmp); -); -Invert(nm,Fig):=Invert(nm,Fig,["nodisp"]); // from 16.01.27 -Invert(nm,Fig,options):=( -//help:Invert("1","gr1"); - regional(name,tmp); - name="-inv"+nm; - tmp=Invert(Fig); - Listplot(name,tmp,options); -);// until 16.01.27 - -Paramoncrv(pP,Gdata):=( - regional(Tmp,PtL); -// Eps=10^(-8); - if(isstring(Gdata),PtL=parse(Gdata),PtL=Gdata); - Tmp=Nearestpt(pP,PtL); - Tmp_2; -); - -ParamonCurve(pP,nN,plist):=( -//help:ParamonCurve(A,10,"gr1"); - regional(PtL,Out,Pa,Pb,vV,vW,sS); - if(isstring(plist),PtL=parse(plist),PtL=plist); - PtL=apply(PtL,LLcrd(#));//16.10.16 - if(nN==length(PtL), - Out=nN; - , - Pa=PtL_nN; - Pb=PtL_(nN+1); - vV=Pb-Pa; - vW=pP-Pa; - sS=vV*vW/|vV|^2; - sS=min([max([sS,0]),1]); - Out=nN+sS; - ); - Out; -); - -Pointoncrv(tT,PtL):=PointonCurve(tT,PtL); -PointonCurve(tTorg,Gdata):=( -//help:PointonCurve(20.5,"gr1"); - regional(tT,Out,Eps,nN,sS,Pa,Pb,PtL); - if(isstring(Gdata),PtL=parse(Gdata),PtL=Gdata); - if(length(PtL)==1,PtL=PtL_1); - tT=max([tTorg,1]); //18.01.04 - tT=min([tT,length(PtL)]); //18.01.04 - Eps=10^(-5); //18.01.04 - nN=floor(tT+Eps); - sS=max([tT-nN,0]); - if(nN==length(PtL), - Out=PtL_nN; - , - Pa=PtL_nN; - Pb=PtL_(nN+1); - Out=(1-sS)*Pa+sS*Pb; - ); - Out; -); - -Koutenseg(pA,pB,pC,pD):=Koutenseg(pA,pB,pC,pD,[]); -Koutenseg(pA,pB,pC,pD,options):=( - regional(Eps0,Eps,Eps2,pV,Sv2,Out,pP,pQ,Flg,p1,p2,q1,q2, - em1,eM1,em2,eM2,rT,Tmp1,Tmp2); - Eps0=10^(-4); - pV=pB-pA; - Sv2=|pV|; - pP=pC-pA; pQ=pD-pA; - Eps=10^(-3); - Eps2=0.2; - Tmp1=0; - forall(options, - if(Tmp1==0, - Eps=#; - Tmp1=1; - , - Eps2=#; - ); - ); - Flg=0; - if(Sv2<10^(-3), - Out=["inf","inf"]; - Flg=1; - ); - if(Flg==0, - Eps=min([Eps2,Eps/Sv2]); - p1=pP*pV/Sv2^2; - p2=[pP_2,-pP_1]*pV/Sv2^2; - q1=pQ*pV/Sv2^2; - q2=[pQ_2,-pQ_1]*pV/Sv2^2; - em1=-Eps; eM1=1+Eps; - em2=-Eps; eM2=Eps; - if(max([p1,q1])<em1 % min([p1,q1])>eM1, - Out=["inf","inf"]; - Flg=1; - ); - if(max([p2,q2])<em2 % min([p2,q2])>eM2, - Out=["inf","inf"]; - Flg=1; - ); - ); - if(Flg==0 & p2*q2<0, - rT=p1-(q1-p1)/(q2-p2)*p2; - if(rT>em1 & rT<eM1, - if(rT>-Eps0 & rT<1+Eps0, - Tmp1=pA+rT*pV; - Tmp2=min([max([rT,0]),1]); - Out=[Tmp1,Tmp2,0]; - , - Tmp1=pA+rT*pV; - Tmp2=min([max([rT,0]),1]); - Out=[Tmp1,Tmp2,1]; - ); - Flg=1; - ); - if(Flg==0 & (p1<em1 % p1>eM1 % p2<em2 % p2>eM2), - if(q1<em1 % q1>eM1 % q2<em2 % q2>eM2, - Out=["inf","inf"]; - Flg=1; - ); - if(Flg==0, - rT=min([max([p1,0]),1]); - Tmp1=pA+rT*pV; - Out=[Tmp1,rT,1]; - Flg=1; - ); - ); - ); - if(Flg==0 & (p1 > -Eps0 & p1 < 1 + Eps0 & p2 > -Eps0 & p2 < Eps0), - rT= p1; - Tmp1=pA+rT*pV; - Out= [Tmp1, rT, 0]; - Flg=1; - ); - if(Flg==0 & (q1 > -Eps0 & q1 < 1 + Eps0 & q2 > -Eps0 & q2 < Eps0), - rT= q1; - Tmp1=pA+rT*pV; - Out=[Tmp1,rT,0]; - Flg=1; - ); - if(Flg==0 & (p1<em1 % p1>eM1 % p2<em2 % p2>eM2), - if(q1<em1 % q1>eM1 % q2<em2 % q2>eM2, - Out=["inf","inf"]; - Flg=1; - ); - if(Flg==0, - rT=min([max([q1,0]),1]); - Tmp1=pA+rT*pV; - Out=[Tmp1,rT,1]; - Flg=1; - ); - ); - if(Flg==0 & (q1<em1 % q1>eM1% q2<em2 % q2>eM2), - rT=min([max([p1,0]),1]); - Tmp1=pA+rT*pV; - Out=[Tmp1,rT,1]; - Flg=1; - ); - if(Flg==0, - if(abs(p2)<abs(q2), - rT=min([max([p1,0]),1]); - , - rT=min([max([q1,0]),1]); - ); - Tmp1=pA+rT*pV; - Out=[Tmp1,rT,1]; - ); - Out; -); - -///////// Start of old Intersect //////////// - -IntersectcrvsPp(Gr1,Gr2):=IntersectcrvsPp(Gr1,Gr2,[]); -IntersectcrvsPp(Gr1,Gr2,options):=( -//help:IntersectcrvsPp("gr1","pa1"); -//help:IntersectcrvsPp(options=[Eps2(0.1),"Dif=0.05"]); - regional(Out,Eps,Eps2,Eps0,Flg,Data1,Data2, - Tmp1,Tmp2,Tmp3,Tmp,KL1,KL2,pA,pB,Ni,Nj, - pP,pQ,rT,Flg,eqL,realL,opstr,Dif); - Eps=10^(-4); - Eps2=0.1; - Dif=0.05; // 2015.05.31 - Flg=0; - Tmp1=Divoptions(options); // - eqL=Tmp1_5; - realL=Tmp1_6; - opstr=Tmp1_(length(Tmp1)); - forall(eqL, - if(substring(#,0,1)=="D", - Tmp1=indexof(#,"="); - Dif=parse(substring(#,Tmp1,length(#))); - ); - ); - Tmp1=length(realL); - if(Tmp1>0, - Eps=realL_1; - if(Tmp1>1, - Eps2=realL_2; - ); - ); - Flg=0; - if(isstring(Gr1),Data1=parse(Gr1),Data1=Gr1); - if(isstring(Gr2),Data2=parse(Gr2),Data2=Gr2); - if(MeasureDepth(Data1)==2,Data1=Data1_1); - if(MeasureDepth(Data2)==2,Data2=Data2_1); - Data1=apply(Data1,LLcrd(#)); - Data2=apply(Data2,LLcrd(#)); - if(length(Data1)==length(Data2), - Tmp1=Reverse(Data2); - Eps0=10^(-6); - Tmp2=0; - forall(1..(length(Data1)), - Tmp2=Tmp2+abs(Data1_#-Data2_#); - ); - Tmp3=0; - forall(1..(length(Data1)), - Tmp3=Tmp3+abs(Data1_#-Tmp1_#); - ); - if(Tmp2<Eps0 % Tmp3<Eps0, - Out=[]; - Flg=1; - ); - ); - if(Flg==0, - KL1=[]; - KL2=[]; - forall(1..(length(Data1)-1),Ni, - pA=Data1_Ni; - pB=Data1_(Ni+1); - forall(1..(length(Data2)-1), - pP=Data2_#; pQ=Data2_(#+1); - Tmp=Koutenseg(pA,pB,pP,pQ,[Eps,Eps2]); - if(Tmp!=["inf","inf"], - if(Tmp_3==0, - Tmp1=[Tmp_1,Tmp_2,Ni,#]; - KL1=concat(KL1,[Tmp1]); - , - Tmp2=[Tmp_1,Tmp_2,Ni,#]; - KL2=concat(KL2,[Tmp2]); - ); - ); - ); - ); - Out=[]; - if(length(KL1)>0, - Tmp=KL1_1; - pP=Tmp_1; - rT=Tmp_2; - Ni=Tmp_3; - Nj=Tmp_4; - Tmp=[pP,Ni+rT,Nj]; - Out=[Tmp]; - ); - forall(2..(length(KL1)),Ni, - Tmp=KL1_Ni; - pP=Tmp_1; - Tmp2=0; - Flg=0; - forall(1..(length(Out)),Nj, - if(Flg==0, - Tmp=Out_Nj; - if(|pP-Tmp_1|<Eps, - Tmp2=1; - Flg=1; - ); - ); - ); - if(Tmp2==0, - Tmp=KL1_Ni; - pP=Tmp_1; - rT=Tmp_2; - Tmp1=Tmp_3; - Tmp2=Tmp_4; - Tmp=[pP,Tmp1+rT,Tmp2]; - Out=concat(Out,[Tmp]); - ); - ); - forall(1..(length(KL2)),Ni, - Tmp=KL2_Ni; // 15.11.21 Usui - pP=Tmp_1; - Tmp2=0; - Flg=0; - forall(1..(length(Out)),Nj, - if(Flg==0, - Tmp=Out_Nj; - if(|pP-Tmp_1|<Eps, - Tmp2=1; - Flg=1; - ); - ); - ); - if(Tmp2==0, - Tmp=KL2_Ni; - rT=Tmp_2; - rT=min([max([rT,0]),1]); // 15.11.21 Usui - Tmp=[pP,Tmp_3+rT,Tmp_4]; - Out=concat(Out,[Tmp]); - ); - ); - ); - Tmp1=Out; // 15.04.06 from - Out=[]; - forall(Tmp1,Tmp2, - Tmp3=select(1..(length(Out)),//16.11.27, - |Out_#_1-Tmp2_1|<Dif & |Out_#_2-Tmp2_2|<=1& |Out_#_3-Tmp2_3|<=1); - //17.04.13 - if(length(Tmp3)==0, - Out=append(Out,Tmp2); - , - forall(Tmp3, //16.11.27 - Out_#_1=(Out_#_1+Tmp2_1)/2;//17.04.14 - ); - ); - ); // 15.04.06 until - Out; -); - -Intersectcrvs(Gr1,Gr2):=Intersectcrvs(Gr1,Gr2,[]); -//help:Intersectcrvs("gr1","pa1"); -Intersectcrvs(Gr1,Gr2,options):=( - regional(tmp,tmp1,tmp2); - tmp1=IntersectcrvsPp(Gr1,Gr2,options); - apply(tmp1,#_1); -); -///////// End of old Intersect //////////// - -/////////// Start of new Intersect ////////////// - -Intersectline(p1,v1,p2,v2):=( - regional(Eps,d,dt,ds,t,s,pt,out,tmp,tmp1,tmp2,tmp3); - Eps=10^(-5); - out=[]; - tmp=Dotprod(v1,v2); - tmp1=[tmp,|v1|^2]; - tmp2=[-|v2|^2,-tmp]; - tmp3=[Dotprod(p2-p1,v2),Dotprod(p2-p1,v1)]; - d=Crossprod(tmp1,tmp2); - tmp=abs(Crossprod(v1,v2)); - if(tmp>Eps, - dt=Crossprod(tmp3,tmp2); - ds=Crossprod(tmp1,tmp3); - t=dt/d; - s=ds/d; - pt=p1+v1*t; - out=[pt,t,s]; - , - tmp1=Crossprod(p2-p1,v1)/|v1|; //18.01.05 - out=[abs(tmp1)]; //18.01.05 - ); - out; -); - -Intersectseg(seg1,seg2):=Intersectseg(seg1,seg2,0.01); -Intersectseg(seg1org,seg2org,Eps1):=( - regional(Eps,seg1,seg2,p1,p2,q1,q2,t,s,pt,n,pts,out,dist, - tmp,tmp1,tmp2,tmp3); - Eps=10^(-4); - //Eps1=0.01; - seg1=seg1org; - seg2=seg2org; - if(isstring(seg1),seg1=parse(seg1)); - if(isstring(seg2),seg2=parse(seg2)); - out=[]; - p1=seg1_1; q1=seg1_2; - p2=seg2_1; q2=seg2_2; - if((|q1-p1|<Eps)%(|q2-p2|<Eps), - out=[-1]; - , - tmp=Intersectline(p1,q1-p1,p2,q2-p2); - if(islist(tmp_1), - pt=tmp_1; t=tmp_2; s=tmp_3; - if((t*(t-1)<Eps)&(s*(s-1)<Eps), - out=[0,pt,t,s]; - , - t=min([max([t,0]),1]); - s=min([max([s,0]),1]); - tmp3=[|p1-p2|,|p1-q2|,|q1-p2|,|q1-q2|]; //18.01.30from - tmp1=[Op(2,q2-p2),-Op(1,q2-p2)]; - tmp=Intersectline(p1,tmp1,p2,q2-p2); - if(islist(tmp_1), - if(tmp_3*(tmp_3-1)<Eps, - tmp3=append(tmp3,|tmp_1-p1|); - ); - ); - tmp=Intersectline(q1,tmp1,p2,q2-p2); - if(islist(tmp_1), - if(tmp_3*(tmp_3-1)<Eps, - tmp3=append(tmp3,|tmp_1-q1|); - ); - ); - tmp1=[Op(2,q1-p1),-Op(1,q1-p1)]; - tmp=Intersectline(p2,tmp1,p1,q1-p1); - if(islist(tmp_1), - if(tmp_3*(tmp_3-1)<Eps, - tmp3=append(tmp3,|tmp_1-p2|); - ); - ); - tmp=Intersectline(q2,tmp1,p1,q1-p1); - if(islist(tmp_1), - if(tmp_3*(tmp_3-1)<Eps, - tmp3=append(tmp3,|tmp_1-q2|); - ); - ); - out=[min(tmp3),pt,t,s]; //18.01.30until - ); - , - dist=tmp_1; - tmp1=q1-p1; - n=[tmp1_2,-tmp1_1]/|tmp1|; - pts=[]; - tmp=Intersectline(p1,n,p2,q2-p2); - if(tmp_3*(tmp_3-1)<Eps, - tmp1=(1-tmp_3)*p2+tmp_3*q2; - pts=append(pts,[tmp1,0,tmp_3]); - ); - tmp=Intersectline(q1,n,p2,q2-p2); - if(tmp_3*(tmp_3-1)<Eps, - tmp1=(1-tmp_3)*p2+tmp_3*q2; - pts=append(pts,[tmp1,1,tmp_3]); - ); - tmp=Intersectline(p2,n,p1,q1-p1); - if(tmp_3*(tmp_3-1)<Eps, - tmp1=(1-tmp_3)*p1+tmp_3*q1; - pts=append(pts,[tmp1,tmp_3,0]); - ); - tmp=Intersectline(q2,n,p1,q1-p1); - if(tmp_3*(tmp_3-1)<Eps, - tmp1=(1-tmp_3)*p1+tmp_3*q1; - pts=append(pts,[tmp1,tmp_3,2]); - ); - if(length(pts)==0, - tmp1=min([|p2-p1|,|q2-p1|,|p2-q1|,|q2-q1|]); - out=[tmp1]; - , - if(dist>Eps1, - out=[dist]; - , - tmp=apply(pts,#_1_1); - tmp1=sum(tmp)/(length(pts)); - tmp=apply(pts,#_1_2); - tmp2=sum(tmp)/(length(pts)); - tmp3=[tmp1,tmp2]; - tmp=Nearestpt(tmp3,seg1); - tmp1=tmp_2; - tmp=Nearestpt(tmp3,seg2); - tmp2=tmp_2; - out=[dist,tmp3,tmp1,tmp2]; - ); - ); - ); - ); - out; -); - -Osplineseg(list):=Osplineseg(list,[]); -Osplineseg(ptlist,optionsorg):=( - regional(tmp,tmp1,tmp2,list,ptL,ctrL,Eps,Eps0, - p0,p1,p2,p3,pQ,pR,cc,p01,p02,p11,p12,p21,p22,p31,p32,out); - Eps=10^(-2); - Eps0=10^(-6); - if(isstring(ptlist),list=parse(ptlist),list=ptlist); - p0=list_1; p1=list_2; p2=list_3; p3=list_4; - tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2); - cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp; - pQ=p1+cc*(p2-p0); // 15.09.21 // 16.08.16 - pR=p2+cc*(p1-p3); // 16.08.16 - ctrL=[pQ,pR]; - options=optionorg; - options=concat(options,["Num=20","nodata"]); - out=Bezier("",[p1,p2],ctrL,options); - out; -); - -Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2):=( - Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,10*Eps2); -); -Intersectpartseg(crv1org,crv2org,ii,jj,Eps1,Eps2,Dist):=( - regional(crv1,crv2,Eps,dst,kk,ll,seg1,seg2,snang, - p0,p1,p2,p3,os1,os2,out,tmp,tmp1,tmp2,flg); - crv1=crv1org; crv2=crv2org; - if(isstring(crv1),crv1=parse(crv1)); - if(isstring(crv2),crv2=parse(crv2)); - Eps=10^(-4); -// Eps1=0.01; -// Eps2=0.1; -// Dist=10*Eps2; - out=[]; - seg1=[crv1_ii,crv1_(ii+1)]; - seg2=[crv2_jj,crv2_(jj+1)]; - tmp1=seg1_2-seg1_1; - tmp2=seg2_2-seg2_1; - snang=abs(Crossprod(tmp1,tmp2))/(norm(tmp1)*norm(tmp2)); - tmp=Intersectseg(seg1,seg2,Eps1); - dst=tmp_1; - if(dst<Eps, - out=[tmp_2,ii+tmp_3,jj+tmp_4,dst,snang]; - , - if(dst<Eps2, - if((length(crv1)==2)%(|seg1_2-seg1_1|>Dist-Eps), - os1=seg1; - , - p1=seg1_1; p2=seg1_2; - if(ii==1, - p3=crv1_3; - tmp=p2-p1; - tmp=(p1+p2)/2+[tmp_2,-tmp_1]; - p0=Reflectpoint(p3,[(p1+p2)/2,tmp]); - , - if(ii==length(crv1)-1, - p0=crv1_(ii-1); - tmp=p2-p1; - tmp=(p1+p2)/2+[tmp_2,-tmp_1]; - p3=Reflectpoint(p0,[(p1+p2)/2,tmp]); - , - p0=crv1_(ii-1); p3=crv1_(ii+2); - ); - ); - os1=Osplineseg([p0,p1,p2,p3]); - ); - if((length(crv2)==2)%(|seg2_2-seg2_1|>Dist-Eps), //18.01.05 - os2=seg2; - , - p1=seg2_1; p2=seg2_2; - if(jj==1, - p3=crv2_3; - tmp=p2-p1; - tmp=(p1+p2)/2+[tmp_2,-tmp_1]; - p0=Reflectpoint(p3,[(p1+p2)/2,tmp]); - , - if(jj==length(crv2)-1, - p0=crv2_(jj-1); - tmp=p2-p1; - tmp=(p1+p2)/2+[tmp_2,-tmp_1]; - p3=Reflectpoint(p0,[(p1+p2)/2,tmp]); - , - p0=crv2_(jj-1); p3=crv2_(jj+2); - ); - ); - os2=Osplineseg([p0,p1,p2,p3]); - ); - tmp2=[]; - forall(1..(length(os1)-1),kk, - forall(1..(length(os2)-1),ll, - seg1=[os1_kk,os1_(kk+1)]; - seg2=[os2_ll,os2_(ll+1)]; - tmp=Intersectseg(seg1,seg2,Eps1); - if((tmp_1<Eps1)&(length(tmp)>1), //18.02.06 - if(tmp_1<dst+Eps, - dst=tmp_1; - tmp2=select(tmp2,#_1<dst); - tmp2=append(tmp2,[dst,tmp_2]); - ); - ); - ); - ); - if(length(tmp2)>0, - tmp=apply(tmp2,#_2_1); - tmp1=[sum(tmp)/length(tmp2)]; - tmp=apply(tmp2,#_2_2); - tmp1=append(tmp1,sum(tmp)/length(tmp2)); - out=[tmp1]; - p1=crv1_ii; p2=crv1_(ii+1); - tmp=[Op(2,p2-p1),-Op(1,p2-p1)]; - tmp=Intersectline(out_1,tmp,p1,p2-p1); - tmp=min([max([tmp_3,0]),1]); - out=[tmp1,ii+tmp]; - p1=crv2_jj; p2=crv2_(jj+1); - tmp=[Op(2,p2-p1),-Op(1,p2-p1)]; - tmp=Intersectline(out_1,tmp,p1,p2-p1); - tmp=min([max([tmp_3,0]),1]); - out=concat(out,[jj+tmp,dst,snang]); - ); - ); - ); - out; -); - -if(1==0, - -Collectnear(ptdL,Eps2):=( - regional(Eps,gL,rL,numL,ii,jj,flg,tmp,tmp1); - Eps=10^(-4); - gL=[ptdL_1]; - rL=ptdL_(2..(length(ptdL))); - flg=0; - forall(1..(length(ptdL)-1),ii, - if(flg==0, - numL=[]; - forall(1..(length(rL)),jj, - tmp1=100; - forall(gL, - tmp=|#_1-rL_jj_1|; - if(tmp<tmp1,tmp1=tmp); - ); - if(tmp1<Eps2,numL=append(numL,jj)); - ); - if(length(numL)==0, - flg=1; - , - gL=concat(gL,rL_(numL)); - rL=remove(rL,rL_(numL)); - ); - ); - ); - [gL,rL]; -); - -); - -Collectsameseg(ptdL):=( - regional(Eps,gL,rL,numL,ii,jj,flg,tmp,tmp1,tmp2,tmp1md, - dst,kk,s1,e1,s2,e2); - Eps00=10^(-8); - if(length(ptdL)==0, - gL=[];rL=[]; - , - tmp1md=[ptdL_1]; - rL=ptdL_(2..(length(ptdL))); - tmp1=tmp1md_1; - kk=floor(tmp1_2); - if(tmp1_2<kk+Eps00, - s1=kk-1-Eps00; e1=s1+2+2*Eps00; - , - s1=kk-Eps00; e1=s1+1+2*Eps00; - ); - kk=floor(tmp1_3); - if(tmp1_3<kk+Eps00, - s2=kk-1-Eps00; e2=s2+2+2*Eps00; - , - s2=kk-Eps00; e2=s2+1+2*Eps00; - ); - numL=[]; - forall(1..(length(rL)),ii, - tmp=rL_ii; - tmp1=tmp_2;tmp2=tmp_3; - if((tmp1>s1)&(tmp1<e1)&(tmp2>s2)&(tmp2<e2), - tmp1md=append(tmp1md,tmp); - numL=append(numL,ii); - ); - ); - gL=[]; - tmp=apply(tmp1md,#_4); - dst=min(tmp); - forall(tmp1md, - if(#_4<dst+Eps00, - gL=append(gL,#); - ); - ); - rL=remove(rL,rL_(numL)); - ); - [gL,rL]; -); - -IntersectcurvesPp(crv1org,crv2org):=IntersectcurvesPp(crv1org,crv2org,[]); -IntersectcurvesPp(crv1org,crv2org,options):=( -//help:IntersectcurvesPp(crv1,crv2); -//help:IntersectcurvesPp(options=[Eps1(0.01),Eps2(0.1),Dist(2)]) - regional(Eps,Eps1,Eps2,Dist,crv1,crv2,ii,jj,seg1,seg2,self,loopL,out, - flg,tmp,tmp1,tmp2); - Eps=10^(-4); - Eps1=0.01; - Eps2=0.1; - Dist=10*Eps2; - if(length(options)>0, - Eps1=options_1; - if(length(options)>1, - Eps2=options_2; - Dist=10*Eps2; - if(length(options)>2, - Dist=options_3; - ); - ); - ); - if(isstring(crv1org),tmp1=parse(crv1org),tmp1=crv1org);//18.01.05from - if(isstring(crv2org),tmp2=parse(crv2org),tmp2=crv2org); - tmp1=apply(tmp1,LLcrd(#)); - tmp2=apply(tmp2,LLcrd(#)); - crv1=[tmp1_1]; - forall(tmp1, - tmp=crv1_(length(crv1)); - if(|tmp-#|>Eps, - crv1=append(crv1,#); - ); - ); - crv2=[tmp2_1]; - forall(tmp2, - tmp=crv2_(length(crv2)); - if(|tmp-#|>Eps, - crv2=append(crv2,#); - ); - );//18.01.05until - if(crv1==crv2, - self=1; - , - self=0; - ); - out=[]; - forall(1..(length(crv1)-1),ii, - if(self==0, - loopL=1..(length(crv2)-1); - , - loopL=(ii+2)..(length(crv2)-1); - ); - forall(loopL,jj, - tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist); - if(length(tmp)>0, - if(length(out)==0, - out=[tmp]; - , - tmp1=out_(length(out)); - if(|tmp1_1-tmp_1|>Eps1, - out=append(out,tmp); - ); - ); - if(self==1, - tmp=[tmp_1,tmp_3,tmp_2,tmp_4,tmp_5]; - out=append(out,tmp); - ); - ); - ); - ); - tmp2=out; - out=[]; - tmp1=tmp2; - flg=0; - forall(1..(length(tmp2)), - if(flg==0, - tmp=Collectsameseg(tmp1); - out=append(out,tmp_1); - if(length(tmp_2)==0, - flg=1; - , - tmp1=tmp_2; - ); - ); - ); - forall(1..(length(out)),ii, - tmp1=out_ii; - if(length(tmp1)==1, - out_ii=tmp1_1; - , - tmp=apply(tmp1,#_4); - dst=min(tmp); - tmp1=select(tmp1,#_4<dst+Eps); - tmp=apply(tmp1,#_1); - tmp=sum(tmp)/length(tmp); - tmp2=[tmp]; - tmp=Nearestpt(tmp2_1,crv1org); - tmp2=append(tmp2,tmp_2); - tmp=Nearestpt(tmp2_1,crv2org); - tmp2=append(tmp2,tmp_2); - tmp2=concat(tmp2,[dst,tmp1_1_5]); - out_ii=tmp2; - ); - ); - out; -); - -Intersectcurves(crv1org,crv2org):=Intersectcurves(crv1org,crv2org,[]); -Intersectcurves(crv1org,crv2org,options):=( -//help:Intersectcurves(crv1,crv2); -//help:Intersectcurves(options=[Eps1(0.1),Dist(2)]) - regional(tmp); - tmp=IntersectcurvesPp(crv1org,crv2org,options); - tmp=apply(tmp,#_1); -); - -///////////End of new Intersect ////////////// - -NearestptcrvPhy(point,PL):=( - regional(tmp,pP,plist); - pP=Pcrd(point); - if(isstring(PL),plist=parse(PL),plist=PL); - if(MeasureDepth(plist)==2,plist=plist_1); - plist=apply(plist,#); // 14.12.18 - tmp=Nearestpt(pP,plist); - tmp=tmp_1; - [tmp_1/SCALEX,tmp_2/SCALEY]; -); - -Nearestptcrv(point,plist):=( -//help:Nearestptcrv(A,"gr1"); - regional(tmp); - tmp=Nearestpt(point,plist); - tmp_1; -); - -Nearestpt(point,PL2):=( - regional(PL1,PL,Ans,Flg,Eps,pA,Pm,Im,Sm,Nn,Ni, - a1,b1,a2,b2,v1,v2,x1,x2,Tmp,rT,pP,sS,Lm,Pm,Sm,Flg); -//help:Nearestpt("gr1","gr2"); - if(isstring(point),PL1=parse(point),PL1=point); - if(MeasureDepth(PL1)==2,PL1=PL1_1); - if(!islist(PL1_1), - PL1=[PL1]; - Flg=0; - , - Flg=1; - ); - if(isstring(PL2),PL=parse(PL2),PL=PL2); - if(MeasureDepth(PL)==2,PL=PL_1); - Eps=10^(-6); - Ans=[PL1_1,1,PL_1,1,|PL1_1-PL_1|]; - forall(1..(length(PL1)),Nn, // 16.05.04 - pA=PL1_Nn; - Pm=PL_1; - Im=1; - Sm=|Pm-pA|; - forall(1..(length(PL)-1),Ni, - a1=PL_Ni_1; a2=PL_Ni_2; - b1=PL_(Ni+1)_1; b2=PL_(Ni+1)_2; - v1=b1-a1; v2=b2-a2; - x1=pA_1; x2=pA_2; - Tmp=v2^2+v1^2; - if(abs(Tmp)>Eps, - rT=(-a2*v2-v1*a1+v1*x1+x2*v2)/Tmp; - if(rT<-Eps, - pP=[a1,a2]; - , - if(rT>1+Eps, - pP=[b1,b2]; - , - pP=[a1+rT*v1,a2+rT*v2]; - ); - ); - sS=|pP-pA|; - if(sS<Sm-Eps, - Tmp=ParamonCurve(pP,Ni,PL); - Pm=pP; Lm=Tmp; Sm=sS; - ); - ); - if(Sm<Ans_5, // 16.05.03from - Ans=[pA,Nn,Pm,Lm,Sm]; - ); - ); // 16.05.03until - ); - if(Flg==0, - Ans=Ans_(3..5); - ); - Ans; -); - -Derivative(fun,var,value):=Derivative(fun,var,value,[]); -Derivative(fun,var,value,options):=( -//help:Derivative("x^3","x",2); - regional(eqL,method,eps,str,x1,x2,y1,y2,tmp,tmp1,tmp2); - method="N"; - tmp=Divoptions(options); - eqL=tmp_5; - forall(eqL, - tmp=substring(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,tmp+1); - if(tmp1=="M", - method=Toupper(tmp2); - ); - ); - if(method=="D", - str="d("; - str=str+replace(fun,var,"#")+","; - str=str+value+")"; - tmp=Pcrd([1,parse(str)]); // 14.11.08 - tmp_2; - ); - if(method=="N", - eps=10^(-6); - x1=max(XMIN,value-eps); - x2=min(XMAX,value+eps); - tmp=Assign(fun,[var,"("+format(x1,6)+")"]);//180408 - y1=parse(tmp); - tmp=Assign(fun,[var,"("+format(x2,6)+")"]);//180408 - y2=parse(tmp); - (y2-y1)/(x2-x1); - ); -); - -Integrate(pltdata,range):=Integrate(pltdata,range,[]); -Intergrate(Arg1,Arg2,Arg3):=( - regional(pltdata,range,options,fnstr,vartr); - if(islist(Arg2), - pltdata=Arg1; - range=Arg2; - options=Arg3; - Integrate(pltdata,range,options); - , - fnstr=Arg1; - vastr=Arg2; - range=Arg3; - Integrate(fnstr,vastr,range,[]); - ); -); - -Integrate(pltdata,range,options):=( -//help:Integrate("gr1",[1,3]); -//help:Integrate(options=["Rule=o"]); - regional(tmp,tmp1,eqL,Rule,pdata,Sm,ptP,ptQ,list,va1,va2); - tmp=Divoptions(options); - eqL=tmp_5; - Rule="o"; - forall(eqL, - if(Toupper(substring(#,0,1))=="R", - tmp=indexof(#,"="); - Rule=substring(#,tmp,tmp+1); - ); - ); - if(Rule=="o", - Sm= IntegrateO(pltdata,range); - , - if(isstring(pltdata),pdata=parse(pltdata),pdata=pltdata); - if(MeasureDepth(pdata)==2,pdata=pdata_1); - va1=MeetCurve(pdata,range_1,0); - va2=MeetCurve(pdata,range_2,0); - list=select(pdata,(#_1>range_1 & #_1<range_2)); - list=apply(list,LLcrd(#)); // 15.09.14 - list=concat([va1],list); - list=concat(list,[va2]); - Sm=0; - forall(1..(length(list)-1), - ptP=list_#; // 15.09.14 - ptQ=list_(#+1); - Sm=Sm+(ptP_2+ptQ_2)*(ptQ_1-ptP_1)/2; - ); - Sm; - ); -); - -Integrate(fnstr,vastr,range,options):=( -//help:Integrate("sin(x)","x",[0,pi],["Num=100","Rule=s"]); - regional(tmp,tmp1,Sm,Lx,Rx,va1,va2,Num,Waysx,ex,dx,xn,yn,x0,x1,x2,y0,y1,y2); - Num=100; - Way="t"; - forall(options, - if(indexof(#,"=")>0, - if(indexof(#,"N=")>0, - Num=parse(substring(#,indexof(#,"="),length(#))); - ); - if(indexof(#,"Num=")>0, - Num=parse(substring(#,indexof(#,"="),length(#))); - ); - if(Toupper(substring(#,0,1))=="R", - tmp=indexof(#,"="); - Way=substring(#,tmp,tmp+1); - ); - ); - ); - Sm=0; - if(Way=="t", - forall(1..Num, - Lx=range_1+(range_2-range_1)*(#-1)/Num; - Rx=range_1+(range_2-range_1)*#/Num; - va1=parse(replace(fnstr,vastr,textformat(Lx,5))); - va2=parse(replace(fnstr,vastr,textformat(Rx,5))); - Sm=Sm+(va1+va2)*(Rx-Lx)/2; - ); - , - sx=range_1; - ex=range_2; - dx=(ex-sx)/Num; - xn=apply(0..Num,sx+#*dx); - yn=apply(xn,parse(replace(fnstr,vastr,textformat(#,5)))); - dx=dx/2; - repeat(Num,s, - x0=xn_s; - x1=(xn_s+xn_(s+1))/2; - x2=xn_(s+1); - y0=yn_s; - y1=parse(replace(fnstr,vastr,textformat(x1,5))); - y2=yn_(s+1); - Sm=Sm+dx*(y0+4*y1+y2)/3; - ); - ); - Sm; -); - -IntegrateO(p0org,p1org,p2org,p3org):=( - regional(p0,p1,p2,p3,pQ,pR,cc,p01,p02, - p11,p12,p21,p22,p31,p32, tmp); - if(ispoint(p0org),p0=p0org.xy,p0=p0org); // 16.03.10 - if(ispoint(p1org),p1=p1org.xy,p1=p1org); // 16.03.16 - if(ispoint(p2org),p2=p2org.xy,p2=p2org); - if(ispoint(p3org),p3=p3org.xy,p3=p3org); - tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2); - cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp; - pQ=p1+cc*(p2-p0); - pR=p2+cc*(p1-p3); - p01=p1_1; p02=p1_2; - p31=p2_1; p32=p2_2; - p11=pQ_1; p12=pQ_2; - p21=pR_1; p22=pR_2; - tmp=-6*p12*p01+3*p12*p21+3*p12*p31+6*p02*p11- - 10*p02*p01+3*p02*p21+p02*p31-3*p22*p11- - 3*p22*p01+6*p22*p31-3*p32*p11-p32*p01- - 6*p32*p21+10*p32*p31; - tmp=tmp/20; -); -IntegrateO(pltdata,rangeorg):=( -//help:IntegrateO("gr1",[0,2]); - regional(tmp,tmp1,tmp2,pdata,va1,va2,list,Bzk,Bzc,range,pmflg, - Sm,p0,p1,p2,p3,pQ,pR,cc,p01,p02,p11,p12,p21,p22,p31,p32); - if(isstring(pltdata), - pdata=parse(pltdata); - , - pdata=pltdata; - ); - if(MeasureDepth(pdata)==2,pdata=pdata_1); - range=rangeorg; - pmflg=1; - if(range_2<range_1, - range=reverse(range); - pmflg=-1; - ); - va1=MeetCurve(pdata,range_1,0); - va2=MeetCurve(pdata,range_2,0); - list=select(pdata,(#_1>range_1 & #_1<range_2)); - if(length(list)>0, // 16.09.25 - if(list_1_1>list_(length(list))_1, //16.11.03 - list=reverse(list); -// pmflg=pmflg*(-1); - ); - ); - list=apply(list,LLcrd(#)); - list=concat([va1],list); - list=concat(list,[va2]); - Sm=0; - forall(1..(length(list)-1), - p1=list_#; - p2=list_(#+1); - if(#==1 % #==length(list)-1, - tmp1=(p1_2+p2_2)*(p2_1-p1_1)/2; - Sm=Sm+tmp1; - , - p0=list_(#-1); - p3=list_(#+2); - tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2); - cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp; - pQ=p1+cc*(p2-p0); - pR=p2+cc*(p1-p3); - p01=p1_1; p02=p1_2; - p31=p2_1; p32=p2_2; - p11=pQ_1; p12=pQ_2; - p21=pR_1; p22=pR_2; - tmp1=-6*p12*p01+3*p12*p21+3*p12*p31+6*p02*p11- - 10*p02*p01+3*p02*p21+p02*p31-3*p22*p11- - 3*p22*p01+6*p22*p31-3*p32*p11-p32*p01- - 6*p32*p21+10*p32*p31; - tmp1=tmp1/20; - Sm=Sm+tmp1; - ); - ); - if(pmflg==-1, - Sm=-Sm; - ); - Sm; -); - -Findarea(pdstr):=( -//help:Findarea("sgABCA"); - regional(pd,p1,p2,s,tmp); - if(isstring(pdstr),pd=parse(pdstr),pd=pdstr); - s=0; - forall(1..(length(pd)-1), - p1=Lcrd(pd_#); - p2=Lcrd(pd_(#+1)); - tmp=(p1_2+p2_2)*(p2_1-p1_1)/2; - s=s+tmp; - ); - if(s<0,s=-s); - s; -); - -Findarea(pdstr):=( // 15.11.27 -//help:Findarea("cr1"); - regional(pd,p0,p1,p2,p3,s,tmp); - if(isstring(pdstr),pd=parse(pdstr),pd=pdstr); - s=0; - forall(1..(length(pd)-1), - p1=pd_#; - p2=pd_(#+1); - if(#==1,p0=pd_(length(pd)-1),p0=pd_(#-1)); - if(#==length(pd)-1,p3=pd_2,p3=pd_(#+2)); - tmp=IntegrateO(p0,p1,p2,p3); - s=s+tmp; - ); - if(s<0,s=-s); - s; -); - -Findlength(pdstr):=( -//help:Findlength("gr1"); - regional(pd,p1,p2,s,tmp); - if(isstring(pdstr),pd=parse(pdstr),pd=pdstr); - s=0; - forall(1..(length(pd)-1), - p1=Lcrd(pd_#); - p2=Lcrd(pd_(#+1)); - tmp=|p2-p1|; - s=s+tmp; - ); - s; -); - -Inversefun(fnstr,rngstr,value):=( - regional(tmp,varstr,range,x1,x2,x3,va1,va2); - tmp=indexof(rngstr,"="); - varstr=substring(rngstr,0,tmp-1); - range=parse(substring(rngstr,tmp,length(rngstr))); - x1=range_1; x2=range_2; - repeat(15, - x3=(x1+x2)/2; - va1=parse(replace(fnstr,varstr,textformat(x1,5))); - va2=parse(replace(fnstr,varstr,textformat(x3,5))); - if((va1>value & va2>value) % (va1<value & va2<value), - x1=x3; - , - x2=x3; - ); - ); - va1=parse(replace(fnstr,varstr,textformat(x1,5)))-value; - va2=parse(replace(fnstr,varstr,textformat(x2,5)))-value; - if(x1==range_1 % x2==range_2, - println("not found in ("+textformat(range_1,5) - +","+textformat(range_2,5)+")"); - ); - if(abs(va1)<=abs(va2),x1,x2); -); - -Com0th(String):=( - regional(str); - str=replace(String,LFmark,""); - COM0thlist=append(COM0thlist,str); -); - -Com1st(String):=( - regional(str); - str=replace(String,LFmark,""); - GLIST=append(GLIST,str); // 15.05.27 -// COM1stlist=append(COM1stlist,str); -); - -Com2nd(String):=( -// help:Com2nd(""); - regional(str); - str=replace(String,LFmark,""); - COM2ndlist=append(COM2ndlist,str); -); - -Com2ndpre(String):=( - regional(str); - str=replace(String,LFmark,""); - COM2ndlist=prepend(str,COM2ndlist); -); - -Texcom(strorg):=( //17.09.22 -//help:Texcom("\color[cmyk]{0,0,0,0.5}"); - regional(str); - str=replace(strorg,"\","\\"); - str=replace(str,"\\\\","\\"); - str="Texcom("+Dq+str+Dq+")"; - Com2nd(str); -); - -Ketcindylogo():=( -//help:Ketcindylogo(); - Com2nd("Texcom("+Dq+"\def\ketcindy{{K\kern-.20em - \lower.5ex\hbox{E}\kern-.125em{TCindy}}}"+Dq+")"); -); - -Drwline():=Drwline(textformat(GrL,5)); -Drwline(gstr):=( - Com2nd("Drwline("+gstr+")"); -); - -Dashline(gstr):=( - Com2nd("Dashline("+gstr+")"); -); - -Invdashline(gstr):=( - Com2nd("Invdashline("+gstr+")"); -); - -Dottedline(gstr):=( - Com2nd("Dottedline("+gstr+")"); -); - -SetEnglish():=( -//help:SetEnglish(); - Com0th("setlanguage('en')"); -); - -Drawlinetype(name,type):=( -//help:Drawlinetype("gr1","da,1"); - regional(Dop,tmp,tmp1,tmp2); - Dop=""; - tmp1=indexof(type,","); - if(tmp1>0, - Dop=","+substring(type,tmp1,length(type)); - ); - tmp1=Toupper(substring(type,0,3)); - if(tmp1=="DR", - Drwline(name+Dop); - ); - if(tmp1=="DA", - Dashline(name+Dop); - ); - if(tmp1=="ID", - Invdashline(name+Dop); - ); - if(tmp1=="DO", - Dottedline(name+Dop); - ); -); - -Setunitlen():=( - println(ULEN); -); -Setunitlen(UI):=( - regional(Dx,Dy,Sym,SL,OL,Is,VL,Ucode,ii,cha, - str,Unit,Valu,flg,tmp); - Dx=XMAX-XMIN; - Dy=YMAX-YMIN; - Sym=".0123456789 +-*/"; - SL=Sym; - OL="+-*/"; - if(length(UI)>0, - ULEN=UI; - GLIST=append(GLIST,"Setunitlen("+Dq+string+Dq+")"); - ); - Is=1; - VL=""; - Ucode=ULEN; - flg=0; - forall(1..(length(Ucode)),ii, - if(flg==0, - cha=substring(Ucode,ii-1,ii); - if(indexof(SL,cha)>0, - if(indexof(OL,cha)>0, - tmp=substring(Ucode,Is-1,ii); - str=VL+tmp+cha; - VL=str; - Is=ii+1; - ); - , - Unit=substring(Ucode,ii-1,ii+1); - str=substring(Ucode,Is-1,ii-1); - VL=VL+str; - flg=1; - ); - ); - ); - Valu=parse(VL); - str=format(Valu,6); - ULEN=str+Unit; - if(Unit=="cm",MilliIn=1000/2.54*Valu); - if(Unit=="mm",MilliIn=1000/2.54*Valu/10); - if(Unit=="in",MilliIn=1000*Valu); - if(Unit=="pt",MilliIn=1000/72.27*Valu); - if(Unit=="pc",MilliIn=000/6.022*Valu); - if(Unit=="bp",MilliIn=1000/72*Valu); - if(Unit=="dd2",MilliIn=1000/1238/1157/72.27*Valu); - if(Unit=="cc",MilliIn=1000/1238/1157/72.27*12*Valu); - if(Unit=="sp",MilliIn=1000/72.27/65536*Valu/10); - MARKLEN=MARKLENNow*1000/2.54/MilliIn; - MEMORI=MEMORINow*1000/2.54/MilliIn; -); - -Setmarklen(ratio):=( -//help:Setmarklen(0.2); - MARKLEN=ratio*0.2;//16.11.01 - Com2nd("Setmarklen("+textformat(ratio,5)+")"); -); - -Setorigin(point):=( -//help:Setorigin([1,2]); - Com2nd("Setorigin("+textformat(point,5)+")"); -); - -Fontsize(sizestr):=( -//help:Fontsize("s"); - Com2nd("Fontsize('"+sizestr+"')"); -); - -Setpen(width):=( -//help:Setpen(2); - PenThick=PenThickInit*width; // 16.04.09 - Com2nd("Setpen("+text(width)+")"); -); - -Lcrd(pt):=( - regional(tmp); - if(ispoint(pt), - tmp=[pt.x/SCALEX,pt.y/SCALEY]; - , - tmp=pt; - ); - tmp; -); - -Pcrd(pt):=( - regional(tmp); - if(ispoint(pt), - tmp=re(pt.xy); // 15.07.24 - , - tmp=[pt_1*SCALEX,pt_2*SCALEY]; - ); - tmp; -); - -LLcrd(pt):=( - regional(tmp); - if(ispoint(pt), - tmp=pt.xy - , - tmp=pt; - ); - tmp=[tmp_1/SCALEX,tmp_2/SCALEY]; - tmp; -); - -Doscaling(pltdata):=( - regional(Level,Out,gL,gr,tmp); - if(ispoint(pltdata) % isreal(pltdata_1), - gL=[[pltdata]]; - Level=0; - , - if(ispoint(pltdata_1) % isreal(pltdata_1_1), - gL=[pltdata]; - Level=1; - , - gL=pltdata; - Level=2; - ); - ); - Out=[]; - forall(gL,gr, - tmp=apply(gr,Lcrd(#)); - tmp=apply(tmp,LLcrd(#)); - Out=concat(Out,[tmp]); - ); - if(Level==0, - Out=Out_1_1; - ); - if(Level==1, - Out=Out_1; - ); - Out; -); - -Unscaling(pltdata):=( - regional(Level,Out,gL,gr,tmp); - if(ispoint(pltdata) % isreal(pltdata_1), - gL=[[pltdata]]; - Level=0; - , - if(ispoint(pltdata_1) % isreal(pltdata_1_1), - gL=[pltdata]; - Level=1; - , - gL=pltdata; - Level=2; - ); - ); - Out=[]; - forall(gL,gr, - tmp=apply(gr,Lcrd(#)); - tmp=apply(tmp,LLcrd(#)); - Out=concat(Out,[tmp]); - ); - if(Level==0, - Out=Out_1_1; - ); - if(Level==1, - Out=Out_1; - ); - Out; -); - -Setpt(n):=Ptsize(n); -//help:Setpt(5); -Ptsize(n):=( - println("Setpt("+text(n)+")"); - TenSize=TenSizeInit*n; - Com2nd("Setpt("+text(n)+")"); // 14.01.19 -); - -Definecolor(name,data):=( -//help:Definecolor("mycolor",[1,1,1,0]); - regional(type,tmp); - if(length(data)>3,type="cmyk",type="rgb"); - tmp=text(data); - tmp=substring(tmp,1,length(tmp)-1); - tmp="\definecolor{"+name+"}{"+type+"}{"+tmp+"}"; - Texcom(tmp); -); - -Setcolor(Par):=( -//help:Setcolor([1,0,0,1]); -//help:Setcolor([1,1,0]); - if(islist(Par), - if(length(Par)==3, - Setcolorrgb(Par); // 2015.04.28 -// KCOLOR=Par; - ); - if(length(Par)==4, - Setcolor(Par,[]); - ); - , - Setcolor(Par,[]); - ); -); - -Setcolor(colorname,options):=( -//help:Setcolor("greenyellow",0.3); - regional(tmp); - if(isstring(colorname), - tmp="Setcolor("+Dq+colorname+Dq; - if(length(options)>0, - tmp=tmp+","+text(options_1); - ); - Com2nd(tmp+")"); - ); - if(islist(colorname), - tmp=text(colorname); - tmp=substring(tmp,1,length(tmp)-1); - Texcom("\color[cmyk]{"+tmp+"}"); //17.09.22 - ); -); - -Setcolorrgb(colorlist):=( -// help:Setcolorrgb([0.5,0.3,0.4]); - regional(tmp); - tmp=text(colorlist); - tmp=substring(tmp,1,length(tmp)-1); - tmp="Texcom("+Dq+"\\color[rgb]{"+tmp+"}"+Dq+")"; //17.10.07 - Com2nd(tmp); -); - -ColorRgb2Cmyk(clr):=( -// help:ColorRgb([0.2,0.5,0.1]); - regional(clrnew,tmp,black); - tmp=apply(clr,1-#); - black=min(tmp); - tmp=apply(clr,(1-#-black)/(1-black)); - clrnew=append(tmp,black); - clrnew; -); - -ColorCmyk2Rgb(clr):=( -// help:ColorRgb([0.2,0.5,0.1,0.2]); - regional(clrnew,tmp,black); - black=clr_4; - tmp=apply(clr,1-min(1,#*(1-black)+black)); - clrnew=tmp_(1..3); - clrnew; -); - -Colorrgbhsv(rgb):=( - regional(varR,varG,varB,varMin,varMax,delMax,hh,ss,vv,delR,delG,delB); - varR = rgb_1; - varG = rgb_2; - varB = rgb_3; - varMin = min( [varR, varG, varB] ); - varMax = max( [varR, varG, varB] ); - delMax = varMax - varMin ; - vv = varMax; - if ( delMax == 0 , - hh = 0 ; - ss = 0 ; - , - ss = delMax / varMax; - delR = ( ( ( varMax - varR ) / 6 ) + ( delMax / 2 ) ) / delMax; - delG = ( ( ( varMax - varG ) / 6 ) + ( delMax / 2 ) ) / delMax; - delB = ( ( ( varMax - varB ) / 6 ) + ( delMax / 2 ) ) / delMax; - if( varR == varMax , - hh = delB - delG; - , - if ( varG == varMax, - hh = ( 1 / 3 ) + delR - delB; - , - if ( varB == varMax , - hh = ( 2 / 3 ) + delG - delR; - ); - ); - ); - if ( hh < 0 ,hh = hh+1); - if ( hh > 1 ,hh = hh-1); - ); - [hh*360,ss,vv]; -); - -Colorhsvrgb(sL):=( - regional(tmp,tmp1,tmp2,tmp3,hi,ff,dL); - tmp=[sL_1/60,sL_2,sL_3]; - hi=mod(floor(tmp_1),6); - ff=tmp_1-floor(tmp_1); - tmp2=tmp_3*[1-tmp_2,1-tmp_2*ff,1-tmp_2*(1-ff)]; - tmp2=append(tmp2,tmp_3); - if(hi==0,dL=tmp2_[4,3,1]); - if(hi==1,dL=tmp2_[2,4,1]); - if(hi==2,dL=tmp2_[1,4,3]); - if(hi==3,dL=tmp2_[1,2,4]); - if(hi==4,dL=tmp2_[3,1,4]); - if(hi==5,dL=tmp2_[4,1,2]); - dL; -); - -Colorrgbhsl(rgb):=( - regional(rr,gg,bb,mn,mx,delta,deltaR,deltaG,deltaB,hh,ss,ll); - rr = rgb_1 ; - gg = rgb_2 ; - bb = rgb_3 ; - mn = min([rr, gg, bb]); - mx = max([rr, gg, bb]); - delta = mx - mn; - ll = (mx + mn) / 2; - if (delta == 0, - hh=0; - ss=0; - , - if (ll < 0.5, - ss = delta/ (mx + mn); - , - ss = delta / (2 - mx - mn); - ); - deltaR = (((mx - rr) / 6) + (delta / 2)) / delta; - deltaG = (((mx - gg) / 6) + (delta / 2)) / delta; - deltaB = (((mx - bb) / 6) + (delta / 2)) / delta; - if (rr == mx, - hh = deltaB - deltaG; - , - if (gg == mx, - hh = (1 / 3) + deltaR - deltaB; - , - if (bb == mx, - hh = (2 / 3) + deltaG - deltaR; - ); - ); - ); - if ( hh < 0, hh = hh+1); - if ( hh > 1, hh = hh-1); - ); - [hh*360,ss,ll]; -); - -Colorhslrgb(hsl):=( - regional(hh,ss,ll,rr,gg,bb,var1,var2); - hh=hsl_1/360; - ss=hsl_2; - ll=hsl_3; - if ( ss == 0.0, - rr = ll ; - gg = ll ; - bb = ll ; - , - if ( ll < 0.5 , - var2 = ll * ( 1.0 + ss ); - , - var2 = ( ll + ss ) - ( ss * ll ); - ); - var1 = 2.0 * ll - var2; - rr = hue2rgb( var1, var2, hh + ( 1.0 / 3.0 ) ); - gg = hue2rgb( var1, var2, hh ); - bb = hue2rgb( var1, var2, hh - ( 1.0 / 3.0 ) ); - ); - [rr,gg,bb]; -); - -hue2rgb(vv1,vv2,vh):=( - regional(out); - if ( vh < 0.0 ,vh =vh+1); - if ( vh > 1.0 ,vh =vh-1); - if ( 6.0*vh < 1.0 , - out = vv1 + ( vv2 - vv1 ) * 6.0 * vh ; - , - if( 2.0*vh < 1.0 , - out = vv2; - , - if ( 3.0*vh < 2.0 , - out = vv1 + ( vv2 - vv1 ) * ( ( 2.0 / 3.0 ) - vh ) * 6.0 ; - , - out= vv1 ; - ); - ); - ); - out; -); - -Colorrgbhwb(sL):=( - regional(dl1,dl2,dl3); - dl1 = Colorrgbhsl(sL)_1;//Colorcode("rgb","hsl",sL)_1; - dl2 = min(sL); - dl3 = 1 - max(sL); - dL= [dl1, dl2 , dl3 ]; -); - -Colorhwbrgb(sLorg):=( - regional(sL,tmp,tmp1,tmp2,tmp3,ratio,ff,ii,vv,nn,dL,flg); - sL=sLorg; - sL=[sL_1/360,sL_2,sL_3]; - ratio = sL_2 + sL_3; - // sL_2 + sL_3 cant be > 1 - if (ratio > 1., - sL_2 =sL_2 / ratio; - sL_3 = sL_3 / ratio; - ); - ii = floor(6 * sL_1); - vv = 1 - sL_3; - ff = 6 * sL_1 - ii; - if(mod(ii,2)==1,ff = 1 - ff); - nn = sL_2 + ff * (vv - sL_2); // linear interpolation - tmp=[[vv,nn,sL_2],[nn,vv,sL_2],[sL_2,vv,nn], - [sL_2,nn,vv],[nn,sL_2,vv],[vv,sL_2,nn],[vv,nn,sL_2]]; - flg=0; - forall(0..6, - if(flg==0 & ii == # , - dL=tmp_(#+1); - flg=1; - ); - ); - dL; -); - -Colorhslhsv(sL):=( - regional(dl1,dl2,dl3,dL); - dl1=sL_1; - if(sL_3 == 0, - // no need to do calc on black - // also avoids divide by 0 error - dL= [0, 0, 0]; - , - sL_3 = sL_3 * 2; - if(sL_3 <= 1,sL_2 = sL_2 * sL_3,sL_2 = sL_2 * (2 - sL_3)); - dl3 = (sL_3 + sL_2) / 2; - dl2 = (2 * sL_2) / (sL_3 + sL_2); - dL = [dl1, dl2, dl3]; - ); - dL; -); - -Colorcode(src,dest,sL):=( -//help:Colorcode("rgb","cmyk",[1,0.5,0]); - regional(tmp,tmp1,tmp2,tmp3,mn,mx,delta,black,dL,flg); - regional(dl1,dl2,dl3); - if(src=="rgb" & dest=="hsv", dL=Colorrgbhsv(sL)); - if(src=="hsv" & dest=="rgb", dL=Colorhsvrgb(sL)); - if(src=="rgb" & dest=="hsl", dL=Colorrgbhsl(sL)); - if(src=="hsl" & dest=="rgb", dL=Colorhslrgb(sL)); - if(src=="rgb" & dest=="hwb", dL=Colorrgbhwb(sL)); - if(src=="hwb" & dest=="rgb", dL=Colorhwbrgb(sL)); - if(src=="hsl" & dest=="hsv", dL=Colorhslhsv(sL)); - if(src=="hsv" & dest=="hsl", - dl1 = sL_1; - dl3 = (2 - sL_2) * sL_3; - dl2 = sL_2 * sL_3; - if(dl3 <= 1,dl2 = dl2/dl3,dl2=dl2/(2 - dl3)); - dl3 =d l3/ 2; - dL = [dl1, dl2 , dl3 ]; - ); - - if(src=="rgb" & dest=="cmyk", - tmp=apply(sL,1-#); - black=min(tmp); - tmp=apply(sL,(1-#-black)/(1-black)); - dL=append(tmp,black); - ); - if(src=="cmyk" & dest=="rgb", - black=sL_4; - tmp=apply(sL,1-min(1,#*(1-black)+black)); - dL=tmp_(1..3); - ); - if(src=="hsv" & dest=="cmyk", - tmp=Colorcode("hsv","rgb",sL); - dL=Colorcode("rgb","cmyk",tmp); - ); - if(src=="cmyk" & dest=="hsv", - tmp=Colorcode("cmyk","rgb",sL); - dL=Colorcode("rgb","hsv",tmp); - ); - - if(src=="hsv" & dest=="hwb", - tmp = Colorcode("hsv","rgb",sL); - dL = Colorcode("rgb","hwb",tmp); - ); - if(src=="hwb" & dest=="hsv", - tmp = Colorcode("hwb","rgb",sL); - dL = Colorcode("rgb","hsv",tmp); - ); - if(src=="hsl" & dest=="hwb", - tmp = Colorcode("hsl","rgb",sL); - dL = Colorcode("rgb","hwb",tmp); - ); - if(src=="hwb" & dest=="hsl", - tmp = Colorcode("hwb","rgb",sL); - dL = Colorcode("rgb","hsl",tmp); - ); - if(src=="hsl" & dest=="cmyk", - tmp = Colorcode("hsl","rgb",sL); - dL = Colorcode("rgb","cmyk",tmp); - ); - if(src=="hwb" & dest=="cmyk", - tmp = Colorcode("hwb","rgb",sL); - dL = Colorcode("rgb","cmyk",tmp); - ); - if(src=="cmyk" & dest=="hsl", - tmp = Colorcode("cmyk","rgb",sL); - dL = Colorcode("rgb","hsl",tmp); - ); - if(src=="cmyk" & dest=="hwb", - tmp = Colorcode("cmyk","rgb",sL); - dL = Colorcode("rgb","hwb",tmp); - ); - if(src=="hsb" & dest=="rgb",dL=Colorcode("hsv","rgb",sL)); - if(src=="rgb" & dest=="hsb",dL=Colorcode("rgb","hsv",sL)); - - if(src=="hsb" & dest=="hsl",dL=Colorcode("hsv","hsl",sL)); - if(src=="hsl" & dest=="hsb",dL=Colorcode("hsl","hsv",sL)); - - if(src=="hsb" & dest=="hwb",dL=Colorcode("hsv","hwb",sL)); - if(src=="hwb" & dest=="hsb",dL=Colorcode("hwb","hsv",sL)); - - if(src=="hsb" & dest=="cmyk",dL=Colorcode("hsv","cmyk",sL)); - if(src=="cmyk" & dest=="hsb",dL=Colorcode("cmyk","hsv",sL)); - - dL; -); - -Addcolor(cmdorg,list):=( -//help:Addcolor("Plotdata('1','x^2','x',[])",[1,1,0]); - regional(rgb,cmyk,cmd,tmp,tmp1,tmp2,tmp3,tmp4); - cmd=replace(cmdorg,"'",Dq); - if(length(list)==3, - rgb=list; - cmyk=Colorcode("rgb","cmyk",list); - , - cmyk=list; - rgb=Colorcode("cmyk","rgb",list); - ); - tmp1="color->"+text(rgb); - tmp2="Setcolor("+text(cmyk)+");"; - tmp3=substring(cmd,0,length(cmd)-2); - tmp=substring(tmp3,length(tmp3)-1,length(tmp3)); - if(tmp!="[", - tmp3=tmp3+","; - ); - tmp3=tmp3+Dq+tmp1+Dq+"])"; - parse(tmp2); - parse(tmp3); - Setcolor("black"); -); - -Colorinfile(filename,clrf,clrt):=( - regional(tmp,tmp1,tmp2,head,cstrL,chstrL,head,body); - if(length(clrf_1)==3, - head="[rgb]{"; - , - head="[cmyk]{"; - ); - tmp=apply(clrf,text(#)); - cstrL=apply(tmp,head+substring(#,1,length(#)-1)+"}"); - if(length(clrt_1)==3, - head="[rgb]{"; - , - head="[cmyk]{"; - ); - tmp=apply(clrt,text(#)); - chstrL=apply(tmp,head+substring(#,1,length(#)-1)+"}"); - tmp1=load(filename); - tmp=tokenize(tmp1,"{\unitlength"); - head=tokenize(tmp_1,"%%%"); - head=head_(2..(length(head))); - head=apply(head,"%%%"+#); - tmp2=tmp_2; - forall(1..5, - tmp2=replace(tmp2,cstrL_#,chstrL_#); - ); - body=tokenize(tmp2,"%"); - body_1="{\unitlength"+body_1; - body=apply(body,#+"%"); - body=body_(1..(length(body)-1)); - tmp=replace(filename,".tex","new.tex"); - SCEOUT=openfile(tmp); - forall(head, - println(SCEOUT,#); - ); - forall(1..(length(body)), - tmp=body_#; - if(#<length(body), - println(SCEOUT,tmp); - , - print(SCEOUT,tmp) - ); - ); - closefile(SCEOUT); -); - -GetLinestyle(str,name):=( - regional(noflg,tmp,tmp1,tmp2,Dop,Ltype,subflg); - Ltype=-1; - Dop=""; - tmp1=indexof(str,","); - if(tmp1>0, - Dop=","+substring(str,tmp1,length(str)); - ); - noflg=parse(substring(str,0,1)); - if(substring(name,0,3)=="sub",subflg=1,subflg=0); // 16.02.29 - tmp1=substring(str,1,3); - if(tmp1=="dr" % tmp1=="Dr", - Ltype=0; - if(noflg==0 & subflg==0, // 16.02.29 - Drwline(name+Dop); - ); - ); - if(tmp1=="da" % tmp1=="Da", - Ltype=1; - if(noflg==0 & subflg==0, // 16.02.29 - Dashline(name+Dop); - ); - ); - if(tmp1=="id" % tmp1=="Id", - Ltype=2; // 15.11.09 - if(noflg==0 & subflg==0, // 16.02.29 - Invdashline(name+Dop); - ); - ); - if(tmp1=="do" % tmp1=="Do", - Ltype=3; - if(noflg==0 & subflg==0, // 16.02.29 - Dottedline(name+Dop); - ); - ); - if(tmp1=="dp" % tmp1=="Dp", - Ltype=0; - tmp1=parse(name); - tmp2=""; - forall(tmp1, - tmp2=tmp2+textformat(#_1,5)+","; - ); - tmp2=substring(tmp2,0,length(tmp2)-1); - if(noflg==0, - Drwpt(tmp2+Dop); - ); - ); - if(tmp1=="no" % tmp1=="No", - Ltype=10; - ); - Ltype; -); - -Chunderscore(str):=( - regional(flg,tmp,tmp1,tmp2,tmp3); - if(indexof(str,"]")>0, - tmp1=replace(str,"]",",]"); - , - tmp1=str+","; - ); - flg=0; - tmp2=[]; - tmp3=0; - forall(1..(length(tmp1)), - if(flg==0, - tmp=substring(tmp1,tmp3,length(tmp1)); - tmp=indexof(tmp,"_"); - if(tmp==0, - flg=1; - , - tmp3=tmp3+tmp; - tmp=substring(tmp1,tmp3,length(tmp1)); - tmp=indexof(tmp,",")-1; - tmp=substring(tmp1,tmp3,tmp3+tmp); - tmp2=append(tmp2,tmp); - ); - ); - ); - forall(tmp2, - tmp1=replace(tmp1,"_"+#,"("+#+")"); - ); - if(indexof(str,"]")>0, - tmp1=replace(tmp1,",]",")"); - tmp1=replace(tmp1,"[","list("); - , - tmp1=substring(tmp1,0,length(tmp1)-1); - ); - tmp1; -); - -//AddGraph(pltdata):=AddGraph("-"+pltdata,pltdata,[]); -AddGraph(nm,pltdata):=AddGraph(nm,pltdata,[]); -// if(isstring(Arg2), -// AddGraph(Arg1,Arg2,[]); -// , -// if(MeasureDepth(Arg2)>0, -// Addgraph(Arg1,Arg2,[]); -// , -// Addgraph("-"+Arg1,Arg1,Arg2); -// ); -// ); -//); -AddGraph(nm,pltdata,options):=( -//help:AddGraph("1","imp1"); // 16.04.04 -//help:Addgraph("1",["[pt1]","gr1"],["nodisp"]); - regional(name,Ltype,Noflg,opcindy,pdata,fname,flg, - tmp,tmp1,tmp2,tmp3); - if(substring(nm,0,1)=="-", - name=substring(nm,1,length(nm)); - , - name="ad"+nm; - ); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_9; - if(isstring(pltdata), - pdata=parse(pltdata) - , - if(!islist(pltdata),pdata=[pltdata],pdata=pltdata); - pdata=apply(pdata,parse(#)); - ); // 15.01.22 - pdata=Flattenlist(pdata); - tmp1=[]; - forall(pdata,tmp2, - tmp=apply(tmp2,Pcrd(#)); - tmp1=append(tmp1,tmp); - ); - if(length(tmp1)==1,tmp1=tmp1_1); - pdata=tmp1; - if(Noflg<3, - println("generate addgraph "+name); - tmp=name+"="+textformat(pdata,5); - parse(tmp); - if(isstring(pltdata), // 16.04.04 from - if(indexof(pltdata,"]")>0, - tmp1="list(Listplot("+substring(pltdata,1,length(pltdata)); - tmp1=replace(tmp1,"]",",]"); - , - tmp1="Listplot("+substring(pltdata,0,length(pltdata))+",]"; - ); - flg=0; - tmp2=[]; - tmp3=0; - forall(1..(length(tmp1)), - if(flg==0, - tmp=indexof(substring(tmp1,tmp3,length(tmp1)),"_"); - if(tmp==0, - flg=1; - , - tmp3=tmp3+tmp; - tmp=indexof(substring(tmp1,tmp3,length(tmp1)),",")-1; - tmp=substring(tmp1,tmp3,tmp3+tmp); - tmp2=append(tmp2,tmp); - ); - ); - ); - forall(tmp2, - tmp1=replace(tmp1,"_"+#,"("+#+")"); - ); - tmp1=replace(tmp1,",]",")"); - tmp1=replace(tmp1,",","),Listplot("); - if(indexof(pltdata,"[")>0, - tmp1=tmp1+")"; - ); - GLIST=append(GLIST,name+"="+tmp1); - , - if(MeasureDepth(pdata)==1, - tmp1=name+"=Listplot("+textformat(pdata,5)+")"; - , - tmp1="list("; - forall(1..(length(pdata)), - tmp=name+"p"+textformat(#,5)+"="; - if(length(pdata_#)>1, // 15.01.22 - tmp=tmp+"Listplot("+textformat(pdata_#,5)+")"; - , - tmp=tmp+"Pointdata("+textformat(pdata_#_1,5)+")"; - ); - GLIST=append(GLIST,tmp); - tmp1=tmp1+name+"p"+textformat(#,5)+","; - ); - tmp1=name+"="+substring(tmp1,0,length(tmp1)-1)+")"; - ); - GLIST=append(GLIST,tmp1); - ); - ); // 16.04.04 until - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); -); - -Joincrvs(nm,plotstrL):=Joincrvs(nm,plotstrL,[]); -Joincrvs(nm,plotstrL,options):=( -//help:Joincrvs("1",["sgAB","sgDCB"]); - regional(plotlist,PtL,Eps,QdL,Flg,Ni,Qd,pP,pS,pQ,pR,rMN, - opcindy,tmp,tmp1,tmp2,str,name,Ltype,Noflg); - name="join"+nm; - plotlist=[]; - forall(plotstrL,str, - if(isstring(str), - tmp=parse(str); - tmp=apply(tmp,LLcrd(#)); - , - tmp=str; - ); - plotlist=append(plotlist,tmp); - ); - Eps=10^(-4); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - tmp1=tmp_6; - if(length(tmp1)>0,Eps=tmp1_1); - QdL=[]; - forall(plotlist,Qd, - if(ispoint(Qd_1) % !islist(Qd_1_1), - QdL=concat(QdL,[Qd]); - , - forall(Qd, - QdL=concat(QdL,[#]); - ); - ); - ); - Flg=0; - if(length(QdL)==0, - PtL=[]; - Flg=1; - ); - if(Flg==0, - PtL=QdL_1; - forall(2..(length(QdL)),Ni, - Qd=QdL_Ni; - if(Numptcrv(Qd)>1, - pP=Ptend(PtL); - pS=Ptstart(PtL); - pQ=Ptstart(Qd); - pR=Ptend(Qd); - rMN=min([|pP-pQ|,|pP-pR|,|pS-pQ|,|pS-pR|]); - if(rMN==|pP-pR|, - Qd=reverse(Qd); - , - if(rMN==|pS-pQ|, - PtL=reverse(PtL); - , - if(rMN==|pS-pR|, - PtL=reverse(PtL); - Qd=reverse(Qd); - ); - ); - ); - ); - if(rMN>Eps, - PtL=concat(PtL,Qd); - , - PtL=concat(PtL,Qd_(2..(length(Qd)))); - ); - ); - ); - if(Noflg<3, - println("generate joincurve "+name); - tmp1=apply(PtL,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=""; - forall(plotstrL, - tmp1=tmp1+#+","; - ); - tmp1=substring(tmp1,0,length(tmp1)-1); - GLIST=append(GLIST,name+"=Joincrvs("+tmp1+")"); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - PtL; -); - -Partcrv(nm,pA,pB,PkLstr):=Partcrv(nm,pA,pB,PkLstr,[]); -Partcrv(nm,pA,pB,PkLstr,options):=( -//help:Partcrv("1",A,B,"sgABC"); -//help:Partcrv("1",1.3,2.5,"sgABC"); - regional(PkL,Ans,Eps,Npt,Out1,Out2,tmp,tmp1,Flg,nS,nE,PPL,pP, - opcindy,Ta,Tb,name,Ltype,Noflg,DepthFlg); - name="part"+nm; - if(isstring(PkLstr),PkL=parse(PkLstr),PkL=PkLstr); - DepthFlg=0; - if(MeasureDepth(PkL)==2, - PkL=PkL_1; - DepthFlg=1; - ); - PkL=apply(PkL,LLcrd(#)); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - Eps=10^(-3); - Flg=0; - if(isreal(pA), - if(pA>pB+Eps, - Npt=Numptcrv(PkL); - Out1=Partcrv("",pA,Npt,PkLstr,["nodata"]); - Out2=Partcrv("",1,pB,PkLstr,["nodata"]); - tmp=Ptstart(PkL)-Ptend(PkL); - if(|tmp|<Eps, - Ans=Joincrvs("",[Out1,Out2],["nodata"]); - , - Ans=[apply(Out1,Pcrd(#)),apply(Out2,Pcrd(#))]; - ); - Flg=1; - ); - if(Flg==0, - nS=ceil(pA); - nE=floor(pB); - PPL=[]; - if(pA<nS-Eps, - pP=(nS-pA)*PkL_(nS-1)+(1-nS+pA)*PkL_nS; - PPL=[pP]; - ); - PPL=concat(PPL,PkL_(nS..nE)); - if(pB>nE+Eps, - pP=(1-pB+nE)*PkL_nE+(pB-nE)*PkL_(nE+1); - PPL=concat(PPL,[pP]); - ); - Ans=PPL; - Flg=1; - ); - ); - if(Flg==0, - tmp=Nearestpt(LLcrd(Pcrd(pA)),PkL); - Ta=tmp_2; - tmp=Nearestpt(LLcrd(Pcrd(pB)),PkL); // 15.09.12 - Tb=tmp_2; - Ans=Partcrv("",Ta,Tb,PkL,["nodata"] ); - Ans=apply(Ans,Pcrd(#)); - ); - if(Noflg<3, - println("generate partcrv "+name); - tmp1=apply(Ans,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); -// GLIST=append(GLIST, // 16.04.03 - if(DepthFlg==0, - tmp=PkLstr; - , - tmp=PkLstr+"(1)"; - ); - tmp1=name+"=Partcrv("+textformat(Lcrd(pA),5) - +","+textformat(Lcrd(pB),5)+","+tmp+")"; // 16.04.03 - GLIST=append(GLIST,tmp1); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - Ans; -); - -Opcrvs(num,Fig):=Opcrvs(num,Fig,["nodisp"]); -Opcrvs(num,Fig,options):=( - //help:Subgraph(2,"grfs"); - regional(name,tmp,tmp1); - name="-"+Fig+text(num); - tmp=Fig+"_"+text(num); - tmp1=parse(tmp); - Listplot(name,tmp1,options); -); - - -Pointdata(nm,list):=Pointdata(nm,list,[]); -Pointdata(nm,listorg,options):=( -//help:Pointdata("1",[2,4],["Size=5"]); -//help:Pointdata("2",[[2,3],[4,1]]); - regional(list,name,nameL,ptlist,opstr,opcindy, - eqL,size,thick,tmp,tmp1,tmp2,tmp3,Ltype,Noflg); - name="pt"+nm; - nameL=name+"L"; - println("generate pointdata "+name); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - opstr=tmp_(length(tmp)-1); - size=""; - eqL=tmp_5; - if(length(eqL)>0, - forall(eqL, - tmp=substring(#,0,1); - if(tmp=="s" % tmp=="S", - tmp=indexof(#,"="); - size=substring(#,tmp,length(#)); - ); - ); - ); - if(isstring(listorg),list=parse(listorg),list=listorg); //17.10.23 - tmp=MeasureDepth(list); - if(tmp>0, // 2015.02.21 - if(tmp==1,ptlist=list,ptlist=list_1); - tmp=apply(ptlist,[textformat(Pcrd(#),5)]); - tmp1=text(tmp); - tmp2=substring(tmp1,1,length(tmp1)-1); - tmp3=tmp1; - , - ptlist=list; - tmp1=textformat(Pcrd(ptlist),5); - tmp2=tmp1; - tmp3="["+tmp1+"]"; - ); - tmp=name+"="+tmp1; - parse(tmp); - tmp=nameL+"="+tmp3; - parse(tmp); - if(Noflg<3, - if(isstring(listorg), //17.10.23 - tmp2=listorg; - , - tmp2="list("; //17.10.10from - forall(list, - if(isstring(#), - tmp=#; - , - if(ispoint(#),tmp=text(#),tmp=textformat(#,6)); - ); - tmp2=tmp2+tmp+","; - ); - tmp2=substring(tmp2,0,length(tmp2)-1)+")"; //17.10.10until - ); - GLIST=append(GLIST,name+"=Pointdata("+tmp2+")"); - ); - if(Noflg<2, - tmp=[nameL,0,opcindy]; - GCLIST=append(GCLIST,tmp); - if(Noflg==0, - if(length(size)>0, - Com2nd("Setpt("+size+")"); - ); - thick=PenThick/PenThickInit; // 16.04.09 from - if(length(size)>0,tmp1=parse(size),tmp1=1); - tmp1=max(tmp1,1)/8; - Setpen(tmp1); // 16.04.09 until - Com2nd("Drwpt(list("+name+")"+opstr+")"); - Setpen(thick); // 16.04.09 - if(length(size)>0, - Com2nd("Setpt("+textformat(TenSize/TenSizeInit,1)+")"); - ); - ); - ); - ptlist; -); - -Listplot(nm,list,options):=( -//help:Listplot([A,B]); -// help:Listplot(["A","B"]); -//help:Listplot("1",[[2,1],[3,3]]); -//help:Listplot(options2=["Msg=yes"]); - regional(name,tmp,tmp1,ptlist,Ltype,opcindy,Noflg,eqL,Msg); - if(substring(nm,0,1)=="-", // 16.01.27 from - name=substring(nm,1,length(nm)); - , - name="sg"+nm; - ); // until - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - opcindy=tmp_(length(tmp)); - Msg=1; // 15.09.17 - forall(eqL, - tmp=substring(#,0,1); - if(Toupper(tmp)=="M", - tmp=indexof(#,"="); - tmp1=substring(#,tmp,tmp+1); // 16.06.28 - if(Toupper(tmp1)=="N", // 16.06.28 - Msg=0; - ); - ); - ); - if(Noflg<3, - if(Msg==1, - println("generate Listplot "+name); - ); - if(isstring(list_1),tmp=apply(list,parse(#)),tmp=list); // 15.03.24 - ptlist=apply(tmp,Pcrd(#)); - tmp=name+"="+textformat(ptlist,5); - parse(tmp); - GLIST=append(GLIST,name+"=Listplot("+textformat(list,5)+")"); // 15.12.23 - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - tmp1=apply(list,Lcrd(#)); - tmp1; -); -Listplot(Arg1,Arg2):=( - regional(name,list,options,str); - if(isstring(Arg1), - name=Arg1; - list=Arg2; - Listplot(name,list,[]); - , - list=Arg1; - options=Arg2; - name=""; - forall(list, // 16.10.07from - name=name+#.name; - );// 16.10.07until - Listplot(name,list,options); - ); -); -Listplot(list):=Listplot(list,[]); - -Lineplot(nm,list,options):=( -//help:Lineplot([A,B]); -//help:Lineplot("1",[[2,1],[3,3]]); - regional(name,Out,tmp,tmp1,opstr,opcindy,Mag,Semi, - Vec,pA,pB,Ltype,Noflg); - name="ln"+nm; - Mag=100; - Semi=""; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - opstr=tmp_(length(tmp)-1); - tmp1=tmp_6; - if(length(tmp1)>0,Mag=tmp1_1); - tmp1=tmp_7; - if(length(tmp1)>0,Semi=tmp1_1); - pA=Lcrd(list_1); pB=Lcrd(list_2); - Vec= Mag/dist(pA,pB)*(pB-pA); - if(length(Semi)==0, - Out=[pA-Vec,pA+Vec]; - , - if(Semi=="+", - Out=[pA,pA+Vec]; - , - Out=[pA-Vec,pA]; - ); - ); - if(Noflg<3, - println("generate Lineplot "+name); - tmp1=apply(Out,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - GLIST=append(GLIST,name+"=Lineplot("+textformat(list,5)+opstr+")"); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - Out; -); -Lineplot(Arg1,Arg2):=( - regional(name,list,options,str); - if(isstring(Arg1), - name=Arg1; - list=Arg2; - Lineplot(name,list,[]); - , - list=Arg1; - options=Arg2; - name=""; - forall(list, // 16.10.07from - name=name+#.name; - );// 16.10.07until - Lineplot(name,list,options); - ); -); -Lineplot(list):=Lineplot(list,[]); - -Plotdata(name1,func,variable):=Plotdata(name1,func,variable,[]); -Plotdata(name1,func,variable,options):=( -//help:Plotdata("1","sin(x)","x",["Num=100"]); -//help:Plotdata("2","x^2","x=[-1,1]"); -//help:Plotdata("3","Fout(x)","x",["out"]); - regional(Fn,Va,tmp,tmp1,tmp2,eqL,name,Vname,x1,x2,dx, - PdL,QdL,Num,Ec,Dc,Fun,Exfun,x,Ke,Eps,Pa, - Ltype,Noflg,Inflg,Outflg,opstr,opcindy); - name="gr"+name1; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - Inflg=tmp_3; - Outflg=tmp_4; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - eqL=tmp_5; - Num=50; - Ec=[]; - Exfun=""; - Dc=1000; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,tmp,length(#)); - opstr=opstr+",'"+#+"'"; - if(substring(#,0,1)=="N", - Num=parse(tmp1); - ); - if(substring(#,0,1)=="E", - if(substring(tmp1,0,1)=="[", - Ec=parse(tmp1); - , - Exfun=tmp1; - ); - ); - if(substring(#,0,1)=="D", - Dc=parse(tmp1); - ); - ); - if(Inflg==0 & Outflg==0, - Eps=10^(-3); - tmp=replace(func,LFmark,""); - tmp=tokenize(variable,"="); - Vname=tmp_1; - if(length(tmp)>1, - tmp=tmp_2; - tmp=parse(tmp); - x1=tmp_1; - x2=tmp_2; - , - x1=XMIN; - x2=XMAX; - ); - // dx=(x2-x2)/Num; - Ec=append(sort(Ec),10000); - Fun=Assign(func,Vname, "xx"); - Exfun=Assign(Exfun,Vname, "xx"); - PdL=[]; - Ke=1; - forall(0..Num, - xx=x1+#*(x2-x1)/Num; // differs from Scilab ( / Num-1) - if(length(Exfun)>0, - tmp=parse(Exfun); - if(abs(tmp)<Eps, - if(length(Pdt)>0, - PdL=concat(PdL,["inf"]); - ); - ); - , - Pa=[]; - if(xx-Ec_Ke<-Eps, - Pa=[xx,parse(Fun)]; - ); - if(abs(xx-Ec_Ke)<=Eps, - if(length(PdL)>0, - if(PdL_(length(PdL))_1!="inf", - Pa=["inf"]; - ); - ); - ); - if(xx-Ec_Ke>Eps, - Pa=[xx,parse(Fun)]; - Ke=Ke+1; - ); - if(length(Pa)>0, - if(Pa_1=="inf", - PdL=concat(PdL,[Pa]); - , - if(length(PdL)==0, - PdL=[Pa]; - , - tmp=PdL_(length(PdL)); - if(tmp_1=="inf", - PdL=concat(PdL,[Pa]); - , - if(dist(tmp,Pa)<Dc, - PdL=concat(PdL,[Pa]); - , - PdL=concat(PdL,[["inf"],Pa]); - ); - ); - ); - ); - ); - ); - ); - tmp1=[]; - tmp2=select(1..(length(PdL)),PdL_#==["inf"]); - tmp=1; - forall(tmp2, - if(#>tmp, - tmp1=concat(tmp1,[PdL_(tmp..(#-1))]) - ); - tmp=#+1; - ); - if(tmp<length(PdL), - tmp1=concat(tmp1,[PdL_(tmp..(length(PdL)))]); - ); - PdL=tmp1; - if(length(PdL)==1, - PdL=PdL_1; - ); - if(Noflg<3, - println("generate Plotdata "+name); - if(MeasureDepth(PdL)==1, - tmp1=apply(PdL,Pcrd(#)); - , - tmp1=[]; - forall(PdL,tmp2, - tmp1=append(tmp1,apply(tmp2,Pcrd(#))); - ); - ); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=replace(func,LFmark,""); - tmp2=replace(variable,LFmark,""); - tmp=name+"=Plotdata('"+tmp1+"','"+tmp2+"'"+opstr+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - PdL; - , - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - if(Inflg==1, - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - ); - ); -); - -Paramplot(name1,funstr,variable):=Paramplot(name1,funstr,variable,[]); -Paramplot(name1,funstr,variable,options):=( -//help:Paramplot("1","[2*cos(t),sin(t)]","t=[0,2*pi]"); - regional(name,Out,tmp,tmp1,tmp2,vname,func,str,Rng,Num, - Ec,Exfun,Dc,eqL,Fntmp,Vatmp,t1,t2,dt,tt,pa,ke, - Ltype,Noflg,Inflg,Outflg,opstr,opcindy); - name="gp"+name1; - Eps=10^(-4); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - Inflg=tmp_3; - Outflg=tmp_4; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - eqL=tmp_5; - Num=50; - Ec=[]; - Exfun=""; - Dc=1000; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,tmp,length(#)); - opstr=opstr+",'"+#+"'"; - if(substring(#,0,1)=="N", - Num=parse(tmp1); - ); - if(substring(#,0,1)=="E", - if(substring(tmp1,0,1)=="[", - Ec=parse(tmp1); - , - Exfun=tmp1; - ); - ); - if(substring(#,0,1)=="D", - Dc=parse(tmp1); - ); - ); - if(Inflg==0 & Outflg==0, - tmp=indexof(variable,"="); - vname=substring(variable,0,tmp-1); - str=substring(variable,tmp,length(variable)); - Rng=parse(str); - t1=Rng_1; t2=Rng_2; - dt=(t2-t1)/Num;// differs from Scilab ( / Num-1) - func=Assign(funstr,vname,"tt"); - Out=[]; - Ec=append(sort(Ec),10000); - ke=1; - forall(0..Num, - pt=[]; - tt=Rng_1+#*dt; - if(tt-Ec_ke<-Eps, - pa=parse(func); - ); - if(abs(tt-Ec_ke)<=Eps, - if(length(Out)>0, - if(Out_(length(Out))_1!="inf", - pa=["inf"]; - ); - ); - ); - if(tt-Ec_ke>Eps, - pa=parse(func); - ke=ke+1; - ); - if(length(pa)>0, - if(pa_1=="inf", - Out=append(Out,pa); - , - if(length(Out)==0, - Out=[pa]; - , - tmp=Out_(length(Out)); - if(tmp_1=="inf", - Out=append(Out,pa); - , - if(|tmp-pa|<Dc, - Out=append(Out,pa); - , - Out=concat(Out,[["inf"],pa]); - ); - ); - ); - ); - ); - ); - tmp1=[]; - tmp2=select(1..(length(Out)),Out_#==["inf"]); - tmp=1; - forall(tmp2, - if(#>tmp, - tmp1=concat(tmp1,[Out_(tmp..(#-1))]) - ); - tmp=#+1; - ); - if(tmp<length(Out), - tmp1=concat(tmp1,[Out_(tmp..(length(Out)))]); - ); - Out=tmp1; - if(length(Out)==1, - Out=Out_1; - ); - if(Noflg<3, - println("generate Paramplot "+name); - if(MeasureDepth(Out)==1, - tmp1=apply(Out,Pcrd(#)); - , - tmp1=[]; - forall(Out,tmp2, - tmp1=append(tmp1,apply(tmp2,Pcrd(#))); - ); - ); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=replace(funstr,LFmark,""); // 15.11.13 - tmp2=replace(variable,LFmark,""); - tmp=name+"=Paramplot('"+tmp1+"','"+tmp2+"'"+opstr+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - Out; - , - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - if(Inflg==1, - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - ); - ); -); - -Connectseg(Pdata):=( - regional(Eps,PlotL,vL,ctr,qd,ah,ao,flg,jj, - pp,qq,tmp,tmp1,tmp2); - Eps=10^(-4); - PlotL=[Pdata_1]; - vL=2..(length(Pdata)); - ctr=0; - while((length(vL)>0)&(ctr<1000), - ctr=ctr+1; - qd=PlotL_(length(PlotL)); - ah=qd_1; ao=qd_(length(qd)); - flg=0; - forall(1..(length(vL)),jj, - if(flg==0, - tmp1=Pdata_(vL_jj); - pp=tmp1_1; qq=tmp1_(length(tmp1)); - if(Norm(pp-ao)<Eps, - tmp=tmp1_(2..(length(tmp1))); - if(length(tmp)>0, - qd=concat(qd,tmp); - ); - PlotL_(length(PlotL))=qd; - vL=remove(vL,[vL_jj]); - flg=1; - ); - ); - if(flg==0, - if(Norm(qq-ao)<Eps, - tmp=tmp1_(1..(length(tmp1)-1)); - tmp=reverse(tmp); - qd=concat(qd,tmp); - PlotL_(length(PlotL))=qd; - vL=remove(vL,[vL_jj]); - flg=1; - ); - ); - if(flg==0, - if(Norm(pp-ah)<Eps, - tmp=tmp1_(2..(length(tmp1))); - qd=concat(tmp,qd); - PlotL_(length(PlotL))=qd; - vL=remove(vL,[vL_jj]); - flg=1; - ); - ); - if(flg==0, - if(Norm(qq-ah)<Eps, - tmp=tmp1_(1..(length(tmp1)-1)); - tmp=reverse(tmp); - qd=concat(tmp,qd); - PlotL_(length(PlotL))=qd; - vL=remove(vL,[vL_jj]); - flg=1; - ); - ); - ); - if(flg==0, - PlotL=concat(PlotL,Pdata_(vL_1)); - vL=remove(vL,[vL_1]); - ); - ); - PlotL; -); - -Implicitplot(name1,func,xrng,yrng):=Implicitplot(name1,func,xrng,yrng,[]); -Implicitplot(name1,func,xrng,yrng,options):=( -//help:Implicitplot("1","x^2+x*y+y^2=1","x=[-3,3]","y=[-3,3]"); -//help:Implicitplot(options=["Num=[50,50]"]); - regional(name,Fn,varx,vary,rngx,rngy,Mdv,Ndv,tmp,tmp1,tmp2, - Eps,Ltype,Noflg,eqL,opsr,opcindy,dx,dy,out,jj,ii,kk, - yval1,yval2,xval1,xval2,eval11,eva12,eval21,eval22,pL,vL,qL); - name="imp"+name1; - Eps=10^(-4); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - Mdv=50;Ndv=50; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,tmp-1)); - tmp2=substring(#,tmp,length(#)); - opstr=opstr+",'"+#+"'"; - if(substring(#,0,1)=="N", - Mdv=parse(tmp2); - if(!islist(Mdv), - Ndv=Mdv; - , - Ndv=Mdv_2; - Mdv=Mdv_1; - ); - ); - ); - tmp=indexof(func,"="); - if(tmp==0, - Fn=func; - , - tmp1=substring(func,0,tmp-1); - tmp2=substring(func,tmp,length(func)); - Fn=tmp1+"-("+tmp2+")"; - ); - tmp=indexof(xrng,"="); - varx=substring(xrng,0,tmp-1); - rngx=parse(substring(xrng,tmp,length(xrng))); - tmp=indexof(yrng,"="); - vary=substring(yrng,0,tmp-1); - rngy=parse(substring(yrng,tmp,length(yrng))); - tmp="Impfun("+varx+","+vary+"):="+Fn; - parse(tmp); - dx=(rngx_2-rngx_1)/Mdv; - dy=(rngy_2-rngy_1)/Ndv; - out=[]; - forall(1..Ndv,jj, - yval1=rngy_1+(jj-1)*dy; - yval2=rngy_1+jj*dy; - xval1=rngx_1; - eval11=Impfun(xval1,yval1); - eval12=Impfun(xval1,yval2); - forall(1..Mdv,ii, - xval2=rngx_1+ii*dx; - eval21=Impfun(xval2,yval1); - eval22=Impfun(xval2,yval2); - pL=[[xval1,yval1]];vL=[eval11]; - pL=append(pL,[xval2,yval1]);vL=append(vL,eval21); - pL=append(pL,[xval2,yval2]);vL=append(vL,eval22); - pL=append(pL,[xval1,yval2]);vL=append(vL,eval12); - pL=append(pL,[xval1,yval1]);vL=append(vL,eval11); - qL=[]; - forall(1..4,kk, - if(abs(vL_kk)<=Eps, - qL=append(qL,pL_kk); - , - if(vL_kk>Eps, - if(vL_(kk+1)< -Eps, - tmp=1/(vL_kk-vL_(kk+1))* - (-vL_(kk+1)*pL_kk+vL_kk*pL_(kk+1)); - qL=append(qL,tmp); - ); - , - if(vL_(kk+1)>Eps, - tmp=1/(-vL_kk+vL_(kk+1))* - (vL_(kk+1)*pL_kk-vL_kk*pL_(kk+1)); - qL=append(qL,tmp); - ); - ); - ); - ); - xval1=xval2; - eval11=eval21; - eval12=eval22; - if(length(qL)==2, - out=append(out,qL); - ); - ); - ); - if(length(out)>0, - out=Connectseg(out); - ); - if(length(out)==1, - out=out_1; - ); - if(Noflg<3, - println("generate Implicitplotdata "+name); - if(MeasureDepth(out)==1, - tmp1=apply(out,Pcrd(#)); - , - tmp1=[]; - forall(out,tmp2, - tmp1=append(tmp1,apply(tmp2,Pcrd(#))); - ); - ); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp=name+"=Implicitplot('"+func+"','"+xrng+"','"+yrng+"'"+opstr+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - out; -); - -Circledata(cenrad):=Circledata(cenrad,[]); -Circledata(para1,para2):=( -//help:Circledata([A,B],["Rng=[0,pi/2]"]); -//help:Circledata([A,B,C]); - regional(name,cenrad,options,str,n); - if(isstring(para1), - name=para1; - cenrad=para2; - options=[]; - , - cenrad=para1; - options=para2; - name="";// 16.10.07from - forall(cenrad, - name=name+#.name; - );// 16.10.07until - ); - Circledata(name,cenrad,options); -); -Circledata(nm,cenrad,options):=( - regional(name,Out,Ctr,Ptcir,ra,Num,Rg,opstr,opcindy, - tmp,tmp1,tmp1,Th,Ltype,Noflg,eqL,pA,pB,pC,d1,d2,Eps); - name="cr"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - eqL=tmp_5; - Num=50; - Rg=[0,2*pi]; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,tmp,length(#)); - opstr=opstr+",'"+#+"'"; - if(substring(#,0,1)=="N", - Num=parse(tmp1); - ); - if(substring(#,0,1)=="R", - Rg=parse(tmp1); - ); - ); - if(length(cenrad)==2, - Ctr=Lcrd(cenrad_1); - Ptcir=Lcrd(cenrad_2); - ra=dist(Ctr,Ptcir); - , - Eps=10^(-1); - pA=Lcrd(cenrad_1); - pB=Lcrd(cenrad_2); - pC=Lcrd(cenrad_3); - tmp=pB-pA; - tmp1=(tmp_2,-tmp_1); - tmp=pC-pB; - tmp2=(tmp_2,-tmp_1); - d1=det([tmp1,tmp2]); - d2=det([pC-pA,tmp2]); - if(abs(d1)<Eps & abs(d2)>10*Eps, - println("points are in a line"); - ra=0; - , - Ctr=1/2*(pA+pB)+1/2*d2/d1*tmp1; - ra=|pA-Ctr|; - tmp=name+"center="+Ctr; - parse(tmp); - Defvar(name+"center",Ctr); - ); - ); - if(ra>0, - Out=[]; - forall(0..Num, - Th=Rg_1+#*(Rg_2-Rg_1)/Num; - Out=append(Out,Ctr+ra*[cos(Th),sin(Th)]); - ); - , - Out=Lineplot("1",[pA,pB],["nodata"]); - ); - if(Noflg<3, - println("generate Circledata "+name); - tmp1=apply(Out,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - if(length(cenrad)==2, - tmp=name+"=Circledata("+cenrad+opstr+")"; - , - if(ra>0, - tmp=name+"=Circledata(["+Ctr+","+cenrad_1+"]"+opstr+")"; - , - tmp=name+"=Lineplot("+cenrad_1+","+cenrad_2+")"; - ); - ); - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - Out; -); - -Framedata():=Framedata(["dr"]);//16.10.29from -Framedata(list):=( - regional(pA,pB); - if(MeasureDepth(list)==0, - pA=LLcrd((SW+NE)/2); // 15.09.17 - pB=LLcrd(NE); - Framedata("win",[pA,pB],list); - , - Framedata(list,[]); - ); -);//16.10.29until -Framedata(Arg1,Arg2):=( - regional(name,list,options,str); - if(isstring(Arg1), - name=Arg1; - list=Arg2; - Framedata(name,list,[]); - , - list=Arg1; - options=Arg2; - name="";// 16.10.07from - forall(list, - name=name+#.name; - );// 16.10.07until - Framedata(name,list,options); - ); -); -Framedata(nm,list,options):=( -//help:Framedata(); -//help:Framedata([C,A]); -//help:Framedata("1",[C,A]); -//help:Framedata("1",[C,dx,dy]); - regional(name,Out,tmp,tmp1,pB,x1,x2,y1,y2,dx,dy, - opcindy,Ltype,Noflg,cent,dx,dy); - name="fr"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - if(length(list)==2, // 15.05.12 - pA=Lcrd(list_1); pB=Lcrd(list_2); - dx=abs(pB_1-pA_1); dy=abs(pB_2-pA_2); - , - pA=Lcrd(list_1); - dx=list_2; dy=list_3; - ); - x1=pA_1-dx; x2=pA_1+dx; - y1=pA_2-dy; y2=pA_2+dy; - Out=[[x1,y1],[x2,y1],[x2,y2],[x1,y2],[x1,y1]]; - if(Noflg<3, - println("generate Framedata "+name); - tmp1=apply(Out,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - GLIST=append(GLIST,name+"=Framedata("+pA+","+dx+","+dy+")"); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - Out; -); -Framedata(nm,cent,dx,dy):=Framedata(nm,cent,dx,dy,[]); -Framedata(nm,cent,dx,dy,options):=( - regional(name,Out,tmp,tmp1,x1,y1,x2,y2,Ltype,opcindy,Noflg); - name="fr"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - x1=cent.x-dx; x2=cent.x+dx; - y1=cent.y-dy; y2=cent.y+dy; - Out=[[x1,y1],[x2,y1],[x2,y2],[x1,y2],[x1,y1]]; - if(Noflg<3, - println("generate Framedata "+name); - tmp1=apply(Out,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - GLIST=append(GLIST,name+"=Framedata("+cent.xy+","+dx+","+dy+")"); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - Out; -); - -Framedata2(nm,list):=Framedata2(nm,list,[]); -Framedata2(nm,list,options):=( -//help:Framedata2("1",[A,B]); - regional(tmp,tmp1,pC,pB); - pC=(Lcrd(list_1)+Lcrd(list_2))/2; - pB=Lcrd(list_2); - Framedata(nm,[pC,pB],options); -); - -Ovaldata(nm,Pdata):=Ovaldata(nm,Pdata,[]); -Ovaldata(nm,Pdata,options):=( -//help:Ovaldata("1",[A,B]); -//help:Ovaldata(optios=[size]); - regional(name,Graph,Ctr,Dx,Dy,Rc,Out,Point,Graph, - opstr,opcindy,tmp,tmp1,tmp2,tmp3,Ltype,Noflg); - name="ov"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - opstr=tmp_(length(tmp)-1); - Rc=0.2; - tmp1=tmp_6; - if(length(tmp1)>0,Rc=tmp1_1*Rc); -// if(length(tmp1)>0,Rc=tmp1_1); //15.11.15 - Ctr=Lcrd(Pdata_1); - if(ispoint(Pdata_2) % islist(Pdata_2), - tmp1=Lcrd(Pdata_2); - Dx=abs(tmp1_1-Ctr_1); - Dy=abs(tmp1_2-Ctr_2); - , - Dx=Pdata_2; - Dy=Pdata_3; - ); - Point=Ctr+[Dx-Rc,Dy-Rc]; - tmp1=Circledata("1",[Point,Point+[Rc,0]], - ["Rng=[0,pi/2]","Num=10","nodata"]); - tmp2=Listplot("1",[Ctr+[Dx-Rc,Dy],Ctr+[0,Dy]], - ["nodata"]); - tmp3=Listplot("2",[Ctr+[Dx,0],Ctr+[Dx,Dy-Rc]], - ["nodata"]); - Graph=Joincrvs("1",[tmp3,tmp1,tmp2],["nodata"]); - tmp1=Reflectdata("1",[Graph],[Ctr,Ctr+[0,1]],["nodata"]); - Graph=Joincrvs("1",[Graph,tmp1],["nodata"]); - tmp2=Reflectdata("2",[Graph],[Ctr,Ctr+[1,0]], - ["nodata"]); - Graph=Joincrvs("2",[Graph,tmp2],["nodata"]); - if(Noflg<3, - println("generate Ovaldata "+name); - tmp1=apply(Graph,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - GLIST=append(GLIST, - name+"=Ovaldata("+Ctr+","+Dx+","+Dy+opstr+")");//16.01.30 - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - tmp1=apply(Graph,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp=textformat(Ctr,5)+","+textformat(Dx,5)+","+textformat(Dy,5); - ); - Graph; -); - -Segmark(nm,ptlist):=Segmark(nm,ptlist,[]); -Segmark(nm,ptlist,options):=Drawsegmark(nm,ptlist,options); -Drawsegmark(nm,ptlist):=Drawsegmark(nm,ptlist,[]); -Drawsegmark(nm,ptlist,options):=( -//help:Segmark("1",[A,B]); -//help:Segmark(options=["Type=1","Width=1","Size=1"]); - regional(name,pA,pB,wid,mid,size,tp,dir,nor,eqL, - tmp,tmp1,tmp2); - name="mrk"+nm; - pA=ptlist_1; - pB=ptlist_2; - size=0.15; - wid=0.05; - tp=1; - tmp1=Divoptions(options); - eqL=tmp1_5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,tmp,length(#)); - tmp1=parse(tmp1); - tmp=substring(#,0,1); - if(tmp=="S" % tmp=="s", - size=size*tmp1; - ); - if(tmp=="W" % tmp=="w", - wid=wid*tmp1; - ); - if(tmp=="T" % tmp=="t", - tp=tmp1; - ); - ); - mid=(pA+pB)/2; - dir=(pB-pA)/|pB-pA|; - nor=[-dir_2,dir_1]; -// nor=nor/|nor|; - if(tp==1, - tmp1=mid+size*nor; - tmp2=mid-size*nor; - Listplot(name,[tmp1,tmp2]); - ); - if(tp==2, - tmp1=mid+wid*dir+size*nor; - tmp2=mid+wid*dir-size*nor; - Listplot(name+"r",[tmp1,tmp2]); - tmp1=mid-wid*dir+size*nor; - tmp2=mid-wid*dir-size*nor; - Listplot(name+"l",[tmp1,tmp2]); - ); - if(tp==3, - tmp1=mid; - tmp2=mid+size*dir; - Circledata(name,[tmp1,tmp2]); - ); - if(tp==4, - tmp=mid+size*2/sqrt(3)*nor; - tmp1=mid+size*dir-size/sqrt(3)*nor; - tmp2=mid-size*dir-size/sqrt(3)*nor; - Listplot(name,[tmp,tmp1,tmp2,tmp]); - ); -); - -Parabolaplot(nm,ptlist):=Parabolaplot(nm,ptlist,"[-5,5]",[]); -Parabolaplot(nm,ptlist,Arg):=( - regional(rng,options); - if(isstring(Arg), - rng=Arg; - options=[]; - , - rng="[-5,5]"; - options=Arg; - ); - Parabolaplot(nm,ptlist,rng,options); -); -Parabolaplot(nm,ptlist,rng,options):=( -//help:Parabolaplot("1",[A,B,C]): -//help:Parabolaplot("1",[A,B,C],"[-5,5]"); - regional(pA,pB,pC,angle,tmp,tmp1,tmp2); - tmp1=Lcrd(ptlist_1); - tmp2=Lcrd(ptlist_3); - pB=Lcrd(ptlist_2); - tmp=(tmp2-pB)/|tmp2-pB|; - if(tmp_2>=0, - angle=arccos(tmp_1); - , - if(tmp_1>=0, - angle=arcsin(tmp_2); - , - angle=-arccos(tmp_1); - ); - ); - pA=Rotatepoint(tmp1,-angle,pB); - pC=Rotatepoint(tmp2,-angle,pB); - tmp1=1/(2*(pA_2-pB_2)); - tmp2=1/2*(pA_2+pB_2); - tmp="("+format(tmp1,5)+")*(x-("+format(pA_1,5)+"))^2"; - tmp=tmp+"+("+format(tmp2,5)+")"; - tmp1=parse(rng); - tmp1=[pA_1-(tmp1_2-tmp1_1)/2,pA_1+(tmp1_2-tmp1_1)/2]; - tmp2="x="+textformat(tmp1,5); - Plotdata(nm+"para",tmp,tmp2,append(options,"nodisp")); - Rotatedata(nm+"para","gr"+nm+"para",angle,append(options,pB)); -); - -Ellipseplot(nm,ptlist):=Ellipseplot(nm,ptlist,"[0,2*pi]",[]); -Ellipseplot(nm,ptlist,Arg):=( - regional(rng,options); - if(isstring(Arg), - rng=Arg; - options=[]; - , - rng="[0,2*pi]"; - options=Arg; - ); - Ellipseplot(nm,ptlist,rng,options); -); -Ellipseplot(nm,ptlist,rng,options):=( -//help:Ellipseplot("1",[A,B,3]); -//help:Ellipseplot("1",[A,B,C],"[0,pi]",[options]); - regional(pA,pB,d,angle,f,a,b,pM,tmp,tmp1,tmp2); - pA=Lcrd(ptlist_1); - tmp1=Lcrd(ptlist_2); - if(ispoint(ptlist_3), - tmp2=Lcrd(ptlist_3); - d=|tmp2-pA|+|tmp2-tmp1|; - , - d=ptlist_3; - ); - tmp=(tmp1-pA)/|tmp1-pA|; - if(tmp_2>=0, - angle=arccos(tmp_1); - , - if(tmp_1>=0, - angle=arcsin(tmp_2); - , - angle=-arccos(tmp_1); - ); - ); - pB=Rotatepoint(tmp1,-angle,pA); - f=|pB_1-pA_1|/2; - a=d/2; - b=sqrt(d^2/4-f^2); - pM=(pA+pB)/2; - tmp="["+format(pM_1,5)+","+format(pM_2,5)+"]"; - tmp=tmp+"+["+format(a,5)+"*cos(t),"+format(b,5)+"*sin(t)]"; - Paramplot(nm+"elp",tmp,"t="+rng,append(options,"nodisp")); - Rotatedata(nm+"elp","gp"+nm+"elp",angle,append(options,pA)); -); - -Hyperbolaplot(nm,ptlist):=Hyperbolaplot(nm,ptlist,"[-5/2,5/2]",[]); -Hyperbolaplot(nm,ptlist,Arg):=( - regional(rng,options); - if(isstring(Arg), - rng=Arg; - options=[]; - , - rng="[-5/2,5/2]"; - options=Arg; - ); - Hyperbolaplot(nm,ptlist,rng,options); -); -Hyperbolaplot(nm,ptlist,rng,optionsorg):=( -//help:Hyperbolaplot("1",[A,B,C],["Num=200"]): -//help:Hyperbolaplot("1",[A,B,C],"[-5,5]",["Asy=do"]); - regional(pA,pB,d,angle,f,a,b,pM,eqL,options,opasy,tmp,tmp1,tmp2); - tmp=Divoptions(optionsorg); - eqL=tmp_5; - options=optionsorg; - opasy=[]; - forall(eqL, - if(Toupper(substring(#,0,1))=="A", - tmp=indexof(#,"="); - opasy=[substring(#,tmp,length(#))]; - options=remove(options,[#]); - ); - ); - pA=Lcrd(ptlist_1); - tmp1=Lcrd(ptlist_2); - if(ispoint(ptlist_3), - tmp2=Lcrd(ptlist_3); - d=abs(|tmp2-pA|-|tmp2-tmp1|); - , - d=ptlist_3; - ); - tmp=(tmp1-pA)/|tmp1-pA|; - if(tmp_2>=0, - angle=arccos(tmp_1); - , - if(tmp_1>=0, - angle=arcsin(tmp_2); - , - angle=-arccos(tmp_1); - ); - ); - pB=Rotatepoint(tmp1,-angle,pA); - f=|pB_1-pA_1|/2; - a=d/2; - b=sqrt(f^2-d^2/4); - pM=(pA+pB)/2; - tmp="["+format(pM_1,5)+"+"+format(a,5)+"*(exp(t)+exp(-t))/2,"; - tmp=tmp+format(pM_2,5)+"+"+format(b,5)+"*(exp(t)-exp(-t))/2]"; - Paramplot(nm+"hyp1",tmp,"t="+rng,append(options,"nodisp")); - tmp="["+format(pM_1,5)+"-"+format(a,5)+"*(exp(t)+exp(-t))/2,"; - tmp=tmp+format(pM_2,5)+"+"+format(b,5)+"*(exp(t)-exp(-t))/2]"; - Paramplot(nm+"hyp2",tmp,"t="+rng,append(options,"nodisp")); - Rotatedata(nm+"hyp1","gp"+nm+"hyp1",angle,append(options,pA));//180408 - Rotatedata(nm+"hyp2","gp"+nm+"hyp2",angle,append(options,pA));//180408 - if(length(opasy)>0, - Lineplot(nm+"asy1",[pM+[a,b],pM+[-a,-b]],["nodisp"]); - Lineplot(nm+"asy2",[pM+[-a,b],pM+[a,-b]],["nodisp"]); - Rotatedata(nm+"asy1","ln"+nm+"asy1",angle,append(opasy,pA));//180408 - Rotatedata(nm+"asy2","ln"+nm+"asy2",angle,append(opasy,pA));//180408 - ); -); - -Polygonplot(nm,ptlist,number):=Polygonplot(nm,ptlist,number,[]); -Polygonplot(nm,ptlist,number,options):=( -//help:Polygonplot("1",[A,B],12); - regional(rr,pA,pB,ptL,angle,tmp,tmp1,tmp2); - pA=Lcrd(ptlist_1); - pB=Lcrd(ptlist_2); - rr=|pB-pA|; - tmp=(pB-pA)/rr; - if(tmp_2>=0, - angle=arccos(tmp_1); - , - if(tmp_1>=0, - angle=arcsin(tmp_2); - , - angle=-arccos(tmp_1); - ); - ); - ptL=[]; - forall(0..number, - tmp=angle+#*2*pi/number; - tmp1=pA+rr*[cos(tmp),sin(tmp)]; - if(#>0 & #<number, - Putpoint((ptlist_2).name+text(#),tmp1);//16.10.07 - //Pointdata(nm,ptL); - ); - tmp2=tmp1; - ptL=append(ptL,tmp1); - ); - Listplot(nm+"ply",ptL,options); -); - -Putintersect(nm,pdata1,pdata2):=( -//help:Putintersect("Q","gr1","gr2"); - regional(pd1,pd2,tmp); - if(isstring(pdata1),pd1=parse(pdata1),pd1=pdata1); - if(isstring(pdata2),pd2=parse(pdata2),pd2=pdata2); - tmp=Intersectcrvs(pd1,pd2); - if(length(tmp)==1, - Putpoint(nm,tmp_1); - , - if(length(tmp)==0, - err("No intersect point"); - , - err("Multiple intersect points"); - println(tmp); - err("Choose point number"); - ); - ); -); -Putintersect(nm,pdata1,pdata2,ptno):=( - regional(pd1,pd2,tmp); - if(isstring(pdata1),pd1=parse(pdata1),pd1=pdata1); - if(isstring(pdata2),pd2=parse(pdata2),pd2=pdata2); - tmp=Intersectcrvs(pd1,pd2); - if(length(tmp)>0, - Putpoint(nm,tmp_ptno); - , - err("No intersect point"); - ); -); - -Arrowheaddata(point,direction):=Arrowheaddata(point,direction,[]); -Arrowheaddata(point,direction,options):=( -//help:Arrowheaddata(A,B); - regional(list,Ookisa,Hiraki,Futosa,Houkou,Str,Flg,tmp,Ev,Nv,pA,pB, - pP,rF,gG,Flg,Nj,Eps,tmp1,scx,scy); - Eps=10^(-3); - pP=point; - Ookisa=0.2*YaSize; - Hiraki=YaAngle; - Futosa=0; - Str=YaStyle; - tmp=Divoptions(options); - tmp1=tmp_6; - if(length(tmp1)>0,Ookisa=Ookisa*tmp1_1); - if(length(tmp1)>1, - tmp=tmp1_2; - if(tmp<5, - Hiraki=Hiraki*tmp; - , - Hiraki=tmp; - ); - ); - Flg=0; - Hiraki=Hiraki*pi/180; - if(isstring(direction),Houkou=parse(direction),Houkou=direction); - if(MeasureDepth(Houkou)==2,Houkou=Houkou_1); - if(islist(Houkou_1), -// pP=Lcrd(pP); -// pP=Doscaling(pP); -// Houkou=Dosscaling(Houkou); - pP=Pcrd(pP); - scy=SCALEY; - SCALEY=1; - tmp=Nearestpt(pP,Houkou); - pA=tmp_1; - rF=floor(tmp_2); - if(rF==1, - if(|Ptend(Houkou)-Ptstart(Houkou)|<Eps, - rF=Numptcrv(Houkou); - ); - ); - gG=apply(0..10,pP+Ookisa*cos(Hiraki)*[cos(2*pi/10*#),sin(2*pi/10*#)]); - Flg=0; - forall(1..rF,Nj, - if(Flg==0, - pB=Ptcrv(rF+1-Nj,Houkou); - tmp=IntersectcrvsPp([pA,pB],gG); - if(length(tmp)>0, - Houkou=pP-tmp_1_1; - Flg=1; - ); - pA=pB; - ); - ); - SCALEY=scy; - if(Flg==0, - println("Arrowhead may be too large (no intersect)"); - Flg=2; - ); - if(Flg==1, - Houkou=Unscaling(Houkou); - pP=Unscaling(pP); - ); - ); - if(Flg<2, -// pP=Doscaling(pP); -// Houkou=Doscaling(Houkou); - pP=Pcrd(pP); - if(!ispoint(point), - Houkou=Pcrd(Houkou); - ); -// if(MeasureDepth(Houkou)==0,Houkou=Pcrd(Houkou)); - Ev=-1/|Houkou|*Houkou; - Ev=Lcrd(Ev); - Nv=[-Ev_2, Ev_1]; - if(indexof(Str,"c")>0, - pP=pP-0.5*Ookisa*cos(Hiraki)*Ev; - ); - if(indexof(Str,"b")>0, - pP=pP-Ookisa*cos(Hiraki)*Ev; - ); - pA=pP+Ookisa*cos(Hiraki)*Ev+Ookisa*sin(Hiraki)*Nv; - pB=pP+Ookisa*cos(Hiraki)*Ev-Ookisa*sin(Hiraki)*Nv; - list=[pA,pP,pB]; - list=apply(list,LLcrd(#)); -// Out=Unscaling(Out); - list; - ); -); - -Arrowhead(point,Houkou):=Arrowhead(point,Houkou,[]); -Arrowhead(point,Houkou,options):=( -//help:Arrowhead(B,B-A,[1.5,30]); -//help:Arrowhead(A,"gr1"); - // global ArrowheadNumber - regional(name,Ltype,Noflg,reL,opstr,opcindy,ptstr,hostr,tmp,tmp1,list); - name="arh"+text(ArrowheadNumber); - ArrowheadNumber=ArrowheadNumber+1; - ptstr=textformat(point,5); - if(isstring(Houkou), // 15.01.11 - tmp=parse(Houkou); - if(MeasureDepth(tmp)<2, - hostr=Houkou; - , - hostr=Houkou+"(1)"; - ); - , - if(ispoint(point), - hostr=textformat(LLcrd(Houkou),5); - , - hostr=textformat(Houkou,5); - ); - ); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - reL=tmp_6; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - list=Arrowheaddata(point,Houkou,options); - if(Noflg<3, -// println("generate Arrowhead "+name); - tmp1=apply(list,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); -// GLIST=append(GLIST,name+"=Listplot("+list+")"); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(1)+Ltype,name); - , -// if(Noflg==1,Ltype=0); - Ltype=0; - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - if(Noflg==0, - if(length(reL)<3, // 16.04.09 from - forall(1..(2-length(reL)), - opstr=opstr+",1"; - ); - tmp=PenThick/PenThickInit; - opstr=opstr+","+text(tmp); - ); // 16.04.09 until - Com2nd("Arrowhead("+ptstr+","+hostr+opstr+")"); - ); -); - -Arrowdata(ptlist):=Arrowdata(ptlist,[]); -Arrowdata(Arg1,Arg2):=( - regional(tmp,nm,ptlist,flg,pA,pB,options); - flg=0; - if(isstring(Arg1), - nm=Arg1; - ptlist=Arg2; - Arrowdata(nm,ptlist,[]); - flg=1; - ); - if(flg==0, - tmp=MeasureDepth(Arg1); - if(tmp==0, - pA=Arg1; - pB=Arg2; - Arrowdata(pA,pB,[]); - , - ptlist=Arg1; - options=Arg2; - nm=text(ArrowlineNumber); - ArrowlineNumber=ArrowlineNumber+1; - Arrowdata(nm,ptlist,options); - ); - ); -); -Arrowdata(Arg1,Arg2,options):=( -//help:Arrowdata([A,B],[2,10]); -//help:Arrowdata("1",[p1,p2]); - regional(Retflg,nm,ptlist,name,opstr,opcindy,realL,strL,size, - flg,Ltype,Noflg,lineflg,tmp,tmp1,tmp2,pA,pB,segpos); - Retflg=0; - Noflg=0; - Ltype=0; - if(!isstring(Arg1), - pA=Arg1; - pB=Arg2; - Arrowdata(pA,pB,options,"old"); - Retflg=1; - ptlist=[pA,pB]; - ); - if(Retflg==0, - nm=Arg1; - ptlist=Arg2; - name="ar"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - realL=tmp_6; - strL=tmp_7; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - size=1; // 15.06.11 - if(length(realL)>0, - size=realL_1; - ); - tmp2=select(strL,indexof(#,"l")>0); // 16.04.09 - if(length(tmp2)>0,lineflg=1,lineflg=0); // 16.04.09 - segpos=1; - tmp1=tmp_5; - if(length(tmp1)>2, - segpos=tmp1_3; - ); - if(Noflg<3, -// println("generate Arrowdata "+name); - tmp1=apply(ptlist,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=Pcrd(ptlist_1);//16.10.20 - tmp2=Pcrd(ptlist_2);//16.10.20 - if(lineflg==0, // 16.04.09 from - tmp=tmp2-0.2*size/2*(tmp2-tmp1)/|tmp2-tmp1|; // 15.06.11 - , - tmp=tmp2; - ); // 16.04.09 until - tmp=[LLcrd(tmp1),LLcrd(tmp)];//16.10.20 - GLIST=append(GLIST,name+"=Listplot("+textformat(tmp,5)+")"); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - tmp=textformat(ptlist,5); - tmp=substring(tmp,1,length(tmp)-1); - tmp1=indexof(tmp,"],["); - if(tmp1>0, - pA=substring(tmp,0,tmp1); - pB=substring(tmp,tmp1+1,length(tmp)); - , - tmp1=indexof(tmp,","); - pA=substring(tmp,0,tmp1-1); - pB=substring(tmp,tmp1,length(tmp)); - ); - tmp1="Lcrd("+pA+")+" - +textformat(segpos,5)+"*(Lcrd("+pB+")-"+"Lcrd("+pA+"))"; - tmp1=parse(tmp1); - tmp2="Lcrd("+pB+")-Lcrd("+pA+")"; - tmp2=parse(tmp2); - Arrowhead(tmp1,tmp2,options); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - ); - ptlist; -); -Arrowdata(pA,pB,options,str):=( - regional(ptA,ptB,opstr,Astr,Bstr,name,tmp,opcindy); - Astr=textformat(pA,5); - Bstr=textformat(pB,5); - name="ar"+pA.name+pB.name; - println("generate Arrow "+name); - opstr=""; - opcindy=""; - forall(options, - if(isstring(#), - if(indexof(#,"->")>0, - opcindy=opcindy+","+#; - , - tmp="'"+#+"'"; - ); - , - tmp=text(#); - ); - opstr=opstr+","+tmp; - ); - ptA=Lcrd(pA); - ptB=Lcrd(pB); - Arrowheaddata(ptB,ptB-ptA,options); - tmp="connect("+textformat([ptA,ptB],5) - +",linecolor->"+text(KCOLOR)+opcindy+");"; - parse(tmp); // 14.11.17 - Com2nd("Arrowline("+Astr+","+Bstr+opstr+")"); // 14.10.04 -); - -Anglemark(plist):=Anglemark(plist,[]); -Anglemark(Arg1,Arg2):=( // 2015.04.28 from - regional(nm,plist,options,tmp); - if(isstring(Arg1), - nm=Arg1; - plist=Arg2; - Anglemark(nm,plist,[]); - , - plist=Arg1; - options=Arg2; - tmp=textformat(plist,5); - tmp=replace(tmp,",",""); - nm=substring(tmp,1,length(tmp)-1); - Anglemark(nm,plist,options); - ); -); // until -Anglemark(nm,plist,options):=( -//help:Anglemark([A,B,C],["E=\theta",2]); -//help:Anglemark("1",[A,B,C],["E=1.2,\theta",2]); -//help:Anglemark(options=["E/L=(sep,)letter",size]); - regional(name,Out,pB,pA,pC,Ctr,ra,sab,sac,ratio,opstr,Bname,Bpos, - Brat,tmp,tmp1,tmp2,Num,opcindy,Ltype,eqL,realL,Rg,Th,Noflg); - name="ag"+nm; - Bpos="md"+name; - ra=0.5; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - eqL=tmp_5; - realL=tmp_6; - Bname=""; - Brat=1.5; - Num=20; - if(length(realL)>0, - ra=realL_1*ra; - opstr=opstr+","+text(realL_1); - ); - forall(eqL, - if(substring(#,0,1)=="L",Bname="Letter("); - if(substring(#,0,1)=="E",Bname="Expr("); - Bname=Bname+Bpos+","+Dq+"c"+Dq+","+Dq;//16.10.29 - tmp=substring(#,indexof(#,"="),length(#)); - tmp1=indexof(tmp,","); - Bname=Bname+substring(tmp,tmp1,length(tmp))+Dq+")"; - if(tmp1>0, - Brat=parse(substring(tmp,0,tmp1-1)); - ); - ); - pB=Lcrd(plist_1); pA=Lcrd(plist_2); pC=Lcrd(plist_3); - Ctr=Lcrd(pA); - sab=pB-pA; - sac=pC-pA; - Rg=[arctan2(sab)+0,arctan2(sac)+0]; - if(Rg_2<Rg_1,Rg_2=Rg_2+2*pi); - Out=[]; - if(ra>min(|sab|,|sac|), // 16.12.29 - println(" segments too short"); - , - forall(0..Num, - Th=Rg_1+#*(Rg_2-Rg_1)/Num; - Out=append(Out,Ctr+ra*[cos(Th),sin(Th)]); - ); - Th=(Rg_1+Rg_2)/2; //16.10.31from(moved) - tmp1=Ctr+Brat*ra*[cos(Th),sin(Th)]; - tmp="Defvar("+Dq+Bpos+"="; - tmp=tmp+textformat(tmp1,5)+Dq+");"; - parse(tmp);//16.10.31until(moved) - if(length(Bname)>0, - parse(Bname); - ); - if(Noflg<3, - println("generate anglemark "+name+" and "+Bpos); - tmp1=apply(Out,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp=textformat(plist,5); - tmp1=substring(tmp,1,length(tmp)-1); - tmp=name+"=Anglemark("+tmp1+opstr+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - ); - Out; -); - -Paramark(plist):=Paramark(plist,[]); -Paramark(Arg1,Arg2):=( // 17.03.27 from - regional(nm,plist,options,tmp); - if(isstring(Arg1), - nm=Arg1; - plist=Arg2; - Paramark(nm,plist,[]); - , - plist=Arg1; - options=Arg2; - tmp=textformat(plist,5); - tmp=replace(tmp,",",""); - nm=substring(tmp,1,length(tmp)-1); - Paramark(nm,plist,options); - ); -);// until -Paramark(nm,plist,options):=( -//help:Paramark([A,B,C],["E=\theta"]); -//help:Paramark("1",[p1,p2,p3],["E=\theta"]); - regional(name,Out,pB,pA,pC,ra,sab,sac,ratio,opstr,Bname,Bpos, - Brat,tmp,tmp1,tmp2,Ltype,Noflg,eqL,realL,opcindy); - name="pm"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - eqL=tmp_5; - realL=tmp_6; - ra=0.5; - Bname=""; - Brat=1.2; - if(length(realL)>0, - tmp=realL_1; - ra=tmp*ra; - opstr=opstr+","+text(tmp); - ); - forall(eqL, - if(substring(#,0,1)=="L",Bname="Letter("); - if(substring(#,0,1)=="E",Bname="Expr("); - Bpos="md"+name; - Bname=Bname+Dq+Bpos+Dq+","+Dq+"c"+Dq+","+Dq; - tmp=substring(#,indexof(#,"="),length(#)); - tmp1=indexof(tmp,","); - Bname=Bname+substring(tmp,tmp1,length(tmp))+Dq+")"; - if(tmp1>0, - Brat=parse(substring(tmp,0,tmp1-1)); - ); - ); - pB=Lcrd(plist_1); pA=Lcrd(plist_2); pC=Lcrd(plist_3); - Ctr=Lcrd(pA); - Out=[]; - Out=append(Out,pA+ra*(pB-pA)/|pB-pA|); - Out=append(Out,pA+ra*(pB-pA)/|pB-pA|+ra*(pC-pA)/|pC-pA|); - Out=append(Out,pA+ra*(pC-pA)/|pC-pA|); - if(length(Bname)>0, - tmp1=pA+Brat*ra*(pB-pA)/|pB-pA|+Brat*ra*(pC-pA)/|pC-pA|; - tmp="Defvar("+Dq+Bpos+"="+textformat(tmp1,5)+Dq+");"; - parse(tmp); - parse(Bname); - ); - if(Noflg<3, - println("generate paramark "+name); - tmp1=apply(Out,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=substring(textformat(plist,5),1,length(textformat(plist,5))-1); - tmp=name+"=Paramark("+tmp1+opstr+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - Out; -); - -MakeBowdata(pA,pB,Hgt):=( - regional(angle,pB2,pH2,pC2,pC,tmp,Th1,Th2,ra,dMA); - angle=arctan2(pB-pA)+0; - pB2=Rotatepoint(pB,-angle,pA); - tmp=Lcrd(pA); - pH2=[(tmp_1+pB2_1)/2,tmp_2-Hgt]; - dMA=|tmp-pB2|/2; - ra=(dMA^2+Hgt^2)/(2*Hgt); - pC2=[pH2_1,pB2_2+(ra-Hgt)]; - pC=Rotatepoint(pC2,angle,pA); - Th1=arctan2(pA-pC2)+angle; - Th2=arctan2(pB2-pC2)+angle; - [pC,ra,Th1,Th2]; -); - -Bowdata(plist):=Bowdata(plist,[]); -Bowdata(plist,options):=( - regional(nm,tmp); - if(islist(plist), // 16.12.04from - tmp=textformat(plist,5); - tmp=replace(tmp,",",""); - nm=substring(tmp,1,length(tmp)-1); - Bowdata(nm,plist,options); - , - nm=plist; - tmp=options; - Bowdata(nm,tmp,[]); - ); // 16.12.04until -); -Bowdata(nm,plist,options):=( -//help:Bowdata([C,A],[2,1.2,"Expr=10","da"]); -//help:Bowdata([A,B],["Expr=t0n3,a"]); -//help:Bowdata([A,B],["Exprrot=t0n2r,a"]); - regional(name,Out,pB,pA,pC,ra,tmp,tmp1,tmp2,Ltype,eqL,realL, - Bname,Bpos,Th,Cut,Num,Hgt,opstr,opcindy,Ydata,pC, - Th1,Th2,Noflg,Bops,Bmov,Tmov,Nmov,rev); - name="bw"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - eqL=tmp_5; - realL=tmp_6; - pA=Lcrd(plist_1); pB=Lcrd(plist_2); - Hgt=1/2*|pB-pA|*0.2; - Cut=0; - Num=24; - Bname=""; - Tmov=0;//16.11.01from - Nmov=0; - Bmov=""; - rev=0;//16.11.01until - if(length(realL)>0, - Hgt=realL_1*Hgt; // 15.04.12 - if(length(realL)>1,Cut=realL_2); - ); - forall(eqL, - tmp=substring(#,0,1); - if(tmp=="L" % tmp=="l", - if(indexof(#,"rot")>0, - Bname="Letterrot("; - , - Bname="Letter("; - ); - ); - if(tmp=="E" % tmp=="e", - if(indexof(#,"rot")>0, - Bname="Exprrot("; - , - Bname="Expr("; - ); - ); - tmp=indexof(#,"="); - Bops=substring(#,tmp,length(#)); // 16.11.01 - ); - Ydata=MakeBowdata(pA,pB,Hgt); - pC=Ydata_1; - ra=Ydata_2; - Th=(Ydata_3+Ydata_4)*0.5; - BOWMIDDLE=[pC_1+ra*cos(Th),pC_2+ra*sin(Th)]; - Bpos="md"+name; // 16.10.31from(moved) - tmp="Defvar("+Dq+Bpos+"="+textformat(BOWMIDDLE,5)+Dq+");"; - parse(tmp);// 16.10.31until(moved) - if(length(Bname)>0, //16.11.01from - tmp=indexof(Bops,","); - if(tmp>0, - tmp1=substring(Bops,0,tmp-1); - if(length(tmp1)>=4 & substring(tmp1,0,1)=="t" & indexof(tmp1,"n")>0, - Bmov=tmp1; - Bops=substring(Bops,tmp,length(Bops)); - ); - ); - if(length(Bmov)>0, - tmp=indexof(Bmov,"t"); - if(tmp>0, - tmp1=indexof(Bmov,"n"); - Tmov=parse(substring(Bmov,tmp,tmp1-1)); - tmp=indexof(Bmov,"r"); - if(tmp>0, - Nmov=parse(substring(Bmov,tmp1,tmp-1)); - rev=1; - , - Nmov=parse(substring(Bmov,tmp1,length(Bmov))); - ); - ); - ); - Bname=Bname+Bpos;//16.11.01 - if(abs(Tmov)+abs(Nmov)>0, - tmp=Pcrd(pA)-Pcrd(pB); - tmp1=1/norm(tmp)*tmp; - tmp2=[-tmp1_2,tmp1_1]; - tmp=MARKLEN*(Tmov*tmp1+Nmov*tmp2); - tmp=LLcrd(tmp); - Bname=Bname+"+"+text(tmp); - ); - Bname=Bname+","; - if(indexof(Bname,"rot")>0, - if(rev==1,tmp=pB-pA,tmp=pA-pB); - Bname=Bname+textformat(tmp,5)+","; - , - Bname=Bname+Dq+"c"+Dq+","; - ); - Bname=Bname+Dq+Bops+Dq+")"; - parse(Bname); - );//16.11.01until - if(Cut==0, - Th1=Ydata_3; - Th2=Ydata_4; - Out=[]; - forall(0..Num, - tmp=Th1+#*(Th2-Th1)/Num; - Out=append(Out,pC+ra*[cos(tmp),sin(tmp)]); - ); - , - Th1=Ydata_3; - Th2=Th-Cut/(2*ra); - tmp1=[]; - forall(0..Num/2, - tmp=Th1+#*(Th2-Th1)/(Num/2); - tmp1=append(tmp1,pC+ra*[cos(tmp),sin(tmp)]); - ); - Th1=Th+Cut/(2*ra); - Th2=Ydata_4; - tmp2=[]; - forall(0..Num/2, - tmp=Th1+#*(Th2-Th1)/(Num/2); - tmp2=append(tmp2,pC+ra*[cos(tmp),sin(tmp)]); - ); - Out=[tmp1,tmp2]; - ); - if(Noflg<3, - println("generate bowdata "+name+" and "+Bpos);//16.10.31 - if(MeasureDepth(Out)==1,Out=[Out]); - tmp1=[]; - forall(Out,tmp2, - tmp=apply(tmp2,Pcrd(#)); - tmp1=append(tmp1,tmp); - ); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=substring(textformat(plist,5),1,length(textformat(plist,5))-1); - tmp=name+"=Bowdata("+tmp1+opstr+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); -); - -Bowname(str):=Bowname("c",str); -Bowname(dir,str):=( - Expr([BOWMIDDLE,dir,str]); -); - -Bownamerot(bwdata,str):=Bownamerot(bwdata,0,0,str,1); -Bownamerot(bwdata,str,updown):=Bownamerot(bwdata,0,0,str,updown); -Bownamerot(bwdata,tmov,nmov,str):=Bownamerot(bwdata,tmov,nmov,str,1); -Bownamerot(bwdata,tmov,nmov,str,updown):=( - regional(bdata,tmp); - tmp=MeasureDepth(bwdata); - if(tmp==1,bdata=[bwdata],bdata=bwdata); - if(length(bdata)>1, - tmp=Ptend(bdata_2)-Ptstart(bdata_1); - , - tmp=Ptend(bdata_1)-Ptstart(bdata_1); - ); - if(updown<0,tmp=-tmp); - Exprrot(BOWMIDDLE,tmp,tmov,nmov,str); -); - -Deqdata(deq,rng,initt,initf,Num):=( //17.10.04 -// Deqdata("[x1,...xn]`=[f1,...fn]","t=[0,20]",0,[...],50); - regional(Eps,Inf,tname,Xname,func,t1,t2,dt,tt,X0,flg, - kl1,kl2,kl3,kl4,pdL,tmp,tmp1,tmp2); - Eps=10^(-3); - Inf=10^3; - tmp=tokenize(deq,"="); - tmp1=replace(tmp_1,"`",""); - tmp1=substring(tmp1,1,length(tmp1)-1); - Xname=tokenize(tmp1,","); - func=tmp_2; - forall(1..(length(Xname)), - func=replace(func,Xname_#,"X_"+text(#)); - ); - tmp=tokenize(rng,"="); - tname=tmp_1; - tmp=parse(tmp_2); - t1=tmp_1; - t2=tmp_2; - tmp="funP("+tname+",X):="+func+";"; - parse(tmp); - tmp="funN("+tname+",X):=-"+func+";"; - parse(tmp); - dt=(t2-t1)/Num; - tt=initt; - X0=Lcrd(initf); - pdL=[flatten([tt,X0])]; - flg=0; - forall(1..floor((t2-initt)/dt), - if(flg==0, - kl1=dt*funP(tt,X0); - kl2=dt*funP(tt+dt/2,X0+kl1/2); - kl3=dt*funP(tt+dt/2,X0+kl2/2); - kl4=dt*funP(tt+dt,X0+kl3); - X0=X0+(kl1+2*kl2+2*kl3+kl4)/6; - tt=initt+#*dt; - tmp=flatten([tt,X0]); - pdL=append(pdL,tmp); - if(|tmp|>Inf,flg=1); - ); - ); - tt=initt; - X0=Lcrd(initf); - flg=0; - forall(1..floor((initt-t1)/dt), - if(flg==0, - kl1=dt*funN(tt,X0); - kl2=dt*funN(tt+dt/2,X0+kl1/2); - kl3=dt*funN(tt+dt/2,X0+kl2/2); - kl4=dt*funN(tt+dt,X0+kl3); - X0=X0+(kl1+2*kl2+2*kl3+kl4)/6; - tt=initt-#*dt; - tmp=flatten([tt,X0]); - pdL=prepend(tmp,pdL); - if(|tmp1|>Inf,flg=1); - ); - ); - pdL; -); - -Deqplot(nm,deq,rng,initf):=Deqplot(nm,deq,rng,Lcrd(initf)_1,initf,[]); -Deqplot(nm,deq,rng,Arg1,Arg2):=( - regional(initt,initf,options); - if(isreal(Arg1) & !islist(Arg1), - initt=Arg1; - initf=Arg2; - options=[]; - , - initf=Lcrd(Arg1); - initt=initf_1; - options=Arg2; - ); - Deqplot(nm,deq,rng,initt,initf,options); -); -Deqplot(nm,deqorg,rngorg,initt,initf,options):=( //17.10.06 -//help:Deqplot("2","y`=y*(1-y)","x",0, 0.5,["Num=100"]); -//help:Deqplot("1","y``=-y","x",0, [1,0]); -//help:Deqplot("3","[x,y]`=[x*(1-y),0.3*y*(x-1)]","t=[0,20]",0,[1,0.5]); - regional(deq,rng,Ltype,Noflg,eqL,opcindy,Num,name,nn,pdL,phase, - sel,tmp,tmp1,tmp2); - name="de"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - opcindy=tmp_(length(tmp)); - Num=50; - forall(eqL, - tmp=indexof(#,"="); - tmp2=substring(#,0,1); - tmp2=Toupper(tmp2); - tmp1=substring(#,tmp,length(#)); - if(Toupper(substring(#,0,1))=="N", - Num=parse(tmp1); - ); - ); - rng=rngorg; - if(indexof(rng,"=")==0, - rng=rng+"="+textformat([XMIN,XMAX],6); - ); - deq=deqorg; - tmp=indexof(deq,"="); - tmp1=substring(deq,0,tmp-1); - if(indexof(tmp1,"[")==0, - phase=0; - sel=[1,2]; - , - phase=1; - sel=[2,3]; - ); - tmp2=substring(deq,tmp,length(deq)); - nn=length(Indexall(tmp1,"`")); - if(nn==1, - if(indexof(tmp1,"[")==0, - tmp1="["+replace(tmp1,"`","]`"); - deq=tmp1+"="+tmp2; - ); - , - tmp=indexof(tmp1,"`"); - tmp1=substring(tmp1,0,tmp-1); - deq="["; - forall(1..nn, - deq=deq+tmp1+"N"+text(#)+","; - ); - deq=substring(deq,0,length(deq)-1)+"]`=["; - forall(1..(nn-1), - deq=deq+tmp1+"N"+text(#+1)+","; - ); - forall(reverse(1..(nn)),jj, - tmp=tmp1; - forall(1..jj, - tmp=tmp+"`"; - tmp2=replace(tmp2,tmp,tmp1+"N"+text(#+1)); - ); - ); - tmp2=tmp2+"]"; - forall(1..(length(tmp2)-1), - tmp=substring(tmp2,#-1,#); - if(tmp!=tmp1, - deq=deq+tmp; - , - tmp=substring(tmp2,#,#+1); - if(tmp=="N", - deq=deq+tmp1; - , - deq=deq+tmp1+"N1" - ); - ); - ); - deq=deq+"]"; - ); - if(Noflg<3, - pdL=deqdata(deq,rng,initt,initf,Num); - if(phase==1, - pdL=apply(pdL,#_(2..3)); - ); - tmp1=apply(pdL,Pcrd(#)); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - ); - if(Noflg<1, - tmp=Assign(deq); - tmp=replace(deq,"'","`"); - tmp=name+"=Deqplot('"+tmp+"','"+rng+"',"; - tmp=tmp+format(initt,6)+","+textformat(initf,6); - tmp=tmp+","+text(sel)+",'Num="+text(Num)+"')"; - tmp=RSform(tmp); - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); -); - -////////// old enclosing /////////////// - -Enclosing(nm,plist):=EnclosingS(nm,plist); -Enclosing(nm,plist,options):=EnclosingS(nm,plist,options); -EnclosingS(nm,plist):=EnclosingS(nm,plist,[]); -EnclosingS(nm,plist,options):=( -//help:Enclosing("1",["sc2","crAB","sc2","Invert(sc1)"],[pt,"dr"]); - regional(name,AnsL,Start,Eps,EEps,S,Flg,Fdata,Gdata,KL,pt,qt, - t1,t2,t3,ii,nn,tmp,tmp1,tmp2,Ltype,Noflg,realL,eqL,opstr,opcindy); - name="en"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - realL=tmp_6; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - Eps=10^(-5); // 16.12.05 - EEps=0.05; - Start=[]; - Flg=0; - forall(realL, - if(isList(#) % ispoint(#), - Start=Lcrd(#); // 15.09.12 - , - Flg=Flg+1; - if(Flg==1,Eps=#); - if(Flg==2,EEps=#); - ); - ); -// tmp1=concat([Eps,EEps],eqL); // 15.04.06 - Fdata=plist_1; - Gdata=plist_(length(plist)); - KL=IntersectcrvsPp(Fdata,Gdata); - if(length(KL)==1, - pt=KL_1_1; - t1=KL_1_2; - ); - if(length(KL)==0, - if(Numptcrv(Fdata)>Numptcrv(Gdata), - tmp=Nearestpt(Fdata,Gdata); - pt=tmp_1; - t1=tmp_2; - , - tmp=Nearestpt(Gdata,Fdata); - pt=tmp_3; - t1=tmp_4; - ); - ); - if(length(KL)>1, - if(Start==[], - err("No Start Point"); - , - pt=KL_1_1; - t1=KL_1_2; - tmp=|pt-Start|; - forall(2..(length(KL)),ii, // 15.04.20 - tmp1=KL_ii_1; - tmp2=|tmp1-Start|; // 15.04.20 - if(tmp2<tmp, - pt=tmp1; - t1=KL_ii_2; - tmp=tmp2; - ); - ); - ); - ); -// pt=Pcrd(pt); // 15.09.12 - Start=pt; - AnsL=[]; - forall(1..(length(plist)),nn, - Fdata=plist_nn; - if(nn>1, pt=qt); - if(nn==length(plist), - qt=Start; - , - Flg=0; - Gdata=plist_(nn+1); -// tmp1=concat([Eps,EEps],eqL); // 15.04.06 - KL=IntersectcrvsPp(Gdata,Fdata); - if(length(KL)==1, - tmp=KL_1; - qt=KL_1_1; - t3=KL_1_2; - Flg=10; - ); - if(length(KL)==0,Flg=1); - if(length(KL)>1, - tmp1=KL_1_1; - tmp2=KL_2_1; - tmp=|tmp1-tmp2|; - if(tmp<Eps*10, Flg=1); - ); - if(Flg==1, - if(Numptcrv(Fdata)>Numptcrv(Gdata), - tmp=Nearestpt(Fdata,Gdata); - qt=tmp_1; - t3=tmp_4; - Flg=10; - , - tmp=Nearestpt(Gdata,Fdata); - qt=tmp_3; - t3=tmp_2; - Flg=10; - ); - ); - if(Flg<10, - t2=10^6; //%inf; - forall(1..(length(KL)),ii, - tmp1=KL_ii_1; - tmp=KL_ii_3; - tmp2=ParamonCurve(tmp1,tmp,Fdata); - tmp3=KL_ii_2; - if(tmp2>t1+Eps & tmp2<t2+Eps, - qt=tmp1; - t2=tmp2; - t3=tmp3; - ); - ); - ); - ); - tmp=Partcrv("",pt,qt,Fdata,["nodata"]); - t1=t3; - if(nn==1, - AnsL=tmp; - , - AnsL=concat(AnsL,tmp_(2..(length(tmp)))); - ); - ); - AnsL=apply(AnsL,Pcrd(#)); // 15.09.12 - AnsL_(length(AnsL))=AnsL_1;//16.10.20 - if(Noflg<3, - println("generate Enclosing "+name); - tmp=name+"="+textformat(AnsL,5); - parse(tmp); - tmp=name+"=Enclosing(";//16.11.07from - tmp1="list("; - forall(plist, - tmp1=tmp1+#+","; - ); - tmp=tmp+substring(tmp1,0,length(tmp1)-1)+")"+opstr+")"; - GLIST=append(GLIST,tmp);//16.11.07until - // GLIST=append(GLIST,"Tmp=[]"); // 16.11.05from -// nn=floor(length(AnsL)/20); -// forall(1..nn,ii, -// tmp=AnsL_(((ii-1)*20+1)..(ii*20)); -// tmp=apply(tmp,LLcrd(#)); -// tmp="Tmp=[Tmp,"+textformat(tmp,5)+"]"; -// GLIST=append(GLIST,tmp); -// ); -// if(length(AnsL)>nn*20, -// tmp=AnsL_((nn*20+1)..(length(AnsL))); -// tmp=apply(tmp,LLcrd(#)); -// tmp="Tmp=[Tmp,"+textformat(tmp,5)+"]"; -// GLIST=append(GLIST,tmp); -// ); -// GLIST=append(GLIST,name+"=Listplot(Tmp)"); // 16.11.05until - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - tmp=apply(AnsL,LLcrd(#));//16.10.20 - tmp; -); - -/////////// new enclosing /////////// - -Enclosing2(nm,plist):=Enclosing2(nm,plist,[]); -Enclosing2(nm,plistorg,options):=( -//help:Enclosing2("1",["sc2","crAB","sc2","Invert(sc1)"]); -//help:Enclosing2(options=[Eps1(0.01),Eps2(0.1)]); - regional(name,plist,AnsL,Start,Eps,Eps1,Eps2,flg,Fdata,Gdata,KL, - t1,t2,tst,ss,ii,nn,nxtno,Ltype,Noflg,realL,eqL,opstr,opcindy, - tmp,tmp1,tmp2); - name="en"+nm; - plist=plistorg; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - eqL=tmp_5; - realL=tmp_6; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - Eps=10^(-5); // 16.12.05 - Eps1=0.01; - Eps2=0.1; - Start=[]; - flg=0; - forall(realL, - if(isList(#) % ispoint(#), -// Start=Lcrd(#); // 18.02.02 - , - if(flg==0,Eps1=#); - if(flg==1,Eps2=#); - flg=flg+1; - ); - ); - flg=0; - AnsL=[]; - if(length(plist)==1, - Fdata=parse(plist_1); - tmp1=Fdata_1; - tmp2=Fdata_(length(Fdata)); - if(|tmp1-tmp2|<Eps, - AnsL=Fdata; - , - AnsL=append(Fdata,tmp1); - ); - flg=1; - ); - if(flg==0, - Fdata=plist_1; - Gdata=plist_(length(plist)); - KL=IntersectcurvesPp(Fdata,Gdata); - if(length(KL)==0, - tmp=parse(Gdata); - tmp1=LLcrd(Op(length(tmp),tmp)); //18.02.02from - tmp=parse(Fdata); - tmp2=LLcrd(Op(1,tmp)); - tmp=Listplot(name,[tmp1,tmp2],["nodisp"]); - plist=append(plist,"sg"+name); - Start=tmp2; - tst=1; //18.02.02until - , - if(length(KL)==1, - tst=KL_1_2; - Start=Pointoncurve(tst,Fdata); - ); - if(length(KL)>1, - KL=sort(KL,[#_2]); - if(Start==[], - tst=KL_1_2; - Start=Pointoncurve(tst,Fdata); - , - tmp=apply(KL,|#_1-Start|); - tmp=min(tmp); - tmp1=select(KL,|#_1-Start|==tmp); - tst=tmp1_1_2; - Start=Pointoncurve(tst,Fdata); - ); - ); - ); - ); - if(flg==0, - t1=tst; - println("Start point of enclosing is "+text(Start)); - forall(1..(length(plist)),nn, - Fdata=plist_nn; - if(nn==length(plist),nxtno=1,nxtno=nn+1); - Gdata=plist_nxtno; - KL=IntersectcurvesPp(Fdata,Gdata); - if(length(KL)==0, - tmp1=parse(Fdata); //18.02.02from - tmp2=parse(Gdata); - tmp2=Prepend(Op(length(tmp1),tmp),tmp2); - Gdata=replace(Gdata,"(",""); - Gdata=replace(Gdata,")",""); - tmp=Gdata+"="+textformat(tmp2,6); - parse(tmp); - plist_nxtno=Gdata; - t2=Length(tmp1); - ss=1; //18.02.02until - , - t2=KL_1_2; - ss=KL_1_3; - if(abs(t2-t1)<Eps, - if(length(KL)>1, - t2=KL_2_2; - ss=KL_2_3; - , - println(text(nn)+" and "+text(nxtno)+" not intersect"); - flg=1; - ); - ); - ); - if(flg==0, - tmp=Partcrv("",t1,t2,Fdata,["nodata"]); - if(nn==1, - AnsL=tmp; - , - AnsL=concat(AnsL,tmp_(2..(length(tmp)))); - ); - t1=ss; - ); - ); - ); - if(flg==0, - AnsL=apply(AnsL,Pcrd(#)); - ); - if(Noflg<3, - println("generate Enclosing "+name); - tmp=name+"="+textformat(AnsL,5); - parse(tmp); - tmp=name+"=Enclosing2(";//16.11.07from - tmp1="list("; - forall(plistorg, //18.02.02 - tmp1=tmp1+#+","; - ); - tmp=tmp+substring(tmp1,0,length(tmp1)-1)+"))";//18.02.02 - GLIST=append(GLIST,tmp);//16.11.07until - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - tmp=apply(AnsL,LLcrd(#));//16.10.20 - tmp; -); - -/////////// end of new enclosing /////////// - -/////////// new Hatchdata(cindy) /////////// - -Makehatch(iolistorg,pt,vec,bdylist):=( - regional(Eps,iolist,sg,bdy,out,nb,tenL,ns,ne,ioL, - ii,jj,kk,nvec,nbdy,sgn1,sgn2,flg,rmL,p0,p1,p2,pL, - Scalebkup,tmp,tmp1,tmp2); - Eps=10^(-6); - nvec=[-vec_2,vec_1]; - nvec=nvec/|nvec|; - if(!islist(iolistorg),iolist=[iolistorg],iolist=iolistorg); - forall(1..(length(iolist)), - tmp=replace(iolist_#,"i","1,"); - tmp=replace(tmp,"o","0,"); - tmp="["+substring(tmp,0,length(tmp)-1)+"]"; - iolist_#=parse(tmp); - ); - Scalebkup=SCALEY; - SCALEY=1; - sg=Lineplot("",[pt,pt+vec],["nodata"]); - nb=length(bdylist); - if(nb>0, - tenL=[]; - forall(1..nb,ii, - rmL=[]; - bdy=bdylist_ii; - nbdy=length(bdy)-1; - pL=[]; - forall(1..nbdy,jj, - p1=bdy_jj; - p2=bdy_(mod(jj+1-1,nbdy)+1); - tmp=Intersectseg(sg,[p1,p2],Eps); - if(abs(tmp_1)<Eps, //18.02.01 - p0=tmp_2; t=tmp_3; s=tmp_4; - pL=append(pL,[p0,t,s,ii]); - ); - ); - if(length(pL)>0, - pL=sort(pL,[#_2]); - pL=apply(1..(length(pL)),append(pL_#,mod(#,2))); - tenL=concat(tenL,pL); - ); - ); - tenL=sort(tenL,[#_2]); - ioL=apply(1..nb,0); - ns=1; - ne=length(tenL); - if(ne>0,tmp=tenL_1_1,tmp=sg_2); - if(|sg_1-tmp|>Eps, - tmp=[sg_1,-1,1,ioL]; - tenL=prepend(tmp,tenL); - ns=ns+1; - ne=ne+1; - ); - if(|sg_2-tenL_(length(tenL))_1|>Eps, - tmp=[sg_2,-1,2,ioL]; - tenL=append(tenL,tmp); - ); - forall(ns..ne,ii, - tmp=tenL_ii; - tmp1=tmp_4; - tmp2=tmp_5; - ioL_tmp1=tmp2; - tmp=[tmp_1,tmp_2,tmp_4,ioL]; - tenL_ii=tmp; - ); - out=[]; - forall(1..(length(tenL)-1),ii, - tmp1=tenL_ii; - if(contains(iolist,tmp1_4), - tmp2=tenL_(ii+1); - tmp=Listplot("",[tmp1_1,tmp2_1],["nodata"]); - out=append(out,tmp); - ); - ); - ); - SCALEY=Scalebkup; - out; -); - -Hatchdatacindy(nm,iostr,bdylist):=Hatchdatacindy(nm,iostr,bdylist,[]); -Hatchdatacindy(nm,iostr,bdylistorg,options):=( -//help:Hatchdatacindy("1",["ii"],[["ln1","Invert(gr1)"],["gr2","n"]]); -//help:Hatchdatacindy(options=[angle,width]); - regional(name,bdylist,bdynameL,bname,Ltype,Noflg,opstr,opcindy,reL,startP,angle, - interval,vec,nvec,flg,pt,kk,delta,sha,AnsL,tmp,tmp1,tmp2); - name="ha"+nm; - bdylist=[]; - bdynameL=[]; - forall(1..(length(bdylistorg)),kk, - tmp1=bdylistorg_kk; - if(length(tmp1)==1, - bname=tmp1_1; - , - tmp=tmp1_(length(tmp1)); - if(contains(["n","s","e","w"],tmp), - tmp2=parse(tmp1_1); - if(tmp=="s", - Listplot(name,[LLcrd(tmp2_1),[tmp2_1_1,YMIN], - [tmp2_(length(tmp2))_1,YMIN],LLcrd(tmp2_(length(tmp2)))],["nodisp"]); - Joincrvs(text(kk)+name,[tmp1_1,"sg"+name],["nodisp"]); - bname="join"+text(kk)+name; - ); - if(tmp=="n", - Listplot(name,[LLcrd(tmp2_1),[tmp2_1_1,YMAX], - [tmp2_(length(tmp2))_1,YMAX],LLcrd(tmp2_(length(tmp2)))],["nodisp"]); - Joincrvs(text(kk)+name,[tmp1_1,"sg"+name],["nodisp"]); - bname="join"+text(kk)+name; - ); - if(tmp=="e", - Listplot(name,apply([tmp2_1,[XMAX,tmp2_1_2], - [XMAX,tmp2_(length(tmp2))_2],tmp2_(length(tmp2))],LLcrd(#)),["nodisp"]); - Joincrvs(text(kk)+name,[tmp1_1,"sg"+name],["nodisp"]); - bname="join"+text(kk)+name; - ); - if(tmp=="w", - Listplot(name,apply( [tmp2_1,[XMIN,tmp2_1_2], - [XMIN,tmp2_(length(tmp2))_2],tmp2_(length(tmp2))],LLcrd(#)),["nodisp"]); - Joincrvs(text(kk)+name,[tmp1_1,"sg"+name],["nodisp"]); - bname="join"+text(kk)+name; - ); - , - Enclosing2(text(#)+name,tmp,["nodisp"]); - bname="en"+text(#)+name; - ); - ); - bdylist=append(bdylist,parse(bname)); - bdynameL=append(bdynameL,bname); - ); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - reL=tmp_6; - angle=45; - interval=0.125*1000/2.54/MilliIn; - startP=[(XMIN+XMAX)/2, (YMIN+YMAX)/2]; - tmp1=1; - forall(reL, - if(islist(#), - startP=#; - , - if(tmp1==1, - angle=#; - tmp1=tmp1+1; - , - interval= interval*#; - ); - ); - ); - angle=angle*pi/180; - vec=[cos(angle),sin(angle)]; - nvec=[-sin(angle),cos(angle)]; - AnsL=[]; - flg=0; - forall(0..100,kk, - pt=startP+kk*interval*nvec; - if(flg==0, - sha=Makehatch(iostr,pt,vec,bdylist); - if((sha==-1)%(length(sha)==0), -// flg=1; - , - AnsL=concat(AnsL,sha); - ); - ); - ); - flg=0; - forall(1..100,kk, - pt=startP-kk*interval*nvec; - if(flg==0, - sha=Makehatch(iostr,pt,vec,bdylist); - if((sha==-1)%(length(sha)==0), -// flg=1; - , - AnsL=concat(AnsL,sha); - ); - ); - ); - if(Noflg<3, - println("generate Hatchdata "+name); - tmp=name+"="+textformat(AnsL,5); - parse(tmp); - if(!islist(iostr),tmp1=[iostr],tmp1=iostr); - tmp="c("; - forall(tmp1, - tmp=tmp+Dq+#+Dq+","; - ); - tmp=substring(tmp,0,length(tmp)-1)+")"; - tmp2=name+"=Hatchdata("+tmp; - forall(bdynameL, - tmp2=tmp2+",list("+#+")"; - ); - tmp2=tmp2+opstr+")"; - GLIST=append(GLIST,tmp2); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - tmp2=[]; - forall(AnsL,tmp1, - tmp=apply(tmp1,LLcrd(#)); - tmp2=append(tmp2,tmp); - ); - tmp2; -); - -/////////// end of new Hatchdata(cindy) /////////// - - -Shade(plist):=Shade(plist,[]); -Shade(plist,options):=( -//help:Shade(["gr2","sg1"],[0.5]); -//help:Shade(["gr2","sg1"],["red" /pict2e]); -//help:Shade(["gr2","sg1"],[[0,0,0,0.5] /pict2e]); -//help:Shade(["gr2","sg1"],[[1,0,0] /pict2e]); -//help:Shade([pointlist]); - regional(tmp,tmp1,tmp2,opstr,opcindy,Str,G2,flg); - if(isstring(plist_1), // 16.01.24 - println("output Shade of "+plist); - , - println("output Shade of lists"); - ); - tmp=Divoptions(options); - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - flg=0; - forall(plist, - if(flg==0, - if(isstring(#),tmp=parse(#),tmp=#); // from 16.01.24 - if(!islist(tmp),flg=1); until - ); - ); - if(flg==1, -// err("some data not defined yet"); - , - G2=Joincrvs("1",plist,["nodata"]); - G2=apply(G2,Pcrd(#)); - tmp1="fillpoly("+textformat(G2,5)+opcindy+");"; - parse(tmp1); - ); - Str="Shade("; - tmp1="list("; - forall(plist, - if(isstring(#), // from 16.01.24 - if(length(#)>1, - tmp1=tmp1+#+","; - , - tmp1=tmp1+Dq+#+Dq+","; - ); - , - tmp1=tmp1+"Listplot("+textformat(#,5)+"),"; - ); // until 16.01.24 - ); - Str=Str+substring(tmp1,0,length(tmp1)-1)+")"+opstr+")"; - Com2nd(Str); -); - -//help:end(); - diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt deleted file mode 100644 index 6510040a..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt +++ /dev/null @@ -1,87 +0,0 @@ -//20180409 -// WritetoRS,Makebat changed ( "shell" used ) -//20180408 -// WritetoRS debugged ( setwd ) -// WriteoRS,Makebat changed ( use "sjis.txt") -//20180405 -// Makebat debugged -//20180404 -// Tlistplot changed ("Msg"); -// WritetoRS debugged ( openfie(..,Cdy= )) -//20180403 -// WritetoRS, Makebat changed (for Zenkaku) -// Convsjiswin removed -// Mkslidesummary debugged -//20180401 -// Convsjiswin added -// Makebat changed (for convsjis ) -//20180330 -// Presentation changed (for wallpaper ) -// Settitle changed (Title option ) -//20180303 -// Letter debugged (for ` ) -//2017.12.24 -// IftoR, FortoR,Deffun rewritten -//2017.12.23 -// Bezier, Translatedata,Rotatedata,Reflectdata debugged ( [ ] ) -// RSform : help added -//2017.12.19 -// WritetoSci() added (=WritetoR(), for old Parent button ) -//2017.12.16 -// Setslidehyper changed ("Size=","Pos=[]") -//2017.12.09 -// Mkslides changed (for animation) -// MakeRarg (from Makesciarg ) added ( RSslash ) -// Setax, Htickmark, Vtickmark changed ( MakeRarg ) -//2017.11.24 -// Slidework changed ( makedir) -// Rotatedata debugged ( MeasureDepth) -//2017.11.20 -// Slidework changed ( for the case of (ex) dir="...../") -//2017.11.05 -// Figpdf debugged -//2017.11.01 -// Presentation debugged ( usepackage{ketpic} etc. ) -//2017.10.30 -// Viewtex changed ( path of ketpicstyle ) -//2017.10.28 -// WritetoRS changed ( generator is written ) -//2017.10.26 -// Mksummary changed for R -//2017.10.18 -// Letter,Letterrot,Exprrot debugged (\ and \\) -//2017.10.17 -// Viewtex debugged ($ removed for xelatex) -//2017.10.16 -// Mkslides debugged ( line4 from last,path) -//2017.10.14 -// Makebat,Makeshell changed(flow="tt" supported) -//2017.10.13 -// Makebat,Makeshell,Mkslides debugged (Shellfile,Sehllchild removed ) -// Makeshell debugged ( Case of no "/" ) -//2017.10.08 -// Mkslides debugged (Sheslide=>Shellslide ) -//2017.10.07 -// WritetoRS changed (for pict2e) -// Helplist debugged ( for r ) -//2017.10.06 -// RSform debugged -//2017.09.29 -// Viewparent debugged (WritetoRS) -//2017.09.24 -// WritetoRS debugged ("\" => "/") -// RSslash added -// Letter changed (RSslash used) -//2017.09.22 -// Defvar changed ("=" removed) -// WritetoRS changed (Com1st,..., VLIST ) -//2017.09.18 -// Extractdata changed -// SCIWR,SCIRE removed -//2017.09.17 -// WritetoRS added -// Viewtex changed ( Writetosci => WritetoR ) -//2017.09.16 -// RSform, Deffun, IftoR, FortoR changed( added ) -//2017.09.14 -// Makeshell, Makebat changed
\ No newline at end of file diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs deleted file mode 100644 index ae40d147..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs +++ /dev/null @@ -1,5073 +0,0 @@ -// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team
-//
-//This program is free software: you can redistribute it and/or modify
-// it under the terms of the GNU General Public License as published by
-// the Free Software Foundation; either version 3 of the License, or
-// (at your option) any later version.
-//
-// This program is distributed in the hope that it will be useful,
-// but WITHOUT ANY WARRANTY; without even the implied warranty of
-// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-// GNU General Public License for more details.
-//
-// You should have received a copy of the GNU General Public License
-// along with this program. If not, see <http://www.gnu.org/licenses/>
-//
-
-println("ketcindybasic2(20180409) loaded");
-
-//help:start();
-
-Dispchoice():=(
- if(islist(Ch),
- if(!isreal(ChNum),ChNum=1);
- drawtext(mouse().xy,"Ch="+text(Ch)+" N="+text(ChNum),size->24,color->[0,0,1]);
- );
-);
-
-Datetime():=(
-//help:Datetime();
- regional(names,dt,tmp);
- tmp=getdatetime();
- dt=tokenize(tmp," ");
- dt=apply(dt,if(!isstring(#),text(#),#));
- names=["Jan","Feb","Mar","Apr","May","Jun",
- "Jul","Aug","Sep","Oct","Nov","Dec"];
- tmp=select(1..12,names_#==dt_2);
- tmp=text(tmp_1);
- tmp=[dt_6+"/"+tmp+"/"+dt_3,dt_4];
-);
-
-Rotatepoint(point,Theta,ctr):=(
-//help:Rotatepoint(A,2*pi/3,B);
- regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
- tmp=Lcrd(point);
- X1=tmp_1; Y1=tmp_2;
- tmp=Lcrd(ctr);
- Cx=tmp_1; Cy=tmp_2;
- X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta);
- Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta);
- [X2,Y2];
-);
-
-Translatepoint(point,mov):=(
-//help:Translatepoint(A,[2,3]);
- regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
- tmp=Lcrd(point);
- X1=tmp_1; Y1=tmp_2;
- tmp=Lcrd(mov);
- Cx=tmp_1; Cy=tmp_2;
- X2=X1+Cx;
- Y2=Y1+Cy;
- [X2,Y2];
-);
-
-Scalepoint(point,ratio,center):=(
-//help:Scalepoint(A,[3,2],[0,0]);
- regional(X1,X2,Y1,Y2,Cx,Cy,tmp);
- tmp=Lcrd(point);
- X1=tmp_1; Y1=tmp_2;
- tmp=Lcrd(center);
- Cx=tmp_1; Cy=tmp_2;
- X2=Cx+ratio_1*(X1-Cx);
- Y2=Cy+ratio_2*(Y1-Cy);
- [X2,Y2];
-);
-
-Reflectpoint(point,symL):=(
-//help:Reflectpoint(A,B);
-//help:Reflectpoint(A,[[2,3]]);
-//help:Reflectpoint(A,[C,E]);
- regional(X1,X2,Y1,Y2,Us,Vs,Pt1,Pt2,Cx,Cy,tmp);
- tmp=Lcrd(point);
- X1=tmp_1; Y1=tmp_2;
- Pt1=Lcrd(symL_1);
- if(length(symL)==1,
- Pt2=Pt1;
- ,
- Pt2=Lcrd(symL_2);
- );
- Us=Pt2_1-Pt1_1;
- Vs=Pt2_2-Pt1_2;
- if(Pt1==Pt2,
- X2=2*Pt1_1-X1;
- Y2=2*Pt1_2-Y1;
- ,
- X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1
- -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
- Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1
- +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
- );
- [X2,Y2];
-);
-
-Rotatedata(nm,plist,Theta):=Rotatedata(nm,plist,Theta,[]);
-Rotatedata(nm,plist,angle,options):=(
-//help:Rotatedata("1","crAB",pi/3,[[1,5],"dr,2"]);
- regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdLL,PdL,
- opcindy,Nj,Njj,Kj,Mj,X1,Y1,X2,Y2,Ltype,Noflg,name);
- name="rt"+nm;
- Pt=[0,0];
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opcindy=tmp_(length(tmp));
- tmp1=tmp_6;
- if(length(tmp1)>0,Pt=Lcrd(tmp1_1));
- pdata=plist;
- if(isstring(pdata),pdata=[pdata]);
- if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
- pdata=[pdata];
- );
- if(isstring(angle),Theta=parse(angle),Theta=angle);
- Cx=Pt_1; Cy=Pt_2;
- PdL=[];
- forall(pdata,Njj,
- if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
- if(MeasureDepth(Kj)==0,Kj=[Kj]); //17.11.24
- if(MeasureDepth(Kj)==1,Kj=[Kj]);
- tmp2=[];
- forall(Kj,Nj,
- tmp1=[];
- forall(Nj,
- tmp=LLcrd(#);
- X1=tmp_1;
- Y1=tmp_2;
- X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta);
- Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta);
- tmp1=concat(tmp1,[[X2,Y2]]);
- );
- tmp2=concat(tmp2,[tmp1]);
- );
- PdL=concat(PdL,tmp2);
- );
- if(Noflg<3,
- println("generate Rotatedata "+name);
- tmp1=[];
- forall(PdL,tmp2,
- tmp=apply(tmp2,Pcrd(#));
- tmp1=append(tmp1,tmp);
- );
- if(length(tmp1)==1,tmp1=tmp1_1);
- tmp=name+"="+textformat(tmp1,5);
- parse(tmp);
- tmp1=text(plist);
- tmp1=RSform(tmp1);// 17.12.23(2lines)
- tmp=name+"=Rotatedata("+tmp1+","
- +textformat(angle,5)+","+RSform(textformat(Pt,5))+")"; //17.12.23
- GLIST=append(GLIST,tmp);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- PdL;
-);
-
-Translatedata(nm,plist,mov):=Translatedata(nm,plist,mov,[]);
-Translatedata(nm,plist,mov,options):=(
-//help:Translatedata("1",["gr1"],[1,2]);
- regional(tmp,tmp1,tmp2,pdata,Cx,Cy,PdL,Nj,Njj,Kj,
- opcindy,X2,Y2,Ltype,Noflg,name);
- name="tr"+nm;
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opcindy=tmp_(length(tmp));
- pdata=plist;
- if(isstring(pdata),pdata=[pdata]);
- if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
- pdata=[pdata];
- );
- tmp=Lcrd(mov);
- Cx=tmp_1; Cy=tmp_2;
- PdL=[];
- forall(pdata,Njj,
- if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
- if(MeasureDepth(Kj)==1,Kj=[Kj]);
- tmp2=[];
- forall(Kj,Nj,
- tmp1=[];
- forall(Nj,
- tmp=LLcrd(#);
- X2=tmp_1+Cx;
- Y2=tmp_2+Cy;
- tmp1=concat(tmp1,[[X2,Y2]]);
- );
- tmp2=concat(tmp2,[tmp1]);
- );
- PdL=concat(PdL,tmp2);
- );
- if(Noflg<3,
- println("generate Translatedata "+name);
- tmp1=[];
- forall(PdL,tmp2,
- tmp=apply(tmp2,Pcrd(#));
- tmp1=append(tmp1,tmp);
- );
- if(length(tmp1)==1,tmp1=tmp1_1);
- tmp=name+"="+textformat(tmp1,5);
- parse(tmp);
- tmp1=text(plist);
- tmp1=RSform(tmp1);// 17.12.23
- tmp=name+"=Translatedata("+tmp1+","+RSform(textformat(mov,5))+")";
- GLIST=append(GLIST,tmp);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- PdL;
-);
-
-Scaledata(nm,plist,ratioV):=(
- regional(tmp);
- tmp=Lcrd(ratioV);
- Scaledata(nm,plist,tmp_1,tmp_2,[]);
-);
-Scaledata(nm,plist,Arg1,Arg2):=(
-//help:Scaledata("1","crAB",3,2,[[0,0]]);
- regional(tmp,options);
- if(islist(Arg2),
- tmp=Lcrd(Arg1);
- options=Arg2;
- Scaledata(nm,plist,tmp_1,tmp_2,options);
- ,
- Scaledata(nm,plist,Arg1,Arg2,[]);
- );
-);
-Scaledata(nm,plist,rx,ry,options):=(
- regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdL,
- opcindy,Nj,Njj,Kj,X2,Y2,Ltype,Noflg,name);
- name="sc"+nm;
- Pt=[0,0];
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opcindy=tmp_(length(tmp));
- tmp1=tmp_6;
- if(length(tmp1)>0,
- Pt=Lcrd(tmp1_1);
- );
- pdata=plist;
- if(isstring(pdata),pdata=[pdata]);
- if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
- pdata=[pdata];
- );
- Cx=Pt_1; Cy=Pt_2;
- PdL=[];
- forall(pdata,Njj,
- if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
- if(MeasureDepth(Kj)==1,Kj=[Kj]);
- tmp2=[];
- forall(Kj,Nj,
- tmp1=[];
- forall(Nj,
- tmp=LLcrd(#);
- X2=Cx+rx*(tmp_1-Cx);
- Y2=Cy+ry*(tmp_2-Cy);
- tmp1=concat(tmp1,[[X2,Y2]]);
- );
- tmp2=concat(tmp2,[tmp1]);
- );
- PdL=concat(PdL,tmp2);
- );
- if(Noflg<3,
- println("generate Scaledata "+name);
- tmp1=[];
- forall(PdL,tmp2,
- tmp=apply(tmp2,Pcrd(#));
- tmp1=append(tmp1,tmp);
- );
- if(length(tmp1)==1,tmp1=tmp1_1);
- tmp=name+"="+textformat(tmp1,5);
- parse(tmp);
- tmp1=text(plist);
- tmp1=RSform(tmp1); // 17.12.23
- tmp=name+"=Scaledata("+tmp1+","
- +textformat(rx,5)+","+textformat(ry,5)+","+RSform(textformat(Pt,5))+")";
- GLIST=append(GLIST,tmp);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- PdL;
-);
-
-Reflectdata(nm,plist,symL):=Reflectdata(nm,plist,symL,[]);
-Reflectdata(nm,plist,symL,options):=(
-//help:Reflectdata("1","crAB",[C]);
- regional(tmp,tmp1,tmp2,pdata,Us,Vs,Pt1,Pt2,Cx,Cy,PdL,
- opcindy,Nj,Njj,Kj,X1,Y1,X2,Y2,Ltype,Noflg,name);
- name="re"+nm;
- Pt=[0,0];
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opcindy=tmp_(length(tmp));
- pdata=plist;
- if(isstring(pdata),pdata=[pdata]);
- if(!isstring(pdata_1) & MeasureDepth(pdata)==1,
- pdata=[pdata];
- );
- Pt1=Lcrd(symL_1);
- if(length(symL)==1,
- Pt2=Pt1;
- ,
- Pt2=Lcrd(symL_2);
- );
- Us=Pt2_1-Pt1_1;
- Vs=Pt2_2-Pt1_2;
- PdL=[];
- forall(pdata,Njj,
- if(isstring(Njj),Kj=parse(Njj),Kj=Njj);
- if(MeasureDepth(Kj)==1,Kj=[Kj]);
- tmp2=[];
- forall(Kj,Nj,
- tmp1=[];
- forall(Nj,
- tmp=LLcrd(#);
- X1=tmp_1;
- Y1=tmp_2;
- if(Pt1==Pt2,
- X2=2*Pt1_1-X1;
- Y2=2*Pt1_2-Y1;
- ,
- X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1
- -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
- Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1
- +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2);
- );
- tmp1=concat(tmp1,[[X2,Y2]]);
- );
- tmp2=concat(tmp2,[tmp1]);
- );
- PdL=concat(PdL,tmp2);
- );
- if(Noflg<3,
- println("generate Reflectdata "+name);
- tmp1=[];
- forall(PdL,tmp2,
- tmp=apply(tmp2,Pcrd(#));
- tmp1=append(tmp1,tmp);
- );
- if(length(tmp1)==1,tmp1=tmp1_1);
- tmp=name+"="+textformat(tmp1,5);
- parse(tmp);
- tmp1=text(plist);
- tmp1=RSform(tmp1);// 17.12.23
- tmp=name+"=Reflectdata("+tmp1+","+RSform(textformat(symL,5))+")";//17.12.23
- GLIST=append(GLIST,tmp);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- PdL;
-);
-
-Mksegments():=Mksegments([]);
-Mksegments(options):=(
-//help:Mksegments();
- regional(segstr,p,q,r,tmp1,tmp2,tmp3);
- forall(allsegments(),seg,
- str=text(inspect(seg,"definition"));
- tmp1=indexof(str,"(");
- tmp2=indexof(str,";");
- tmp3=indexof(str,")");
- p=substring(str,tmp1,tmp2-1);
- q=substring(str,tmp2,tmp3-1);
- Listplot([parse(p),parse(q)]);
- );
-);
-
-Mkcircles():=Mkcircles([]);
-Mkcircles(options):=(
-//help:Mkcircles():
- regional(seg,cir,str,p,q,r,tmp1,tmp2,tmp3,tmp4);
- forall(allcircles(),cir,
- str=text(inspect(cir,"definition"));
- tmp1=indexof(str,"(");
- tmp2=indexof(str,";");
- tmp3=indexof(str,")");
- tmp4=indexof(str,";",tmp2+1);
- if(tmp4==0,
- p=substring(str,tmp1,tmp2-1);
- q=substring(str,tmp2,tmp3-1);
- Circledata([parse(p),parse(q)]);
- ,
- p=substring(str,tmp1,tmp2-1);
- q=substring(str,tmp2,tmp4-1);
- r=substring(str,tmp4,tmp3-1);
- Circledata([parse(p),parse(q),parse(r)]);
- );
- );
-);
-
-MakeRarg(arglist):=(
- regional(str,tmpstr);
- str="";
- forall(arglist,
- if(isstring(#),
- tmpstr=Dq+RSslash(#)+Dq;
- ,
- tmpstr=textformat(#,6);
- );
- str=str+tmpstr+",";
- );
- str=substring(str,0,length(str)-1);
- str;
-);
-
-Setax(arglist):=(
-//help:Setax(["l","x","e","y","n","O","sw"]);
-//help:Setax([7,"nw"]);
- regional(tmp);
- tmp=MakeRarg(arglist);
- Com1st("Setax("+tmp+")");
-);
-
-Htickmark(arglist):=(
-//help:Htickmark([1,"1",2,"sw","2"]);
- regional(tmp);
- tmp="";
- tmp=MakeRarg(arglist);
- Com2nd("Htickmark("+tmp+")");
-);
-
-Vtickmark(arglist):=(
-//help:Vtickmark([1,"1",2,"sw","2"]);
- regional(tmp);
- tmp=MakeRarg(arglist);
- Com2nd("Vtickmark("+tmp+")");
-);
-
-Vtick(py):=Vtick(py,MARKLEN,[]);
-Vtick(py,len):=Vtick(py,len,[]);
-Vtick(py,len,options):=(
-//help:Vtick(1,0.1,options);
- regional(tmp,tmp1,tmp2);
- tmp="v"+text(round(py*100));
- tmp=replace(tmp,"-","m");
- tmp1=[0-len/2,py];
- tmp2=[0+len/2,py];
- Listplot(tmp,[tmp1,tmp2],options);
-);
-
-Htick(px):=Htick(px,MARKLEN,[]);
-Htick(px,len):=Htick(px,len,[]);
-Htick(px,lenorg,options):=(
-//help:Htick(-1,0.1,options);
- regional(len,tmp,tmp1,tmp2);
- tmp=LLcrd([0,lenorg]);
- len=tmp_2;
- tmp="h"+text(round(px*100));
- tmp=replace(tmp,"-","m");
- tmp1=[px,0-len/2];
- tmp2=[px,0+len/2];
- Listplot(tmp,[tmp1,tmp2],options);
-);
-
-Drwxy():=(
-//help:Drwxy();
- Com2nd("Drwxy()");
- Addax(0); // 16.01.21
-);
-
-Drwpt(pstr):=Drawpoint(pstr);
-Drwpt(ptlist,nn):=( // 16.03.05 from
-//help:Drwpt(A);
-//help:Drwpt("[1,1],0");
-//help:Drwpt(A,0);
-//help:Drwpt([1,2],0);
- Drawpoint(ptlist,nn);
-);
-Drawpoint(pstr):=(
- if(isstring(pstr),
- println("Drwpt : "+pstr);
- Com2nd("Drwpt("+pstr+")");
- ,
- Drawpoint(pstr,1);
- );
-);
-Drawpoint(ptlistorg,nn):=(
- regional(ptlist,thick,tmp,tmp1);
- println("Drwpt : "+text(ptlistorg));
- if(islist(ptlistorg),
- if(MeasureDepth(ptlistorg)==1,
- ptlist=ptlistorg
- ,
- ptlist=[ptlistorg]
- );
- ,
- ptlist=[ptlistorg]
- );
- thick=PenThick/PenThickInit;// 16.04.09 from
- tmp1=max(TenSize/TenSizeInit,1)/8;
- Setpen(tmp1); // 16.04.09 until
- forall(ptlist,
- tmp=textformat(#,5)+","+text(nn);
- Com2nd("Drwpt("+tmp+")"); // 16.04.09
- );
- Setpen(thick); // 16.04.09
-);// 16.03.05 until
-
-Addax(param):=(
-//help:Addax(0);
- ADDAXES=textformat(param,5);
-);
-
-Expr(Pt,Dr,St):=Expr([Pt,Dr,St]);
-Expr(list):=Expr(list,[]);
-Expr(listorg,options):=( //16.10.09
-//help:Expr([A,"e","f(x)=x^2"]);
- regional(list,str,tmp,tmp1,tmp2);
- list=listorg;
- forall(1..round(length(list)/3),
- str=list_(3*#);
- if(!isstring(str),str=format(str,5));
- str="$"+str+"$";
- list_(3*#)=str;
- );
- Letter(list,options);
-);
-
-Letter(Pt,Dr,St):=Letter([Pt,Dr,St]);
-Letter(list):=Letter(list,[]);
-Letter(list,options):=(
-//help:Letter([C,"c","Graph of f(x)"]);
- regional(Nj,Pos,Dir,Str,Off,Dmv,Xmv,Ymv,Noflg,opcindy,
- opL,aln,sz,clr,bld,ita,tmp,tmp1,tmp2);
- tmp=Divoptions(options);
- Noflg=tmp_2;
- opL=select(options,indexof(#,"->")>0); //16.10.09from
- tmp=select(opL,indexof(#,"color"));
- size=12;
- clr=[0,0,0];
- bld=false;
- ita=false;
- aln="left";
- forall(opL,
- tmp=indexof(#,"->");
- tmp1=removespace(substring(#,0,tmp-1));
- tmp2=substring(#,tmp+1,length(#));
- if(tmp1=="size",sz=parse(tmp2));
- if(tmp1=="color",clr=parse(tmp2));
- if(tmp1=="bold",bld=parse(tmp2));
- if(tmp1=="ita",ita=parse(tmp2));
- );//16.10.09until
- Off=-4;
- Dmv=8;
- Nj=1;
- while(Nj+2<=length(list),
-// Pos=textformat(list_Nj,5);
- Pos=list_Nj;
- Dir=list_(Nj+1);
- tmp=indexof(Dir,"s")+indexof(Dir,"n");//16.10.19from
- if(tmp>0,
- tmp=indexof(Dir,"w")+indexof(Dir,"e");
- if(tmp==0,
- Dir="c"+Dir;//16.10.08
- );
- );//16.10.19until
- Str=list_(Nj+2);
- if(!isstring(Str),Str=format(Str,5)); // 16.09.30,10.09
- tmp=replace(Str,".xy","");
- tmp=replace(tmp,".x","(1)");
- Str=replace(tmp,".y","(2)");
- Str=RSslash(Str); // 17.09.24
- Str=replace(Str,"`","'");//180303
- tmp=Dq+","+Dq+Str+Dq+")";
- if(Noflg==0,
- Com2nd("Letter("+Lcrd(Pos)+","+Dq+Dir+tmp);//16.10.10
- );
- if(Noflg<2,
- Xmv=0;//16.10.13
- Ymv=-4;
- if(indexof(Dir,"n")>0,
- Ymv=Dmv/2;
- );
- if(indexof(Dir,"s")>0,
- Ymv=-Dmv*3/2;//16.10.13
- );
- if(indexof(Dir,"e")>0,
- Xmv=Dmv/2;
- Off=0;
- aln="left";
- );
- if(indexof(Dir,"w")>0,
- Xmv=-Dmv/2;
- Off=0; // 16.09.30from
- aln="right";
- );
- if(indexof(Dir,"c")>0,
- Xmv=0;//16.10.13
- Off=0;
- if(Ymv==0,Ymv=-4);//16.10.08
- aln="mid"; // 16.09.30until
- );
- Str=list_(Nj+2); //17.10.17
- drawtext(Pcrd(Pos),Str,offset->[Off+Xmv,Off+Ymv],
- size->sz,color->clr,align->aln,bold->bld,italics->ita);//16.10.09
- );
- Nj=Nj+3;
- );
-);
-
-Letterrot(pt,dir,str):=Letterrot(pt,dir,0,0,str);
-Letterrot(pt,dir,movstr,str):=(
-//help:Letterrot(C,B-A,"AB"):
-//help:Letterrot(C,B-A,0,5,"AB"):
-//help:Letterrot(C,B-A,"t0n5","AB"):
- regional(tmov,nmov,tmp,tmp1,tmp2);
- tmp1=indexof(movstr,"t");
- tmp2=indexof(movstr,"n");
- if(tmp1>0,
- if(tmp2>0,tmp=tmp2-1,tmp=length(movstr));
- tmov=parse(substring(movstr,tmp1,tmp));
- ,
- tmov=0;
- );
- if(tmp2>0,
- nmov=parse(substring(movstr,tmp2,length(movstr)));
- ,
- nmov=0;
- );
- Letterrot(pt,dir,tmov,nmov,str);
-);
-Letterrot(pt,dir,tmov,nmov,str):=(
- regional(tmp);
- Letter([pt,"c",str],["notex"]);
- tmp=replace(str,"\","\\"); //17.10.18
- Com2nd("Letterrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')");
-);
-
-Exprrot(pt,dir,str):=Exprrot(pt,dir,0,0,str);
-Exprrot(pt,dir,movstr,str):=(
-//help:Exprrot(C,B-A,"d"):
-//help:Exprrot(C,B-A,0,5,"d"):
-//help:Exprrot(C,B-A,"t0n5","d"):
- regional(tmov,nmov,tmp,tmp1,tmp2);
- tmp1=indexof(movstr,"t");
- tmp2=indexof(movstr,"n");
- if(tmp1>0,
- if(tmp2>0,tmp=tmp2-1,tmp=length(movstr));
- tmov=parse(substring(movstr,tmp1,tmp));
- ,
- tmov=0;
- );
- if(tmp2>0,
- nmov=parse(substring(movstr,tmp2,length(movstr)));
- ,
- nmov=0;
- );
- Exprrot(pt,dir,tmov,nmov,str);
-);
-Exprrot(pt,dir,tmov,nmov,str):=(
- regional(tmp);
- Expr([pt,"c",str],["notex"]);
- tmp=replace(str,"\","\\"); //17.10.18
- Com2nd("Exprrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')");
-);
-
-Putslider(ptstr,p1,p2):=Slider(ptstr,p1,p2);
-Slider(ptstr,p1,p2):=( //17.04.11
-//help:Slider("A-C-B",[-3,0],[3,0]);
- regional(pA,pB,pC,seg,sname,Alpha,tmp,tmp1);
- tmp=indexall(ptstr,"-");
- pA=substring(ptstr,0,tmp_1-1);
- pC=substring(ptstr,tmp_1,tmp_2-1);
- pB=substring(ptstr,tmp_2,length(ptstr));
- seg=pA+pB;
- Alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZ";
- sname="";
- forall(1..(length(seg)),
- tmp=substring(seg,#-1,#);
- tmp1=indexof(Alpha,tmp);
- if(tmp1>0,
- sname=sname+unicode(text(tmp1+96),base->10);
- ,
- sname=sname+tmp;
- );
- );
- Putpoint(pA,p1);
- Putpoint(pB,p2);
- Listplot([parse(pA),parse(pB)],["notex","color->[0,0.4,0.4]","size->2"]);
-// create([sname],"Segment",[parse(pA),parse(pB)]);
-// tmp2=Listplot("",[p1,p2],["nodata"]);
- Putonseg(pC,parse("sg"+pA+pB));
-// create([pC],"PointOn",[parse(sname),0.5]);
-);
-
-Putpoint(name,Pt):=Putpoint(name,Pt,Pt);
-Putpoint(name,Ptinit,Pt):=(
-//help:Putpoint("A",[1,2],[1,A.y]);
- regional(ptstr);
- ptstr=apply(allpoints(),#.name);//16.10.06
- if(!contains(ptstr,name),
- createpoint(name,Pcrd([Ptinit_1,Ptinit_2]));
- ,
- ptstr=name+".xy="+textformat(Pcrd(Pt),5);
- parse(ptstr);
- );
-);
-
-Bezierpt(t,ptlist,ctrlist):=(
- regional(flg3,p0,p1,p2,p3,p4,p5,p6,p7,p8,p9);
- p0=ptlist_1;
- p3=ptlist_2;
- p1=ctrlist_1;
- if(length(ctrlist)==1,
- p2=p3;
- flg3=0;
- ,
- p2=ctrlist_2;
- flg3=1;
- );
- if(length(p0)<3, // 15.02.08
- p0=Lcrd(p0);
- p3=Lcrd(p3);
- p1=Lcrd(p1);
- p2=Lcrd(p2);
- );
- p4=(1-t)*p0+t*p1;
- p5=(1-t)*p1+t*p2;
- p6=(1-t)*p2+t*p3;
- p7=(1-t)*p4+t*p5;
- p8=(1-t)*p5+t*p6;
- p9=(1-t)*p7+t*p8;
- if(flg3==0,p7,p9);
-);
-
-Bezier(ptctrlist):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,[]);
-Bezier(ptctrlist,options):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,options);
-Bezier(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]);
-Bezier(nm,ptlist,ctrlist,options):=BezierCurve(nm,ptlist,ctrlist,options);
-BezierCurve(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]);
-BezierCurve(nm,ptlistorg,ctrlistorg,options):=(
-//help:Bezier("1",[A,D],[B,C]);
-//help:Bezier(options=["Num=10"]);
- regional(name,Ltype,Noflg,opstr,opcindy,Num,
- ptlist,ctrlist,tmp,tmp1,tmp2,ii,st,out,list);
- name="bz"+nm;
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opstr=tmp_(length(tmp)-1);
- opcindy=tmp_(length(tmp));
- Num=10;
- tmp1=tmp_5;
- forall(tmp1, // 14.12.31
- if(substring(#,0,1)=="N",
- tmp2=indexof(#,"=");
- Num=parse(substring(#,tmp2,length(#)));
- opstr=opstr+","+Dq+#+Dq;
- );
- );
- ptlist=apply(ptlistorg,Lcrd(#)); // 16.08.16
- ctrlist=[]; // 14.12.31
- if(length(ctrlistorg)==length(ptlist)-1,
- forall(ctrlistorg,tmp1,
- if(MeasureDepth(tmp1)==0,tmp=[tmp1],tmp=tmp1);
- tmp=apply(tmp,Lcrd(#)); // 16.08.16
- ctrlist=append(ctrlist,tmp);
- );
- ,
- forall(1..(length(ptlist)-1),ii,
- tmp=ctrlistorg_((2*ii-1)..(2*ii));
- tmp=apply(tmp,Lcrd(#)); // 16.08.16
- ctrlist=append(ctrlist,tmp);
- );
- );
- if(!islist(Num),
- Num=apply(ctrlist,Num);
- );
- list=[];
- forall(1..(length(ptlist)-1),ii,
- tmp1=ptlist_(ii..(ii+1));
- tmp2=ctrlist_ii;
- if(ii==1,st=0,st=1);
- forall(st..Num_ii,
- tmp=Bezierpt(#/Num_ii,tmp1,tmp2);
- list=append(list,tmp);
- );
- );
- if(Noflg<3,
- println("generate Bezier "+name);
- out=apply(list,Pcrd(#));
- tmp=name+"="+textformat(out,5);
- parse(tmp);
- tmp1=textformat(ptlist,5);
- tmp1=RSform(tmp1,2); //17.12.23
- tmp2=textformat(ctrlist,5);
- tmp2=RSform(tmp2,3); //17.12.23
- GLIST=append(GLIST,name+"=Bezier("+tmp1+","+tmp2+opstr+")");
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- list;
-);
-
-Readcsvsla(fname):=Readplotdigdata(fname,[]);
-Readcsvsla(fname,options):=Readplotdigdata(fname,options);
-Readplotdigdata(fname):=Readplotdigdata(fname,[]);
-Readplotdigdata(fname,options):=(
- regional(fsc,mv,cmdall,dataL,nd,npt,ptdata,ii,tmp,tmp1,tmp2,tmp3);
- tmp=Divoptions(options);
- tmp1=tmp_6;
- sc=1;//10;
- mv=[0,0];//[5,5];
- forall(tmp1,
- if(!islist(#),sc=#,mv=#);
- );
- if(indexof(fname,".")>0,
- tmp=load(fname);
- ,
- tmp=load(fname+".txt");
- );
- cmdall=tokenize(tmp,"//");
- dataL=[];
- forall(2..length(cmdall),ii,
- tmp1=parse("["+cmdall_ii+"]");
- dataL=append(dataL,tmp1);
- );
- if(length(dataL_(length(dataL)))<2,
- dataL=dataL_(1..(length(dataL)-1));
- );
- nd=length(dataL_1)/2;
- npt=length(dataL);
- ptdata=[];
- forall(1..nd,ii,
- tmp3=[];
- forall(1..npt,
- tmp1=dataL_#_(2*ii-1);
- tmp2=dataL_#_(2*ii);
- if(isreal(tmp1),
- tmp3=append(tmp3,[tmp1,tmp2]);
- );
- );
- ptdata=append(ptdata,tmp3);
- );
- tmp1=[];
- forall(ptdata,
- tmp=#/sc;
- tmp=Translatedata("1",[tmp],-mv,["nodata"]);
- tmp1=append(tmp1,tmp);
- );
- ptdata=tmp1;
- ptdata;
-);
-
-Putbezierdata(name,ptL):=Putbezierdata(name,ptL,[]);
-Putbezierdata(name,ptL,options):=(
- regional(psize,Deg,tmp,tmp1,tmp2,p1,p2,pts,ctrs);
- tmp=Divoptions(options);
- psize=3;
- Deg=3;
- tmp1=tmp_5;
- forall(tmp1,
- if(substring(#,0,1)=="D",
- tmp=indexof(#,"=");
- Deg=parse(substring(#,tmp,length(#)));
- );
- if(substring(#,0,1)=="S",
- tmp=indexof(#,"=");
- psize=parse(substring(#,tmp,length(#)));
- );
- );
- pts=[];
- ctrs=[];
- forall(1..length(ptL),
- p2=ptL_#; // 16.08.16
- if(ispoint(p2),
- tmp1=text(p2);
- ,
- tmp1=name+text(#);
- Putpoint(tmp1,p2,Lcrd(parse(tmp1))); // 16.08.16
- );
- inspect(parse(tmp1),"ptsize",psize);
- pts=append(pts,parse(tmp1));
- inspect(parse(tmp1),"color",4);
- if(#>1,
- p1=Lcrd(ptL_(#-1)); // 16.08.16
- p2=Lcrd(ptL_#); // 16.08.16
- if(Deg==3,
- tmp=(2*p1+p2)/3;
- tmp1=name+"p"+text(#-1);
- Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16
- inspect(parse(tmp1),"labeled",false); //15.01.22
- Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22
- inspect(parse(tmp1),"ptsize",psize);
- inspect(parse(tmp1),"color",3);
- tmp=(p1+2*p2)/3;
- tmp2=name+"q"+text(#-1);
- Putpoint(tmp2,tmp,Lcrd(parse(tmp2))); // 16.08.16
- inspect(parse(tmp2),"labeled",false); //15.01.22
- Letter([parse(tmp2),"ne",tmp2],["notex"]); //15.01.22
- inspect(parse(tmp2),"ptsize",psize);
- inspect(parse(tmp2),"color",3);
- ctrs=append(ctrs,[parse(tmp1),parse(tmp2)]);
- ,
- tmp=(p1+p2)/2;
- tmp1=name+"p"+text(#-1);
- Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16
- inspect(parse(tmp1),"labeled",false); //15.01.22
- Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22
- inspect(parse(tmp1),"ptsize",psize);
- inspect(parse(tmp1),"color",3);
- ctrs=append(ctrs,[parse(tmp1)]);
- );
- );
- );
- [pts,ctrs,name];
-);
-
-Bezierstart(n):=( // 2016.02.26
- BezierNumber=n;
-);
-
-Mkbezierptcrv(ptdata):=Mkbezierptcrv(ptdata,[]);
-Mkbezierptcrv(ptdata,options):=(
- //help:Mkbezierptcrv([A,B,C,D]);
- //help:Mkbezierptcrv([[A,B],[C,D]]);
- //help:Mkbezierptcrv(options=["Num=10"]);
- // global BezierNumber
- regional(ptlist,Out,tmp,tmp1,tmp2);
- if(isstring(ptdata),
- ptlist=Readcsvsla(ptdata,options);
- ,
- ptlist=ptdata;
- );
- if(MeasureDepth(ptlist)==1,ptlist=[ptlist]);
- Out=[];
- forall(1..length(ptlist),
- tmp=floor((BezierNumber-1)/26);// 15.02.23
- if(tmp==0,tmp="",tmp=text(tmp));
- tmp2=mod(BezierNumber,26);
- if(tmp2==0,tmp2=26);
- tmp1=unicode(text(96+tmp2),base->10)+tmp;// 15.03.11
- tmp2=Putbezierdata(tmp1,ptlist_#,options);
- Bezier(tmp2,options);
- BezierNumber=BezierNumber+1;
- Out=append(Out,tmp2_(1..2));
- );
- Out;
-);
-
-Mkbeziercrv(nm,ptctrL):=Mkbeziercrv(nm,ptctrL,[]);
-Mkbeziercrv(nm,ptctrL,options):=(
- //help:Mkbeziercrv("1",[[A,B,C,D],[[P,Q],[R,S],T]]);
- regional(ptctrLL,name,ptlist,ctrlist,tmp,tmp1,tmp2);
- if(MeasureDepth(ptctrL)==2,ptctrLL=[ptctrL],ptctrLL=ptctrL);
- forall(1..length(ptctrLL),
- name=nm+text(#);
- ptlist=ptctrLL_#_1;
- ctrlist=ptctrLL_#_2;
- Bezier(nm,ptlist,ctrlist,options); // 17.01.06
- );
-);
-
-Writebezier():=Writebezier(Fhead,"all");
-Writebezier(head):=Writebezier(head,"all");
-Writebezier(head,seL):=(
-//help:Writebezier(file);
-//help:Writebezier(file,"acd");
- regional(bz,dt,name,tmp,tmp1,tmp2);
- bz=select(GLIST,indexof(#,"=Bezier")>0);
- tmp1=[]; // 16.04.22from
- if(seL!="all",
- forall(1..length(seL),
- tmp=substring(seL,#-1,#);
- tmp=select(bz,indexof(#,"bz"+tmp)>0);
- tmp1=concat(tmp1,tmp);
- );
- bz=tmp1;// 16.04.22until
- );
- dt=[head+"n",[[length(bz),0]]];
- forall(1..length(bz),
- tmp=indexof(bz_#,"=");
- name=substring(bz_#,0,tmp-1);
- tmp=indexof(bz_#,","+Dq);
- if(tmp>0,
- tmp1=substring(bz_#,0,tmp-1)+")";
- ,
- tmp1=bz_#;
- );
- tmp1=replace(tmp1,"Bezier(","[");
- tmp1=replace(tmp1,"list(","[");
- tmp1=replace(tmp1,")","]");
- tmp1=replace(tmp1,",",".xy,");
- tmp1=replace(tmp1,"]",".xy]");
- tmp1=replace(tmp1,".xy,[",",[");
- tmp1=replace(tmp1,"].xy","]");
- tmp1=replace(tmp1,name,head+text(#));
- parse(tmp1);
- tmp=parse(head+text(#)+"_1");
- dt=concat(dt,[head+text(#)+"k",tmp]);
- tmp=parse(head+text(#)+"_2");
- dt=concat(dt,[head+text(#)+"c",tmp]);
- );
- WriteOutData(head+".txt",dt);
- dt;
-);
-
-Readbezier(file):=Readbezier(file,[]);
-Readbezier(file,optionorg):=(
-//help:Readbezier("xsr");
-//help:Readbezier(options=["Num=10","nogeo"]);
- regional(nn,options,stL,geo,nc,alpha,out,tmp,tmp1,tmp2,tmp3);
- options=optionorg;
- tmp=Divoptions(options);
- stL=tmp_7;
- geo=0;
- forall(stL,
- tmp=Toupper(substring(#,0,1));
- if(tmp=="G",geo=1);
- options=remove(options,[#]);
- );
- ReadOutData(file);
- tmp=file+"n_1_1";
- nn=parse(tmp);
- out=[];
- forall(1..nn,nc,
- tmp=file+text(nc);
- tmp1=parse(tmp+"k");
- tmp2=parse(tmp+"c");
- if(MeasureDepth(tmp2)==1,tmp2=[tmp2]); // 16.04.22from
- if(geo==1,
- alpha="abcdefghijklmnopqrstuvwxyz";
- forall(1..length(tmp1),
- tmp="k"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#);
- Putpoint(tmp,tmp1_#,parse(tmp+".xy"));
- inspect(parse(tmp),"labeled",false);
- inspect(parse(tmp),"ptsize",3);
- tmp1_#=parse(tmp+".xy");
- );
- forall(1..length(tmp2),
- tmp="c"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#)+"1";
- Putpoint(tmp,tmp2_#_1,parse(tmp+".xy"));
- inspect(parse(tmp),"labeled",false);
- inspect(parse(tmp),"color",4);
- inspect(parse(tmp),"ptsize",3);
- tmp2_#_1=parse(tmp+".xy");
- tmp="c"+BezierNumber+"no"+text(nc)+substring(alpha,#-1,#)+"2";
- Putpoint(tmp,tmp2_#_2,parse(tmp+".xy"));
- inspect(parse(tmp),"labeled",false);
- inspect(parse(tmp),"color",4);
- inspect(parse(tmp),"ptsize",3);
- tmp2_#_2=parse(tmp+".xy");
- );
- BezierNumber=BezierNumber+1;
- );
- Bezier(file+text(nc),tmp1,tmp2,options);// 16.04.22until
- out=append(out,"bz"+tmp);
- );
- out;
-);
-
-Ospline(nm,ptlist):=Ospline(nm,ptlist,[]);
-Ospline(nm,ptlist,options):=(
-//help:Ospline("1",ptlist,[options]);
- regional(tmp,tmp1,tmp2,list,ptL,ctrL,name,closed,flg,
- p0,p1,p2,p3,pQ,pR,cc,p01,p02,p11,p12,p21,p22,p31,p32);
- name="o"+nm;
- if(isstring(ptlist),list=parse(ptlist),list=ptlist);
- if(|list_1-list_(length(list))|<10^(-6),closed=1,closed=0);
-// list=apply(list,LLcrd(#));
- ctrL=[];
- forall(1..(length(list)-1),
- flg=0;
- p1=Lcrd(list_#); // 16.08.16
- p2=Lcrd(list_(#+1)); // 16.08.16
- if(#==1 % #==length(list)-1,
- flg=1;
- if(closed==0,
- pQ=(p1+2*p2)/3; // 15.09.21 // 16.08.16
- pR=(2*p1+p2)/3; // 16.08.16
- ctrL=append(ctrL,[pQ,pR]);
- flg=2;
- ,
- if(#==1,
- p0=Lcrd(list_(length(list)-1)); // 16.08.16
- p3=Lcrd(list_(#+2)); // 16.08.16
- ,
- p0=Lcrd(list_(#-1)); // 16.08.16
- p3=Lcrd(list_2); // 16.08.16
- );
- );
- );
- if(flg<=1,
- if(flg==0,
- p0=Lcrd(list_(#-1)); // 16.08.16
- p3=Lcrd(list_(#+2)); // 16.08.16
- );
- tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2);
- cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp;
- pQ=p1+cc*(p2-p0); // 15.09.21 // 16.08.16
- pR=p2+cc*(p1-p3); // 16.08.16
- ctrL=append(ctrL,[pQ,pR]);
- );
- );
-// list=apply(list,LLcrd(#)); // 16.08.16
-// ctrL=apply(ctrL,LLcrd(#));
- if(closed==0, // 15.09.21
- p1=ctrL_2_1;
- p2=Lcrd(list_2); // 16.08.16
- pQ=p2+(p2-p1);
- ctrL_1=[pQ];
- tmp=length(ctrL);
- tmp1=ctrL_(tmp-1);
- p1=ctrL_(tmp-1)_2;
- p2=Lcrd(list_(tmp)); // 16.08.16
- pQ=p2+(p2-p1);
- ctrL_tmp=[pQ];
- );
- Bezier("o"+nm,list,ctrL,options);
-);
-
-CRspline(nm,ptL):=CRspline(nm,ptL,[]);
-CRspline(nm,ptL,options):=(
- // Catmull-Rom spline
-//help:CRspline("1",[A,B,C,A]);
- regional(name,ptlist,ctrpts,eqL,opcindy,c,v,tmp,tmp1,tmp2,ctrlist,cflg);
- name="crsp"+nm;
- if(MeasureDepth(ptL)==1,tmp=[ptL],tmp=ptL);
- ptlist=tmp_1;
- if(length(tmp)==1,
- cflg=1;
- ,
- cflg=0;
- ctrpts=tmp_2;
- );
- c=1/6;
- tmp=Divoptions(options);
- eqL=tmp_5;
- opcindy=tmp_(length(tmp)); // 15.03.05
- forall(eqL,
- if(substring(#,0,1)=="R",
- tmp2=indexof(#,"=");
- c=parse(substring(#,tmp2,length(#)));
- );
- );
- ptlist=apply(ptlist,Lcrd(#)); // 16.08.16
- ctrlist=[];
- forall(1..(length(ptlist)-1),
- if(#==1,
- if(cflg==0,
- tmp1=ctrpts_1;
- ,
- v=ptlist_2-ptlist_(length(ptlist)-1);
- tmp1=ptlist_#+c*v;
- );
- ,
- v=ptlist_(#+1)-ptlist_(#-1);
- tmp1=ptlist_#+c*v;
- );
- if(#==length(ptlist)-1,
- if(cflg==0,
- tmp2=ctrpts_2;
- ,
- v=ptlist_2-ptlist_#;
- tmp2=ptlist_(#+1)-c*v;
- );
- ,
- v=ptlist_(#+2)-ptlist_#;
- tmp2=ptlist_(#+1)-c*v;
- );
- tmp=select(options,indexof(text(#),"->")>0);
- tmp=append(tmp,"notex"); //15.03.05
- Pointdata(name+text(#),[tmp1,tmp2],tmp);
- ctrlist=append(ctrlist,[tmp1,tmp2]);
- );
- Bezier(nm,ptlist,ctrlist,options);
-);
-
-Beziersmooth(nm,ptL):=Bzspline(nm,ptL,[]);
-//help:Beziersmooth("1",[A,B,C,A]);
-Beziersmooth(nm,ptL,options):=Bzspline(nm,ptL,options);
-Bzspline(nm,ptL):=Bzspline(nm,ptL,[]);
-Bzspline(nm,ptLorg,options):=(
- // smooth bezier
- regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr,
- tmp,tmp1,tmp2,cflg,ctrlist);
- name="bzsp"+nm;
- Eps=10^(-3);
- ptL=apply(ptLorg,Lcrd(#)); // 16.08.16
- if(|ptL_1-ptL_(length(ptL))|<Eps,cflg=1,cflg=0);
- forall(2..length(ptL),
- pt=ptL_#;
- pt1=ptL_(#-1);
- tmp1="C"+text(#-1)+"q";// 16.10.07
- Putpoint(tmp1,(pt1+4*pt)/5,Lcrd(parse(tmp1))); // 16.08.16
- );
- forall(2..(length(ptL)-1),
- if(#<length(ptL) % cflg==1,
- lstr="c"+text(#);
- pt=ptLorg_#; // 16.08.16
- pt1=parse("C"+text(#-1)+"q");
- create([lstr],"Join",[pt1,pt]);
- tmp2="C"+text(#)+"p";
- tmp=Append((2*pt.xy-pt1.xy),1);
- create([tmp2],"PointOnLine",[parse(lstr),tmp]);
- );
- );
- if(cflg==0,
- pt=ptL_1;
- pt1=ptL_2;
- tmp1="C1p";
- Putpoint(tmp1,(4*pt+pt1)/5,Lcrd(parse(tmp1))); // 16.08.16
- );
- if(cflg==1,
- lstr="c1";
- pt=ptLorg_1; // 16.08.16
- pt1=parse("C"+text(length(ptL)-1)+"q");
- create([lstr],"Join",[pt1,pt]);
- tmp1="C1p";
- tmp=Append((2*pt.xy-pt1.xy),1);
- create([tmp1],"PointOnLine",[parse(lstr),tmp]);
- );
- ctrlist=[];
- forall(1..(length(ptL)-1),
- if(#>1 % cflg==1,
- tmp1="c"+text(#);
- inspect(parse(tmp1),"alpha",0.3);
- );
- tmp1="C"+text(#)+"p";
- tmp2="C"+text(#)+"q";
- inspect(parse(tmp1),"ptsize",3);
- inspect(parse(tmp1),"color",3);
- inspect(parse(tmp2),"ptsize",3);
- inspect(parse(tmp2),"color",3);
- tmp=[parse(tmp1),parse(tmp2)];
- ctrlist=append(ctrlist,tmp);
- );
- Bezier(nm,ptL,ctrlist,options);
- [ptL,ctrlist];
-);
-
-Beziersym(nm,ptL):=Bzsspline(nm,ptL,[]);
-Beziersym(nm,ptL,options):=Bzsspline(nm,ptL,options);
-Bzsspline(nm,ptL):=Bzsspline(nm,ptL,[]);
-Bzsspline(nm,ptLorg,options):=(
- // smooth bezier with symmetric control points
- regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr,
- tmp,tmp1,tmp2,cflg,ctrlist);
- name="bzssp"+nm;
- Eps=10^(-3);
- ptL=apply(ptLorg,Lcrd(#)); // 16.08.16
- if(|ptL_1-ptL_(length(ptL))|<Eps,cflg=1,cflg=0);
- forall(2..length(ptL),
- pt=ptL_#;
- pt1=ptL_(#-1);
- tmp1="C"+text(#-1)+"q";
- Putpoint(tmp1,(pt1+4*pt)/5,Lcrd(parse(tmp1)));
- );
- forall(2..(length(ptL)-1),
- if(#<length(ptL) % cflg==1,
- pt=ptL_#;
- pt1=parse("C"+text(#-1)+"q");
- tmp2="C"+text(#)+"p=2*pt-pt1";
- parse(tmp2);
- );
- );
- if(cflg==0,
- pt=ptL_1;
- pt1=ptL_2;
- Putpoint("C1p",(4*pt+pt1)/5,Lcrd(C1p)); // 16.08.16
- inspect(C1p,"ptsize",3);
- inspect(C1p,"color",3);
- );
- if(cflg==1,
- pt=ptL_1;
- pt1=Lcrd(parse("C"+text(length(ptL)-1)+"q")); // 16.08.16
- tmp1="Putpoint("+Dq+"C1p"+Dq+",2*pt-pt1)"; // 16.08.16
- parse(tmp1);
- );
- ctrlist=[];
- forall(1..(length(ptL)-1),
- tmp1="C"+text(#)+"p";
- tmp2="C"+text(#)+"q";
- inspect(parse(tmp2),"ptsize",3);
- inspect(parse(tmp2),"color",3);
- tmp=[parse(tmp1),parse(tmp2)];
- ctrlist=append(ctrlist,tmp);
- );
- Bezier(nm,ptL,ctrlist,options);
- [ptL,ctrlist];
-);
-
-Listbspline2bz(listorg):=(
- regional(Eps,list,pcl,ptl,ctrl,k);
- Eps=10^(-3);
- list=apply(listorg,Lcrd(#)); // 16.08.16
- k=length(list);
- if(|list_1-list_k|>Eps,
- pcl=list;
- pcl_1=2*list_1-list_2;
- pcl_k=2*list_k-list_(k-1);
- ,
- pcl=concat(list,[list_2]);
- );
- ctrl=apply(2..(length(pcl)-1),[pcl_#]);
- ptl=apply(1..(length(pcl)-1),(pcl_#+pcl_(#+1))/2);
- [ptl,ctrl];
-);
-
-Bspline(nm,ctrL):=Bspline(nm,ctrL,[]);
-Bspline(nm,ctrL,options):=(
-//help:Bspline("",[A,B,C]);
- regional(list,tmp);
- list=Listbspline2bz(ctrL);
- tmp=BezierCurve("b"+nm,list_1,list_2,options);
- tmp;
-);
-
-MeetCurve(Crv,Xorg,Yorg):=(
- regional(Cv,tmp,tmp1,tmp2,X0,Y0,x1,x2,y1,y2,Ylist,Ban,Tate);
- if(isstring(Crv),Cv=parse(Crv),Cv=Crv);
- if(MeasureDepth(Cv)==2,Cv=Cv_1);
- Cv=apply(Cv,LLcrd(#)); // 14.12.18
- while(length(Cv)==1,
- Cv=Cv_1;
- );
- Cv=apply(Cv,Lcrd(#));
- tmp1=min(apply(Cv,#_1));
- tmp2=max(apply(Cv,#_1));
- if(isstring(Xorg),X0=parse(Xorg),X0=Xorg);
- if(isstring(Yorg),Y0=parse(Yorg),Y0=Yorg);
- if(X0<tmp1,
- X0=tmp1;
- ,
- if(X0>tmp2,
- X0=tmp2;
- );
- );
- tmp1=select(
- 1..(length(Cv)-1),Cv_#_1<=X0 & X0<=Cv_(#+1)_1);
- tmp2=select(
- 1..(length(Cv)-1),Cv_#_1>=X0 & X0>=Cv_(#+1)_1);
- tmp2=remove(tmp2,common(tmp2,tmp1));
- Ban=concat(tmp1,tmp2);
- Tate=select(Ban,
- abs(Cv_#_1-Cv_(#+1)_1)<=
- 10^(-2)*abs(Cv_#_2-Cv_(#+1)_2)
- );
- Ban=remove(Ban,Tate);
- Ylist=[];
- forall(Ban,
- tmp=Cv_#;
- x1=tmp_1; y1=tmp_2;
- tmp=Cv_(#+1);
- x2=tmp_1; y2=tmp_2;
- tmp=((x2-X0)*y1+(X0-x1)*y2)/(x2-x1);
- Ylist=append(Ylist,tmp);
- );
- forall(Tate,
- tmp=Cv_#;
- x1=tmp_1; y1=tmp_2;
- tmp=Cv_(#+1);
- x2=tmp_1; y2=tmp_2;
- tmp1=min([y1,y2]);
- tmp2=max([y1,y2]);
- if(Y0<tmp1,
- tmp=tmp1;
- ,
- if(Y0>tmp2,
- tmp=tmp2;
- ,
- tmp=Y0;
- );
- );
- Ylist=append(Ylist,tmp);
- );
- tmp=sort(Ylist,abs(#_1-Y0));
- [X0,tmp_1];
-);
-
-PutonLine(name,p1,p2):=PutonLine(name,p1,p2,[]);
-PutonLine(name,p1org,p2org,options):=(
-//help:PutonLine("C","sgAB");
-//help:PutonLine("C",pA,pB);
- regional(par,p1,p2,dx,dy,tmp,tmp1,tmp2);
- par=0.5;
- tmp=Divoptions(options);
- if(length(tmp_6)>0,
- par=tmp_6_1;
- );
- p1=Lcrd(p1org);//16.10.11from
- p2=Lcrd(p2org);
- dx=p2_1-p1_1;
- dy=p2_2-p1_2;
- tmp1=(1-par)*p1+par*p2;
- if(abs(dx)>abs(dy),
- tmp=name+".x";
- tmp2="["+tmp+",dy/dx*("+tmp+"-p1_1)+p1_2]";//16.10.11until
- Putpoint(name,tmp1,parse(tmp2));
- ,
- if(abs(dy)>0,
- tmp=name+".y";
- tmp2="[dx/dy*("+tmp+"-p1.y)+p1_1,"+tmp+"]";
- Putpoint(name,tmp1,parse(tmp2));
- ,
- tmp2=p1;//16.10.11
- Putpoint(name,tmp1,tmp2);
- );
- );
-);
-
-PutonSeg(name,sgstr):=(
- regional(seg,p1,p2);
- if(isstring(sgstr),seg=parse(sgstr),seg=sgstr);
- PutonSeg(name,LLcrd(seg_1),LLcrd(seg_2));
-);
-PutonSeg(name,p1,p2):=PutonSeg(name,p1,p2,[]);
-PutonSeg(name,p1org,p2org,options):=(
-//help:PutonSeg("C","sgAB");
-//help:PutonSeg("C",pA,pB);
- regional(par,dx,dy,p,tmp,tmp1,tmp2);
- par=0.5;
- tmp=Divoptions(options);
- if(length(tmp_6)>0,
- par=tmp_6_1;
- );
- p1=Lcrd(p1org);//16.10.11from
- p2=Lcrd(p2org);
- PutonLine(name,p1,p2,[par]);
- dx=p2_1-p1_1;
- dy=p2_2-p1_2;
- p=parse(name+".xy");
- p=LLcrd(p);
- if(abs(dx)>abs(dy) & (p_1-p1_1)*(p_1-p2_1)>0,
- if(|p-p1|<|p-p2|,
- parse(name+".xy=Pcrd(p1)");
- ,
- parse(name+".xy=Pcrd(p2)");
- );
- );
- if(abs(dx)<abs(dy) & (p_2-p1_2)*(p_2-p2_2)>0,
- if(|p-p1|<|p-p2|,
- parse(name+".xy=Pcrd(p1)");
- ,
- parse(name+".xy=Pcrd(p2)");//16.10.11until
- );
- );
-);
-
-PutonCurve(pn,crv):=PutonCurve(pn,crv,[]);
-PutonCurve(pn,crv,options):=(
-//help:PutonCurve("A","gr1");
- regional(Pmt,pstr,optionL,leftlim,rightlim,tmp,tmp1,Flg,Msg);
- if(!islist(options),optionL=[options],optionL=options);
- leftlim=XMIN;
- rightlim=XMAX;
- Flg=0;
- Msg="y";
- forall(optionL,
- if(isstring(#), // 16.02.10 from
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,tmp,tmp+1));
- if(tmp1=="N", Msg="n"); // 16.02.10 until
- ,
- if(Flg==0,
- leftlim=#;
- Flg=Flg+1;
- ,
- rightlim=#;
- );
- );
- );
- Pmt=MeetCurve(crv,leftlim,0);
- pstr=apply(allpoints(),textformat(#,5)); // 15.04.07
- if(!contains(pstr,pn),
- createpoint(pn,Pcrd(Pmt));
- ,
- tmp1=parse(pn+".x");
- if(tmp1< leftlim % tmp1>rightlim,
- if(tmp1< leftlim,tmp= leftlim, tmp=rightlim);
- Pmt=MeetCurve(crv,textformat(tmp,5),pn+".y");
- ,
- Pmt=MeetCurve(crv,pn+".x",pn+".y");
- );
- ptstr=pn+".xy="+textformat(Pcrd(Pmt),5)+";";
- parse(ptstr);
- );
- if(Msg=="y",
- println("Put "+pn+" on Curve "+text(crv));
- );
-);
-
-CrossPoint(name,Crv1,Crv2,range):=(
- regional(Mx1,Mx2,Mx3,tmp,Crs1,Crs2,Crs3,Crs4,df1,df2);
- Mx1=range_1; Mx2=range_2;
- repeat(15,
- Mx3=(Mx1+Mx2)/2;
- Crs1=MeetCurve(Crv1,Mx1,0);
- Crs2=MeetCurve(Crv2,Mx1,0);
- Crs3=MeetCurve(Crv1,Mx3,0);
- Crs4=MeetCurve(Crv2,Mx3,0);
- df1=Crs1_2-Crs2_2;
- df2=Crs3_2-Crs4_2;
- if((df1>0 & df2>0) % (df1<0 & df2<0),
- Mx1=Mx3;
- ,
- Mx2=Mx3;
- );
- );
- Putpoint(name,Crs1);
-);
-
-Setscaling(sc):=(
-//help:Setscaling(3);
- SCALEX=1;
- SCALEY=sc;
- Com0th("Setscaling("+sc+")");
- Setwindow("Msg=no");
-);
-
-Periodfun(defL,rep):=Periodfun(defL,rep,[]);
-Periodfun(defL,rep,optionorg):=( // 16.11.24
-//help:Periodfun(["0",[-1,0],"1",1,[0,1],1],2(num of repetition),options);
-//help:Periodfun(options=["Con=y"]);
-//help:Periodfun(defL=[function string, range, devision number,...]);
- regional(nn,fun,range,num,options,nr,maxfun,
- tmp,tmp1,tmp2,eqL,connect,minx,maxx,pdata,Eps,prept);
- options=optionorg;
- tmp=Divoptions(options);
- eqL=tmp_5;
- connect="Y";
- forall(eqL,
- tmp=indexof(#,"=");
- tmp2=substring(#,tmp,tmp+1);
- tmp=substring(#,0,3);
- if(Toupper(tmp)=="CON",
- connect=Toupper(tmp2);
- options=remove(options,[#]);
- );
- );
- minx=10000;
- maxx=-10000;
- mxfun="";
- pdata=[];
- forall(1..(length(defL)/3),nn,
- fun=defL_(3*nn-2);
- range=defL_(3*nn-1);
- tmp1=if(isstring(range_1),parse(range_1),range_1); //17.06.11(2lines)
- tmp2=if(isstring(range_2),parse(range_2),range_2);
- minx=min(minx,tmp1);
- maxx=max(maxx,tmp2);
- num=defL_(3*nn);
- options=append(options,"Num="+text(num));
- Plotdata("pe"+text(nn),fun,
- "x="+textformat([tmp1,tmp2],5),options);
- pdata=append(pdata,"grpe"+text(nn));
- tmp1=range_1; //17.06.11(4lines)
- if(isstring(tmp1),tmp1=replace(tmp1,"pi","%pi"),tmp1=format(tmp1,5));
- tmp2=range_2;
- if(isstring(tmp2),tmp2=replace(tmp2,"pi","%pi"),tmp2=format(tmp2,5));
- mxfun=mxfun+"elseif ("+tmp1+
- "<=x and x<"+tmp2+") then "+fun+" ";
- );
- per=maxx-minx;
- forall(1..rep,nr,
- tmp1=[];
- forall(pdata,
- Translatedata("p"+#+text(nr),#,[per*nr,0],options);
- Translatedata("m"+#+text(nr),#,[-per*nr,0],options);
- tmp1=concat(tmp1,["trp"+#+text(nr),"trm"+#+text(nr)]);
- );
- );
- pdata=concat(pdata,tmp1);
- if(connect=="Y",
- Eps=10^(-5);
- pdata=sort(pdata,[parse(#)_1_1]);
- prept=parse(pdata_1)_1;
- forall(1..(length(pdata)),
- tmp=parse(pdata_#);
- tmp1=tmp_1;
- tmp2=tmp_(length(tmp));
- if(|prept-tmp1|>Eps,
- Listplot("con"+text(#),[prept,tmp1],append(options,"da"));
- );
- prept=tmp_(length(tmp));
- );
- );
- mxfun=substring(mxfun,4,length(mxfun)-1);
- [mxfun,per];
-);
-
-Fourierseries(nm,coeff,per,nterm):=
- Fourierseries(nm,coeff,per,nterm,[]); // 16.11.24
-Fourierseries(nm,coeff,per,nterm,options):=(
-//help:Fourierseries("1",[c0,cn,sn],period,numterm,options);
- regional(c0,cn,sn,fs,tmp,tmp1,tmp2);
- c0=coeff_1;
- if(!isstring(c0),c0=format(c0,5));
- c0=replace(c0,"%pi","pi");
- cn=coeff_2;
- if(!isstring(cn),cn=format(cn,5));
- cn=replace(cn,"%pi","pi");
- sn=coeff_3;
- if(!isstring(sn),sn=format(sn,5));
- sn=replace(sn,"%pi","pi");
- fs=c0;
- forall(1..nterm,
- tmp=parse(Assign(cn,["n",#]));
- tmp1=Assign("("+format(tmp,5)+")*cos(n*2*pi/per*x)",
- ["n",#,"per",per]);
- tmp=parse(Assign(sn,["n",#]));
- tmp2=Assign("("+format(tmp,5)+")*sin(n*2*pi/per*x)",
- ["n",#,"per",per]);
- fs=fs+"+"+tmp1+"+"+tmp2;
- );
- Plotdata("four"+nm,fs,"x",options);
-);
-
-Tabledatalight(nm,xLst,yLst,rmvL):=Tabledatalight(nm,xLst,yLst,rmvL,[]);
-Tabledatalight(nm,xLst,yLst,rmvL,optionorg):=(
-//help:Tabledatalight("",xLst,yLst,rmvL,[2,"Rng=y"]);
- regional(options,rng,name,upleft,ul,flg,tick,eqL,reL,n,m,xsize,ysize,
- rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps);
-// name="tb"+nm;
- name="tb";
- options=optionorg;
- tmp=Divoptions(options);
- eqL=tmp_5; //16.12.16from
- reL=tmp_6;
- rng="Y";
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,2));
- tmp2=Toupper(substring(#,tmp,tmp+1));
- if(tmp1=="RN",
- rng=tmp2;
- options=remove(options,[#]);
- );
- );//16.12.16until
- tick=1;
- flg=0;
- forall(reL,
- if(flg==0,
- tick=#;
- flg=flg+1;
- ,
- upleft=tmp_6_1;
- );
- );
- tmp=sum(yLst);
- upleft=[0,tmp];
- TableOptions=options; // 16.11.28
- println("Tabledatalight "+name+" generated");
- ul=upleft/10;
- m=length(xLst);
- n=length(yLst);
- xsize=sum(xLst);
- ysize=sum(yLst);
- clist=[ul];
- rlist=[ul];
- forall(1..m,
- tmp1=clist_(#)_1+xLst_#/10;
- clist=append(clist,[tmp1,clist_1_2]);
- );
- forall(1..n,
- tmp1=rlist_(#)_2-yLst_#/10;
- rlist=append(rlist,[0,tmp1]);
- );
- Tb=[clist,rlist];
- tmp=name+"="+Tb;
- parse(tmp);
- forall(0..m,
- tmp1="c"+text(#)+"r0";
- tmp2="c"+text(#)+"r"+text(n);
- Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options);
- if(mod(#,tick)==0 % #==m,
- tmp=clist_(#+1);
- drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#));
- );
- );
- forall(0..n,
- tmp1="c0r"+text(#);
- tmp2="c"+text(m)+"r"+text(#);
- Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options);
- if(mod(#,tick)==0 % #==n,
- tmp=rlist_(#+1);
- drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#));
- );
- );
- Tsegrmv(rmvL,options);
- Addax(0);
- Eps=10^(-3);
- tmp1=clist_(length(clist));
- tmp2=rlist_1;
- tmp3=rlist_(length(rlist));
- if(rng=="Y", // 16.12.16
- Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]);
- );
- Tb;
-);
-
-Tabledata(nm,n,m,xsize,ysize,rmvL):=
- Tabledata(nm,n,m,xsize,ysize,rmvL,[]);
-Tabledata(nm,n,m,xsize,ysize,rmvL,options):=(
-//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]);
- regional(Tb,name,tmp,xLst,yLst);
- name="tb"+nm;
- xLst=apply(1..n,xsize/n);
- yLst=apply(1..m,ysize/m);
- Tabledata(nm,xLst,yLst,rmvL,options)
-);
-Tabledata(nm,xLst,yLst,rmvL):=Tabledata(nm,xLst,yLst,rmvL,[]);
-Tabledata(nm,xLst,yLst,rmvL,optionorg):=(
-//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]);
- regional(name,options,eqL,reL,rng,upleft,ul,flg,tick,n,m,xsize,ysize,
- rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps);
-// name="tb"+nm;
- name="tb";
- tmp=sum(yLst);
- upleft=[0,tmp];
- options=optionorg;
- tmp=Divoptions(options);
- eqL=tmp_5; //16.12.16from
- reL=tmp_6;
- rng="Y";
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,2));
- tmp2=Toupper(substring(#,tmp,tmp+1));
- if(tmp1=="RN",
- rng=tmp2;
- options=remove(options,[#]);
- );
- );//16.12.16until
- tick=1;
- flg=0;
- forall(reL,
- if(flg==0,
- tick=#;
- flg=flg+1;
- ,
- upleft=tmp_6_1;
- );
- );
- TableOptions=options; // 16.11.28
- println("Tabledata "+name+" generated");
- ul=upleft/10;
- m=length(xLst);
- n=length(yLst);
- xsize=sum(xLst);
- ysize=sum(yLst);
- clist=[ul];
- rlist=[ul];
- forall(1..m,
- tmp1=clist_(#)_1+xLst_#/10;
- clist=append(clist,[tmp1,clist_1_2]);
- );
- forall(1..n,
- tmp1=rlist_(#)_2-yLst_#/10;
- rlist=append(rlist,[0,tmp1]);
- );
- Tb=[clist,rlist];
- tmp=name+"="+Tb;
- parse(tmp);
- forall(0..m,
- tmp="C"+text(#);
- tmp1="c"+text(#)+"r0";
- if(#==0,
- Putpoint(tmp,Tgrid(tmp1));
- ,
- Putpoint(tmp,Tgrid(tmp1),[parse(tmp+".x"),C0.y]);
- clist_(#+1)=parse(tmp+".xy");
- );
- inspect(parse(tmp),"ptsize",3);
- inspect(parse(tmp),"labeled",false);
- if(mod(#,tick)==0 % #==m,
- tmp=clist_(#+1);
- drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#));
- );
- );
- forall(0..n,
- tmp="R"+text(#);
- tmp1="c0r"+text(#);
- if(#==0,
- Putpoint(tmp,Tgrid(tmp1));
- ,
- Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]);
- rlist_(#+1)=parse(tmp+".xy");
- );
- Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]);
- inspect(parse(tmp),"ptsize",3);
- inspect(parse(tmp),"labeled",false);
- if(mod(#,tick)==0 % #==n,
- tmp=rlist_(#+1);
- drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#));
- );
- );
- Tb=[clist,rlist];
- tmp=name+"="+Tb;
- parse(tmp);
- forall(0..m,
- tmp1="c"+text(#)+"r0";
- tmp2="c"+text(#)+"r"+text(n);
- Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options);
- if(#<m,
- tmp1=parse("C"+text(#));
- tmp2=parse("C"+text(#+1));
- tmp=(tmp1.xy+tmp2.xy)/2;
- drawtext(tmp+[-0.2,0.5],text((tmp2.x-tmp1.x)*10));
- );
- );
- forall(0..n,
- tmp1="c0r"+text(#);
- tmp2="c"+text(m)+"r"+text(#);
- Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options);
- if(#<n,
- tmp1=parse("R"+text(#));
- tmp2=parse("R"+text(#+1));
- tmp=(tmp1.xy+tmp2.xy)/2;
- drawtext(tmp-[1.2,0.1],text(abs(tmp1.y-tmp2.y)*10));
- );
- );
- Tsegrmv(rmvL,options);
- Addax(0);
- Eps=10^(-3);
- tmp1=clist_(length(clist));
- tmp2=rlist_1;
- tmp3=rlist_(length(rlist)); // 15.06.11
- if(rng=="Y", // 16.12.16
- Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]);
- );
- Tb;
-);
-
-Tseginfo(seg):=(
- regional(cr,tp,tpc,n1,n2,n3,tmp,tmp1,tmp2);
- if(substring(seg,0,2)=="sg",
- cr=substring(seg,2,length(seg));
- ,
- cr=seg;
- );
- tp=substring(cr,0,1);
- if(tp=="c",
- tpc="r";
- ,
- tpc="c";
- );
- tmp1=indexof(cr,tpc);
- tmp=substring(cr,tmp1,length(cr));
- tmp2=tmp1+indexof(tmp,tpc);
- n1=substring(cr,1,tmp1-1);
- n2=substring(cr,tmp1,tmp2-1);
- n3=substring(cr,tmp2,length(cr));
- [tp+n1,tpc,parse(n2),parse(n3)];
-);
-
-Tsegrmv(rmvL):=Tsegrmv(rmvL,[]);
-Tsegrmv(rmvL,options):=(
- regional(cr,gcL,flg,gc,hd,tail,tpc,m1,m2,n1,n2,tmp,tmp1,tmp2);
- forall(rmvL,cr,
- tmp1=Tseginfo(cr);
- hd=tmp1_1;
- tpc=tmp1_2;
- m1=tmp1_3;
- m2=tmp1_4;
- gcL=select(GCLIST,Tseginfo(#_1)_1==tmp1_1);
- flg=0;
- forall(gcL,
- if(flg==0,
- tmp=Tseginfo(#_1);
- n1=tmp_3;
- n2=tmp_4;
- if(m1>=n1 & m2<=n2,
- gc=#;
- flg=1;
- );
- );
- );
- if(flg==1,
- Changestyle([gc_1],["nodisp"]);
- tail="";
- if(indexof(hd,"r")>0,
- tail=hd; hd="";
- );
- if(n1<m1,
- tmp1=tpc+text(n1);
- tmp2=tpc+text(m1);
- tmp=hd+tail+tmp1+tmp2;
- Tlistplot(tmp,[hd+tmp1+tail,hd+tmp2+tail],options);
- );
- if(m2<n2,
- tmp1=tpc+text(m2);
- tmp2=tpc+text(n2);
- tmp=hd+tail+tmp1+tmp2;
- Tlistplot(tmp,[hd+tmp1+tail,hd+tmp2+tail],options);
- );
- );
- );
-);
-
-Tgrid(ptstr):=(
-//help:Tgrid("c2r5");
- regional(tmp,tmp1,tmp2);
- tmp=parse(ptstr);
- if(islist(tmp),
- tmp;
- ,
- tmp=indexof(ptstr,"r");
- tmp1=substring(ptstr,1,tmp-1);
- tmp1=parse(tmp1);
- tmp2=substring(ptstr,tmp,length(ptstr));
- tmp2=parse(tmp2);
- [tb_1_(tmp1+1)_1,tb_2_(tmp2+1)_2];
- );
-);
-
-Tlistplot(ptL):=Tlistplot(ptL,[]);
-Tlistplot(Ag1,Ag2):=(
- regional(nm,ptL,options);
- if(isstring(Ag1),
- nm=Ag1;
- ptL=Ag2;
- options=[];
- ,
- ptL=Ag1;
- options=Ag2;
- nm=ptL_1+ptL_2;
- );
- Tlistplot(nm,ptL,options);
-);
-Tlistplot(nm,ptL,options):=(
-//help:Tlistplot(["c0r0","c0r4"]);
-//help:Tlistplot("1",["c0r0","c0r4"]);
-//help:Tlistplot([options2="Msg=y"]);
- regional(tmp,tmp1);
- tmp1=divoptions(options);//180404from
- tmp1=tmp1_5;
- tmp1=apply(tmp1,Toupper(substring(#,0,1)));
- if(contains(tmp1,"M"),
- tmp1=options;
- ,
- tmp1=append(options,"Msg=n");
- );//180404to
- tmp=apply(ptL,Tgrid(#)); // 15.06.03
- Listplot(nm,tmp,tmp1);
-);
-
-ChangeTablestyle(nameL,style):=(
-////help:ChangeTablestyle(["r0c0c3"],["da"]);
- regional(nmL,grid,head,sb,tmp,tmp1,tmp2,
- tsg,segall,sg,str);
- if(islist(nameL),nmL=nameL,nmL=[nameL]);
- forall(nmL,grid,
- if(substring(grid,0,1)=="r",sb="c",sb="r");
- tmp=Indexall(grid,sb);
- head=substring(grid,0,tmp_1-1);
- tmp1=substring(grid,tmp_1,tmp_2-1);
- tmp2=substring(grid,tmp_2,length(grid));
- tsg=apply([tmp1,tmp2],parse(#));
- tmp1=apply(GCLIST,#_1); // 16.12.06from
- segall=[];
- forall(tmp1,
- tmp2=substring(#,2,length(#));
- tmp=indexof(tmp2,sb);
- tmp2=substring(tmp2,0,tmp-1);
- if(head==tmp2,segall=append(segall,#));
- );// 16.12.06until
- sg=[];
- forall(segall,
- tmp=Indexall(#,sb);
- tmp1=substring(#,tmp_1,tmp_2-1);
- tmp2=substring(#,tmp_2,length(#));
- tmp=apply([tmp1,tmp2],parse(#));
- if((tsg_1>=tmp_1) & (tsg_2<=tmp_2),
- sg=tmp;
- Changestyle(#,["nodisp"]);
- );
- );
- if(length(sg)==0,
- println("No segment includes "+grid);
- ,
- if(sb=="c",str=sb+"no"+head,str=head+sb+"no");
- if(sg_1<tsg_1,
- tmp1=replace(str,"no",text(sg_1));
- tmp2=replace(str,"no",text(tsg_1));
- tmp=head+sb+text(sg_1)+"c"+text(tsg_1);
- Tlistplot(tmp,[tmp1,tmp2],TableOptions);
- );
- tmp1=replace(str,"no",text(tsg_1));
- tmp2=replace(str,"no",text(tsg_2));
- tmp=head+"c"+text(tsg_1)+"c"+text(tsg_2);
- Tlistplot(tmp,[tmp1,tmp2],style);
- if(tsg_2<sg_2,
- tmp1=replace(str,"no",text(tsg_2));
- tmp2=replace(str,"no",text(sg_2));
- tmp=head+"c"+text(tsg_2)+"c"+text(sg_2);
- Tlistplot(tmp,[tmp1,tmp2],TableOptions);
- );
- );
- );
-);
-
-Findcell(pos1,pos2):=Findcell("",pos1,pos2);
-Findcell(Tbdata,pos1,pos2):=(
-//help:Findcell("c0r0","c2r1");
- regional(tmp1,tmp2,posnw,posse,ctr,dx,dy);
- if(isstring(pos1),
- posnw=Tgrid(pos1); // 15.05.20
- posse=Tgrid(pos2);
- //posnw=parse(pos1);
- //posse=parse(pos2);
- ,
- if(islist(pos1),
- posnw=pos1;
- posse=pos2;
- ,
- tmp1="c"+text(pos1-1)+"r"+text(pos2-1);
- tmp2="c"+text(pos1)+"r"+text(pos2);
- posnw=Tgrid(tmp1);
- posse=Tgrid(tmp2);
-// posnw=parse(tmp1);
-// posse=parse(tmp2);
- );
- );
- ctr=(posnw+posse)/2;
- dx=abs(posse_1-ctr_1);
- dy=abs(posnw_2-ctr_2);
- [ctr,dx,dy];
-);
-
-Putcell(pos1,pos2,dir,lttr):=Putcell("",pos1,pos2,dir,lttr);
-Putcell(Tbdata,pos1,pos2,dir,lttr):=(
-//help:Putcell("c0r0","c2r1","lt","abc");
-//help:Putcell(2,3,"c","xyz");
- regional(tmp,tmp1,tmp2,posnw,posse,
- posdir,posstr,ctr,dx,dy);
- tmp=Findcell(Tbdata,pos1,pos2);
- ctr=tmp_1; dx=tmp_2; dy=tmp_3;
- posdir=ctr;
- posstr=dir;
- if(indexof(dir,"b")>0,
- posdir_2=posdir_2-dy;
- posstr=replace(posstr,"b","n");
- );
- if(indexof(dir,"t")>0,
- posdir_2=posdir_2+dy;
- posstr=replace(posstr,"t","s");
- );
- if(indexof(dir,"l")>0,
- posdir_1=posdir_1-dx;
- posstr=replace(posstr,"l","e");
- );
- if(indexof(dir,"r")>0,
- posdir_1=posdir_1+dx;
- posstr=replace(posstr,"r","w");
- );
- Letter(posdir,posstr,text(lttr));
-);
-
-Putcellexpr(pos1,pos2,dir,ex):=Putcellexpr("",pos1,pos2,dir,ex);
-Putcellexpr(Tbdata,pos1,pos2,dir,ex):=(
-//help:Putcellexpr("c0r0","c2r1","lt","abc");
-//help:Putcellexpr(2,3,"c","\sin x");
- Putcell(Tbdata,pos1,pos2,dir,"$"+text(ex)+"$");
-);
-
-Putrow(nrow,dir,lttrL):=Putrow("",nrow,dir,lttrL);
-Putrow(Tbdata,nrow,dir,lttrL):=(
-//help:Putrow(1,"c",["x","y","z"]);
- regional(tmp,tmp1,mcol);
- mcol=length(lttrL);
- forall(1..mcol,
- Putcell(Tbdata,#,nrow,dir,lttrL_#);
- );
-);
-
-Putrowexpr(nrow,dir,exL):=Putrowexpr("",nrow,dir,exL);
-Putrowexpr(Tbdata,nrow,dir,exL):=(
-//help:Putrowexpr(2,"r",["x","y","z"]);
- regional(lttrL);
- lttrL=apply(exL,"$"+#+"$");
- Putrow(Tbdata,nrow,dir,lttrL);
-);
-
-PutcoL(mcol,dir,lttrL):=PutcoL("",mcol,dir,lttrL);
-PutcoL(Tbdata,mcol,dir,lttrL):=(
-//help:PutcoL(1,"c",["x","y","z"]);
- regional(tmp,tmp1,nrow);
- nrow=length(lttrL);
- forall(1..nrow,
- Putcell(Tbdata,mcol,#,dir,lttrL_#);
- );
-);
-PutcoLexpr(mcol,dir,exL):=PutcoLexpr("",mcol,dir,exL);
-PutcoLexpr(Tbdata,mcol,dir,exL):=(
-//help:PutcoLexpr(2,"r",["x","y","z"]);
- regional(lttrL);
- lttrL=apply(exL,"$"+#+"$");
- PutcoL(Tbdata,mcol,dir,lttrL);
-);
-
-Setrange():=(
-//help:Setrange();
- SW.xy=Pcrd([XMIN,YMIN]);
- NE.xy=Pcrd([XMAX,YMAX]);
- drawpoly([Pcrd([XMIN,YMIN]), Pcrd([XMAX,YMIN]),
- Pcrd([XMAX,YMAX]),Pcrd([XMIN,YMAX])],color->[1,1,1]);
-);
-
-Sciform(list):=(
- regional(plotlist,comp,pos,out,out2,nn,strL,flg,
- tmp,tmp1,tmp2,tmp3,Nj);
- plotlist=Flatten([list]);
- out=replace(plotlist_1,".xy","");
- out=replace(out,".x","(1)");
- out=replace(out,".y","(2)");
- if(length(plotlist)==1,
- comp=[];
- forall(1..length(out),
- comp=append(comp,substring(out,#-1,#));
- );
- out="";
- pos=0;
- forall(comp,
- if(#!="'",
- out=out+#;
- ,
- if(pos==0,
- tmp=indexof(out,"Assign(");
- if(substring(out,length(out)-7,length(out))=="Assign(",
- out=out+"'";
- pos=1;
- ,
- out=out+"Assign('";
- pos=2;
- );
- ,
- if(pos==2,
- out=out+"')";
- ,
- out=out+"'";
- );
- pos=0;
- );
- );
- );
- ,
- forall(2..length(plotlist),
- comp=plotlist_#;
- if(isstring(comp),
- pos=indexof(comp,"Assign(");
- if(pos>0,
- comp=substring(comp,6,length(comp));
- );
- out=out+"Assign(";
- comp=replace(comp,".xy","");
- comp=replace(comp,".x","(1)");
- comp=replace(comp,".y","(2)");
- out=out+"'"+comp+"'";
- out=out+"),";
- );
- if(islist(comp),
- forall(comp,
- out=out+"'"+#+"',";
- );
- );
- );
- if(length(plotlist)>1,
- out=substring(out,0,length(out)-1);
- out=out+");";
- );
- );
- pos=[];
- forall(1..length(out),
- tmp=indexof(substring(out,#-1,length(out)),"Assign");
- if(tmp>0,
- tmp1=#-1+tmp;
- if(length(pos)==0,
- pos=[tmp1];
- ,
- if(pos_(length(pos))<tmp1,
- pos=append(pos,tmp1);
- );
- );
- );
- );
- if(length(pos)>0,
- strL=[];
- Nj=0;
- forall(pos,
- tmp=substring(out,Nj,#-1);
- strL=append(strL,tmp);
- Nj=#-1;
- );
- strL=append(strL,substring(out,Nj,length(out)));
- out="";
- forall(strL,
- if(indexof(#,"Assign")==0,
- out=out+#;
- ,
- tmp=indexof(#,"('");
- tmp1=indexof(#,"')");
- tmp2=substring(#,tmp+1,tmp1-2);
- tmp3=substring(#,tmp1-2,length(#));
- if(indexof(tmp2,"=")==0,
- out=out+#;
- ,
- tmp=substring(tmp2,0,indexof(tmp2,"="));
- out=out+"'"+tmp+"'+"+"Assign('";
- tmp=substring(tmp2,indexof(tmp2,"="),length(tmp2));
- out=out+tmp+tmp3;
- );
- );
- );
- );
- out2=""; // patched 16.01.21 from
- nn=length(out);
- flg=0;
- forall(1..nn,
- if(flg==0,
- tmp=indexof(out,"='+Assign('");
- if(tmp==0,
- out2=out2+out;
- flg=1;
- ,
- out2=out2+substring(out,0,tmp);
- out=substring(out,tmp+10,length(out));
- tmp=indexof(out,"'"); // 16.04.19 from
- tmp1=substring(out,0,tmp-1);
- tmp2="1234567890";
- tmp=apply(1..length(tmp1),
- indexof(tmp2,substring(tmp1,#-1,#)));
- tmp=min(tmp);
- if(tmp==0, // 16.04.19 until
- out2=out2+"'+Assign('";
- ,
- tmp=indexof(out,"'");
- out=substring(out,0,tmp)+substring(out,tmp+1,length(out));
- // 16.04.18 until
- );
- );
- );
- );
- out2=replace(out2,"Dist=","D=");
- out2=replace(out2,"Dis=","D=");
- out2;
-);
-
-RSform(str):=RSform(str,3);
-RSform(str,listfrom):=(
-//help:RSform(string,listfrom);
- regional(posL,mxlv,rep1,rep2,rep3,prev,out,
- tmp,tmp1,tmp2);
- rep1="c("; rep2="c("; rep3="list(";
- if(listfrom<3,rep2="list(");
- if(listfrom==1,rep1="list(");
- posL=Bracket(str,"[]");
- tmp=apply(posL,#_2);
- mxlv=max(tmp);
- out="";
- prev=0;
- forall(posL,
- out=out+substring(str,prev,#_1-1);
- prev=#_1;
- if(#_2>0,
- tmp1=select(posL,tmp,(tmp_2<0)&(tmp_1>#_1));
- tmp1=tmp1_1_1;
- tmp=substring(str,#_1,tmp1);
- if(#_2==mxlv,out=out+rep1);
- if(#_2==mxlv-1,out=out+rep2);
- if(#_2<=mxlv-2,out=out+rep3);
- ,
- out=out+")";
- );
- );
- out=out+substring(str,prev,length(str));
- out=replace(out,".xy","");
- out=replace(out,".x","[1]");
- out=replace(out,".y","[2]");
- out=replace(out,"c(1)","[1]");//17.10.06(2lines)
- out=replace(out,"c(2)","[2]");
- out;
-);
-
-RSslash(str):=( //17.09.24
- regional(tmp);
- tmp=replace(str,"\","\\");
-// tmp=replace(tmp,"\\\\","\\");
- tmp;
-);
-
-Rform(list):=(
- regional(plotlist,comp,pos,out,strL,tmp,tmp1,tmp2,tmp3,Nj);
- out=list;
- out=replace(out,"[[[","list([[");
- out=replace(out,"[","c(");
- out=replace(out,"]",")");
- out=replace(out,".xy","");
- out=replace(out,".x","[1]");
- out=replace(out,".y","[2]");
- out;
-);
-
-Defvar(varstr):=(
- regional(name,value,tmp,tmp1);
- if(isstring(varstr),
- parse(varstr);
- tmp=indexof(varstr,"=");
- name=substring(varstr,0,tmp-1);
- value=substring(varstr,tmp,length(varstr));
- value=parse(value);
- tmp1=select(1..length(VLIST),VLIST_#_1==name);
- if(length(tmp1)>0,
- tmp=tmp1_1;
- VLIST_tmp=[name,value];
- ,
- VLIST=prepend([name,value],VLIST);
- );
- ,
- forall(1..(length(varstr)/2), // 16.11.16from
- name=varstr_(2*#-1);
- value=varstr_(2*#);
- Defvar(name,value);
- ); // 16.11.16until
- );
-);
-
-Defvar(name,value):=(
-//help:Defvar("a",0.3);
-//help:Defvar(["a",0.3,"b",2]);
- regional(tmp,tmp1);
- if(islist(value),
- tmp1="[";
- forall(value,
- if(isstring(#), // 16.11.14
- tmp1=tmp1+Dq+#+Dq+","; // 16.11.14
- ,
- tmp1=tmp1+format(#,5)+",";
- );
- );
- tmp1=substring(tmp1,0,length(tmp1)-1)+"]";
- ,
- tmp1=format(value,5);
- );
- tmp=name+"="+tmp1; // 15.02.06
- parse(tmp);
- VLIST=select(VLIST,#_1!=name); // 15.02.08
- VLIST=prepend([name,value],VLIST);
-);
-
-IftoR(strorg):=(
- regional(str,pre,post,sub,ppL,ifstr,out,tmp,tmp1,tmp2);
- str=strorg;
- ifstr=indexof(str,"if(");
- if(ifstr==0,
- out=replace(str,",","}else{");
- ,
- pre=substring(str,0,ifstr-1)+"if(";
- ppL=Bracket(str,"()");
- tmp1=ifstr+2;
- tmp=select(ppL,#_1==tmp1);
- tmp=select(ppL,#_2==-tmp_1_2);
- tmp2=tmp_1_1;
- sub=substring(str,tmp1,tmp2-1);
- post="}"+substring(str,tmp2,length(str));
- tmp=indexof(sub,",");
- tmp1=substring(sub,0,tmp-1);
- tmp2=substring(sub,tmp,length(sub));
- sub=tmp1+"){"+tmp2;
- tmp=IftoR(sub);
- out=pre+tmp+"}";
- );
- out;
-);
-
-FortoR(strorg):=(
- regional(str,pre,post,sub,ppL,forstr,out,tmp,tmp1,tmp2);
- str=strorg;
- forstr=indexof(str,"forall(");
- if(forstr==0,
- out=str;
- ,
- pre=substring(str,0,forstr-1)+"for(";
- ppL=Bracket(str,"()");
- tmp1=forstr+6;
- tmp=select(ppL,#_1==tmp1);
- tmp=select(ppL,#_2==-tmp_1_2);
- tmp2=tmp_1_1;
- sub=substring(str,tmp1,tmp2-1);
- post="}"+substring(str,tmp2,length(str));
- tmp=indexof(sub,",");
- tmp1=substring(sub,0,tmp-1);
- tmp2=substring(sub,tmp,length(sub));
- sub=tmp1+"){"+tmp2;
- tmp1=indexof(sub,"{");
- tmp2=indexof(sub,",");
- tmp=substring(sub,tmp1,tmp2-1);
- pre=pre+tmp+" in "+substring(sub,0,tmp1-1)+"{";
- sub=substring(sub,tmp2,length(sub));
- tmp=FortoR(sub);
- out=pre+tmp+"}";
- );
- out=replace(out,"..",":");
- out;
-);
-
-Deffun(name,bodylist):=(
-//help:Deffun("f(x)",["regional(y)","y=x^2*(x-3)","y"]);
- regional(funstr,str,Pos,nbody,bdy,ppL,bpL,excma,tmp,tmp1,tmp2);
- funstr=name+":=(";
- forall(bodylist,
- funstr=funstr+#+";";
- );
- funstr=funstr+");";
- parse(funstr);
- tmp=indexof(name,"(");
- str=substring(name,0,tmp-1)+"<-function(";
- str=str+substring(name,tmp,length(name))+"{";
- forall(1..(length(bodylist)-1),nbody,
- bdy=bodylist_nbody;
- Pos=indexof(bdy,"regional")+indexof(bdy,"local");
- if(Pos==0,
- bdy=replace(bdy,LFmark,"");
- bdy=replace(bdy," ","");
- ppL=Bracket(bdy,"()");
- bpL=Bracket(bdy,"[]");
- tmp1=select(bpL,#_2==1);
- tmp2=select(bpL,#_2==-1);
- excma=[];
- forall(1..(length(tmp1)),
- excma=append(excma,[tmp1_#_1,tmp2_#_1]);
- );
- tmp1=Indexall(bdy,",");
- forall(tmp1,cma,
- tmp=select(excma,(#_1<cma)&(cma<#_2));
- if(length(tmp)>0,
- bdy=substring(bdy,0,cma-1)+"'"+substring(bdy,cma,length(bdy));
- );
- );
- tmp=indexof(bdy,"forall");
- if(tmp>0,
- bdy=FortoR(bdy);
- );
- tmp=indexof(bdy,"if(");
- if(tmp>0,
- bdy=IftoR(bdy);
- );
- bdy=RSform(replace(bdy,"'",","));
- str=str+bdy+";";
- );
- );
- str=str+"return("+bodylist_(length(bodylist))+")}";
- FUNLIST=append(FUNLIST,str);
-);
-
-Windispg():=(
- regional(Nj,Nk,Dt,Vj,tmp,tmp1,tmp2,opcindy);
- gsave();
- layer(KETPIClayer);
- forall(GCLIST,Nj,
- if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17
- if(islist(Dt) & length(Dt)>0, // 12.19,12.22
- tmp=MeasureDepth(Dt);
- if(tmp==1,Dt=[Dt]);
- opcindy=Nj_3;
- if(Nj_2<0,tmp1=0,tmp1=Nj_2);
- if(tmp1<10,
- forall(Dt,Nk,
-// tmp2=apply(Nk,if(ispoint(#),Lcrd(#),#));
-// tmp2=apply(tmp2,Pcrd(#));
- tmp2=Nk; // 14.12.04
- if(length(Nk)>1,
- tmp="connect("+textformat(tmp2,5)+
- ",dashtype->"+text(tmp1)+",linecolor->"+KCOLOR+opcindy+")";
- parse(tmp);
- ,
- if(length(Nk)==1,
- tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31
- parse(tmp);
- );
- );
- );
- );
- );
- );
-// if(ADDAXES=="1", // 16.10.08from
-// draw([XMIN,0],[XMAX,0],color->[0,0.2,0]);
-// draw([0,YMIIN],[0,YMAX],color->[0,0.2,0]);
-// Letter([[XMAX,0],"e","x",[0,YMAX],"n","y"]);
-// Letter([[0,0],"sw","O"]);
-// ); // 16.10.08until
- grestore();
- layer(0);
-);
-
-Windispg(pltdata):=(
- regional(pdata,Nj,Nk,Dt,tmp,tmp1,tmp2,opcindy);
- gsave();
- layer(KETPIClayer);
- if(!islist(pltdata),tmp=[pltdata],tmp=pltdata);
- pdata=select(GCLIST,contains(tmp,#_1));
- forall(pdata,Nj,
- if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17
- if(islist(Dt) & length(Dt)>0, // 12.19,12.22
- tmp=MeasureDepth(Dt);
- if(tmp==1,Dt=[Dt]);
- opcindy=Nj_3;
- if(Nj_2<0,tmp1=0,tmp1=Nj_2);
- if(tmp1<10,
- forall(Dt,Nk,
- tmp2=Nk; // 14.12.04
- if(length(Nk)>1,
- tmp="connect("+textformat(tmp2,5)+ // 15.05.11
- ",dashtype->"+text(tmp1)+
- ",linecolor->"+KCOLOR+opcindy+")";
- parse(tmp);
- ,
- if(length(Nk)==1,
- tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31
- parse(tmp);
- );
- );
- );
- );
- );
- );
- grestore();
- layer(0);
-);
-
-WritetoSci():=WritetoRS(); //17.12.19
-WritetoRS():=WritetoRS(FnameR);// 17.09.17from
-WritetoRS(Arg):=(
- regional(string,filename,shch,tmp1,tmp2);
- if(isstring(Arg),
- string=Arg;
- if(indexof(string,".r")>0,
- filename=string;
- shch="";
- ,
- filename=FnameR;
- shch=string;
- );
- WritetoRS(filename,shch);
- ,
- if(Arg<=1,WritetoRS(FnameR,"all"));
- if(Arg==2,WritetoRS(FnameR,"sh"));
- );
-);
-WritetoRS(filename,shchoice):=(
- regional(Plist,Pos,GrL,str,tmp,tmp1,tmp2,cmd);
- println("Write to R "+filename);
- Plist=[];
- Pnamelist=[];
- forall(remove(allpoints(),[SW,NE]),
- tmp=Lcrd(#);
- tmp1=format(re(tmp_1),6);// 15.02.05
- tmp2=format(re(tmp_2),6);
- tmp=#.name+"="+"c("+tmp1+","+tmp2+");";
- tmp=tmp+"Assignadd('"+#.name+"',"+#.name+")";
- Plist=append(Plist,tmp);
- );
- SCEOUTPUT = openfile(filename);
- tmp=Datetime();
- println(SCEOUTPUT,"# date time="+tmp_1+" "+tmp_2);
- if(isstring(CindyPathName), // 16.12.25from
- if(length(CindyPathName)>0,
- println(SCEOUTPUT,
- "# path file="+CindyPathName+" "+CindyFileName+".cdy");
- ,
- println(SCEOUTPUT,"");
- );
- ,
- println(SCEOUTPUT,"");
- );
- tmp1=replace(Dirwork,"\","/");
- if((iswindows())&(indexof(tmp1,"Users")>0),
- tmp=Indexall(tmp1,"/");
- tmp2=substring(tmp1,tmp_3-1,length(tmp1));
- tmp1=substring(tmp1,0,tmp_3-1);
- println(SCEOUTPUT,"Drv=shell('echo %HOMEDRIVE%',intern=TRUE)");
- println(SCEOUTPUT,"Drv=Drv[length(Drv)]");
- println(SCEOUTPUT,"Hpath=shell('echo %HOMEPATH%',intern=TRUE)");
- println(SCEOUTPUT,"Hpath=Hpath[length(Hpath)]");
- println(SCEOUTPUT,"Rest="+Dqq(tmp2));
- println(SCEOUTPUT,"Path=paste(Drv,Hpath,Rest,sep='')");
- println(SCEOUTPUT,"setwd(Path)");
- ,
- println(SCEOUTPUT,"setwd('"+tmp1+"')");
- );//180409to
- tmp=replace(Libname,"\","/"); //17.09.24from
- println(SCEOUTPUT,"source('"+tmp+".r')");//temporary
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
- // 17.10.07added
- tmp=replace(tmp+"_rep2e","\","/");
- println(SCEOUTPUT,"source('"+tmp+".r')");
- );
- println(SCEOUTPUT,"Ketinit()");
- println(SCEOUTPUT,"cat(ThisVersion,'\n')");
- println(SCEOUTPUT,"Fnametex='"+Fnametex+"'");
- println(SCEOUTPUT,"FnameR='"+FnameR+"'");
- println(SCEOUTPUT,"Fnameout='"+Fnameout+"'");
- println(SCEOUTPUT,"arccos=acos; arcsin=asin; arctan=atan");
- println(SCEOUTPUT,"");
- forall(COM0thlist,
- if(indexof(#,"Texcom")==0, //17.09.22
- println(SCEOUTPUT,RSform(#));
- ,
- println(SCEOUTPUT,#);
- );
- );
- println(SCEOUTPUT,
- "Setwindow(c("+XMIN+","+XMAX+"), c("+YMIN+","+YMAX+"))");
- forall(Plist,
- println(SCEOUTPUT,#);
- );
- forall(VLIST,
- tmp=#_1;
- tmp1=#_2;
- if(!isstring(tmp1),
- if(islist(tmp1),
- tmp2="[";
- forall(tmp1,
- tmp2=tmp2+textformat(#,6)+",";
- );
- tmp1=substring(tmp2,0,length(tmp2)-1)+"]";
- ,
- tmp1=format(tmp1,6);
- );
- );
- tmp1=RSform(tmp1);
- print(SCEOUTPUT,tmp+"="+tmp1+";"); //17.09.22
-// tmp=substring(tmp,0,length(tmp)-1);
- println(SCEOUTPUT,"Assignadd('"+tmp+"',"+tmp+")");
- );
- forall(FUNLIST,
- println(SCEOUTPUT,#);
- );
- forall(GLIST,
- println(SCEOUTPUT,RSform(#));
- );
- tmp=text(Pnamelist);
- tmp=replace(tmp,"[","list(");
- Pnamelist=replace(tmp,"]",")");
- println(SCEOUTPUT,"PtL="+Pnamelist);
- tmp=select(GCLIST,#_2==-1);
- GrL=apply(tmp,#_1);
- tmp=text(GrL);
- tmp=replace(tmp,"[","list(");
- tmp=replace(tmp,"]",")");
- println(SCEOUTPUT,"GrL="+tmp);
- tmp1="";
- if(length(tmp1)>0,
- tmp1="WriteOutData(Fnameout"+tmp1+");";
- println(SCEOUTPUT,tmp1);
- );
- forall(COM1stlist,
- if(indexof(#,"Texcom")==0, //17.09.22
- println(SCEOUTPUT,RSform(#));
- ,
- println(SCEOUTPUT,#);
- );
- );
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"# Windisp(GrL)");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"if(1==1){");
- println(SCEOUTPUT,"");
- tmp1=replace(Dirwork,"\","/"); //180408to
- if((iswindows())&(indexof(tmp1,"Users")>0),
- println(SCEOUTPUT,"Path=paste(Path,"+Dqq("/"+Fnametex)+",sep='')");
- tmp="Openfile(Path,'"+ULEN+"'";
- ,
- tmp="Openfile('"+tmp1+"/"+Fnametex+"','"+ULEN+"'";
- );
- tmp=tmp+",'Cdy="+Cindyname()+".cdy"; //180404
- tmp=replace(tmp,"\","\\");
- println(SCEOUTPUT,tmp+"')");
- forall(COM2ndlist,
- if(indexof(#,"Texcom")==0, //17.09.22
- println(SCEOUTPUT,RSform(#));
- ,
- println(SCEOUTPUT,#);
- );
- );
- if(length(GrL)>0,
- println(SCEOUTPUT," Drwline(GrL)");
- );
- println(SCEOUTPUT,"Closefile('"+ADDAXES+"')");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"}");
- if(shchoice=="sh",
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"quit()");
- ,
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"#quit()");
- );
- closefile(SCEOUTPUT);
-); //17.09.17to
-
-Extractdata(name):=Extractdata(1,name,[]);
-Extractdata(Arg1,Arg2):=(
- if(isstring(Arg1),
- Extractdata(1,Arg1,Arg2);
- ,
- Extractdata(Arg1,Arg2,[]);
- );
-);
-Extractdata(number,name,options):=(
-//help:ExtractData("ha1");
-//help:ExtractData(1,"ha1");
- regional(dlist,tmp,tmp1,tmp2,tmp3,File,Ltype,Noflg,opstr,opcindy);
- tmp=Divoptions(options);
- Ltype=tmp_1;
- Noflg=tmp_2;
- opstr=tmp_(length(tmp)-1);
- opcindy=tmp_(length(tmp));
- tmp1=[];
- forall(1..length(GOUTLIST),
- if(contains(GOUTLIST_#_2,name),
- tmp1=append(tmp1,#);
- );
- );
- if(length(tmp1)==0,
- println(name+" not found");
- ,
- tmp1=tmp1_number;
- tmp2=GOUTLIST_tmp1;
- tmp=remove(tmp2_2,[name]);
- GOUTLIST_tmp1=[tmp2_1,tmp];
- File=tmp2_1;
- );
- if(Noflg<3,
- println("extract outdata "+name);
- tmp1=parse(name);
- tmp3=[ //17.09.18
- "Tmpout=ReadOutData("+Dq+File+Dq+")"
- ];
- GLIST=concat(GLIST,tmp3);
- );
- if(Noflg<2,
- if(isstring(Ltype),
- Ltype=GetLinestyle(text(Noflg)+Ltype,name);
- ,
- if(Noflg==1,Ltype=0);
- );
- GCLIST=append(GCLIST,[name,Ltype,opcindy]);
- );
- tmp2;
-);
-
-RemoveOut(pltlist):=(
- regional(name,tmp,tmp1,tmp2);
- forall(pltlist,name,
- tmp1=[];
- forall(GOUTLIST,
- tmp=remove(#_2,[name]);
- tmp1=append(tmp1,[#_1,tmp]);
- );
- GOUTLIST=tmp1;
- );
-);
-
-ReadOutData():=ReadOutData(Fnameout);
-ReadOutData(filename):=ReadOutData("",filename); //16.03.07
-ReadOutData(pathorg,filenameorg):=(
-//help:ReadOutData();
-//help:Readoutdata();
-//help:ReadOutData("file.txt");
-//help:Readoutdata("file.txt");
-//help:ReadOutData("/datafolder","file.txt");
-//help:Readoutdata("/datafolder","file.txt");
- regional(path,filename,varname,varL,ptL,pts,tmp,tmp1,tmp2,tmp3,tmp4,
- nmbr,cmdall,cmd,cmdorg,outdt,goutdt);
- path=pathorg; //16.03.07 from
- if(length(path)>0,
- setdirectory(path);
- if(indexof(path,"\")>0,tmp1="\",tmp1="/");
- tmp=substring(path,length(path)-1,length(path));
- if(tmp!=tmp1,path=path+tmp1);
- ); //16.03.07 until
- filename=filenameorg; // 16.04.17
- if(indexof(filename,".")==0,filename=filename+".txt");
- tmp=load(filename);
- cmdall=tokenize(tmp,"//");
- varname=cmdall_1;
- cmdall=cmdall_(2..length(cmdall));
- outdt=[];
- varL=[varname];
- ptL=[];
- forall(cmdall,cmdorg,
- cmd=replace(cmdorg,LFmark,"");
- if(length(cmd)>0,
- if(cmd=="start" % cmd=="end" % substring(cmd,0,1)=="[",
- if(cmd=="start",
- pts=[];
- );
- if(cmd=="end",
- ptL=append(ptL,pts);
- );
- if(substring(cmd,0,1)=="[",
- tmp1=parse(cmd);
- if(length(tmp1_1)==2,
- tmp1=apply(tmp1,Pcrd(#));
- );
- pts=concat(pts,tmp1);
- );
- ,
- if(length(ptL)>0,
- if(length(ptL)==1,
- ptL=ptL_1;
- tmp=apply(ptL,textformat(#,6));
- ,
- tmp="[";
- forall(ptL,tmp1,
- tmp=tmp+apply(tmp1,textformat(#,6))+",";
- );
- tmp=substring(tmp,0,length(tmp)-1)+"]";
- );
- ,
- tmp="[]";
- );
- parse(varname+"="+tmp);
- outdt=append(outdt,ptL);
- ptL=[];
- varname=cmd;
- varL=append(varL,varname);
- );
- );
- );
- if(length(ptL)>0,
- if(length(ptL)==1,
- ptL=ptL_1;
- tmp=apply(ptL,textformat(#,6));
- ,
- tmp="[";
- forall(ptL,tmp1,
- tmp=tmp+apply(tmp1,textformat(#,6))+",";
- );
- tmp=substring(tmp,0,length(tmp)-1)+"]";
- );
- ,
- tmp="[]";
- );
- parse(varname+"="+tmp);
- outdt=append(outdt,ptL);
- if(path=="",tmp=filename,tmp=path+filename); //16.03.07
- GOUTLIST=append(GOUTLIST,[tmp,varL]);
- if(length(path)>0, // 16.03.09
- setdirectory(Dirwork); // 16.03.07
- );
- print("readoutdata from "+tmp+" : ");
- println(varL);
- varL;
-);
-
-WriteOutData(filename,ptlist):=(
-//help:WriteOutData("file.txt",["g1",gr1,"sg",sgAB]);
-//help:Writeoutdata("file.txt",["g1",gr1,"sg",sgAB]);
- regional(nn,Gname,Gdata,Str,Gstr,Gj,Pt,Flg,tmp,tmp1,loopend);
- Flg=0;
- if(isstring(ptlist_(length(ptlist))),
- Flg=1;
- );
- SCEOUTPUT = openfile(filename);
- if(Flg==0,
- loopend=length(ptlist)/2;
- ,
- loopend=length(ptlist);
- );
- Gstr="[";
- forall(1..loopend,nn,
- if(Flg==0,
- Gname=ptlist_(2*nn-1);
- ,
- Gname=ptlist_nn;
- );
- Gstr=Gstr+Gname+",";
- println(SCEOUTPUT,Gname+"//");
- if(Flg==0,
- Gdata=ptlist_(2*nn);
- ,
- Gdata=parse(Gname);
- );
- Gdata=Flattenlist(Gdata);
- if(MeasureDepth(Gdata)==1,Gdata=[Gdata]);
- forall(Gdata,Gj,
- println(SCEOUTPUT,"start//");
- Str="";
- forall(Gj,Pt,
- if(length(Str)>0,
- Str=Str+","
- );
- Str=Str+"["+format(Pt_1,5)+",";
- Str=Str+format(Pt_2,5);
- if(length(Pt)<3,
- Str=Str+"]";
- ,
- Str=Str+","+format(Pt_3,5)+"]";
- );
- if(length(Str)>80,
- println(SCEOUTPUT,"["+Str+"]//");
- Str="";
- );
- );
- if(length(Str)>0,
- println(SCEOUTPUT,"["+Str+"]//");
- );
- if((nn==loopend) & (Gj==Gdata_(length(Gdata))),
- println(SCEOUTPUT,"end////");
- ,
- println(SCEOUTPUT,"end//");
- );
- );
- );
- closefile(SCEOUTPUT);
- Gstr=substring(Gstr,0,length(Gstr)-1)+"]";
- println("writeoutdata "+filename+":"+Gstr);
-);
-
-Makeshell():=(
- if(length(Texmain)>0,
- Texparent=Texmain;
- );
- if(length(Texparent)>0,
- Makeshell(Texparent);
- if(length(FigPdfList)>0,
- SCEOUTPUT=openfile(Texparent+".tex");
- forall(FigPdfList,println(SCEOUTPUT,#));
- closefile(SCEOUTPUT);
- );
- ,
- Makeshell(Fhead+"main");
- );
-);
-Makeshell(texmainfile):=Makeshell(texmainfile,"rtv");
-Makeshell(texmainfile,flow):=(
- regional(parent,tmp,tmp1,tmp2,tmp3,flg,tex,path,shnm);
- parent=Dirwork+Shellparent; // 16.05.29
- kc():=(
- println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04,06.07
- );
- tmp1="";
-// tmp2=parent;
- flg=0;
- forall(reverse(1..length(parent)),
- if(flg==0,
- tmp=substring(parent,#-1,#);
- if(tmp=="/" % tmp=="\", // 14.01.15
- tmp1=substring(parent,0,#-1);
- tmp2=substring(parent,#,length(parent));
- flg=1;
- );
- );
- );
- if(length(tmp1)>0,
- setdirectory(tmp1);
- );
- SCEOUTPUT = openfile(tmp2);
- println(SCEOUTPUT,"#!/bin/sh");
- println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); // 15.07.16
- tmp1=" "+Dq+Fhead+Dq+" "+Dq+texmainfile+Dq; // 15.12.11
- flg=0;
- forall(reverse(1..length(PathT)),
- if(flg==0,
- if(substring(PathT,#-1,#)=="/",
- tex=substring(PathT,#,length(PathT));
- path=substring(PathT,0,#-1);
- flg=1;
- );
- );
- );
- if(flg==0, // 17.10.13(Norbert)
- tex=PathT;
- path="";
- );
- if(indexof(flow,"r")>0,
- tmp=Dq+PathR+Dq+" --vanilla --slave < "+Fhead+".r";
- // 17.09.14
- println(SCEOUTPUT,tmp);
- );
- if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- tmp="rm "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- );
- if(tex=="xelatex",
- tmp="export PATH="+path+":${PATH}";
- println(SCEOUTPUT,tmp);
- tmp="xelatex"+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- tmp="rm "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- );
- if(tex=="pdflatex" % tex=="pdftex",//16.11.22from
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- );//16.11.22until
- if(tex=="lualatex",//16.12.16
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- );//16.12.16
- if(!isstring(Pathpdf),
- tmp="preview";
- ,
- tmp=Pathpdf;
- );
- if(tmp=="preview" % tmp=="skim", // 16.09.09from,16.10.20
- tmp="open -a "+Dq+tmp+Dq+" "+texmainfile+".pdf";
- ,
- tmp=Dq+tmp+Dq+" "+texmainfile+".pdf";
- );// 16.09.09until
- println(SCEOUTPUT,tmp); // 16.07.21until
- println(SCEOUTPUT,"exit 0");
- closefile(SCEOUTPUT);
- setdirectory(Dirwork);
-);
-
-Convsjiswin(dir,fname,ext):=( //180401
- regional(ctr,flg,mx,tmp);
- mx=200;
- ctr=0;flg=0;
- nkfwin(dir,fname,ext);
- while((!isexists(dir,fname+".out"))&(ctr<mx),
- wait(100);ctr=ctr+1;
- );
- if(ctr==mx,flg=1);
- if(flg==0,
- wait(100);ctr=0;
- nkfcpdel(dir,fname,ext);
- while((isexists(dir,fname+".out"))&(ctr<mx),
- wait(100);ctr=ctr+1;
- );
- if(ctr==mx,flg=2);
- );
- tmp=dir+pathsep()+fname+"."+ext;
- if(flg==0,
- tmp=
- println(tmp+" converted");
- ,
- println(tmp+" not converted "+text(flg));
- );
-);
-
-Makebat():=(
- if(length(Texmain)>0,
- Texparent=Texmain;
- );
- if(length(Texparent)>0,
- Makebat(Texparent);
- if(length(FigPdfList)>0,
- SCEOUTPUT=openfile(Texparent+".tex");
- forall(FigPdfList,println(SCEOUTPUT,#));
- closefile(SCEOUTPUT);
- );
- ,
- Makebat(Fhead+"main");
- );
-);
-Makebat(texmainfile):=Makebat(texmainfile,"rtv");
-Makebat(texmainfile,flow):=(
- regional(drive,fname,tmp,tmp1,tmp2,tmp3,flg,tex,path,batnm);
- drive="C:";
- fname=Dirwork+Batparent;
- kc():=(
- println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04
- );
- tmp=indexof(fname,":");
- if(tmp>0,
- drive=substring(fname,0,tmp);
- fname=substring(fname,tmp,length(fname));
- );
- tmp1="";
- tmp2=fname;
- flg=0;
- forall(reverse(1..length(fname)),
- if(flg==0,
- tmp=substring(fname,#-1,#);
- if(tmp=="/" % tmp=="\" % tmp=="\", // 14.01.15
- tmp1=substring(fname,0,#-1);
- tmp2=substring(fname,#,length(fname));
- flg=1;
- );
- );
- );
- if(length(tmp1)>0,
- setdirectory(drive+tmp1);
- );
- SCEOUTPUT = openfile(tmp2);
- fname=replace(Dirwork,"/","\");
- tmp=indexof(fname,":");
- if(tmp>0,
- drive=substring(Dirwork,0,tmp);
- fname=substring(Dirwork,tmp,length(Dirwork));
- println(SCEOUTPUT,drive);
- );
- tmp=Dirwork;//180408form
- if(iswindows(),
- if((isincludefull(Dirwork))&(isexists(Dirwork,"sjis.txt")),
- import("sjis.txt");
- );
- );
-// tmp=replace(tmp,"\","/"); //180408
-// println(SCEOUTPUT,"cd "+Dq+tmp+Dq); //180408
- tmp1=indexof(fname,"Users");//180409from
- tmp2=indexof(fname,Homehead);
- if((tmp1>0)%(tmp2>0),
- if(tmp1>0,
- fname=substring(fname,tmp1+length("Users")-1,length(fname));
- ,
- fname=substring(fname,tmp2+length(Homehead)-1,length(fname));
- );
- tmp=Indexall(fname,"\");//180403from
- fname=substring(fname,tmp_2,length(fname));
- fname="%HOMEPATH%\"+fname;
- );//180403to
- println(SCEOUTPUT,"cd "+Dq+fname+Dq);//180409to
- flg=0;
- tmp=replace(PathT,"\","/");
- forall(reverse(1..length(PathT)),
- if(flg==0,
- if(substring(tmp,#-1,#)=="/",
- tex=substring(PathT,#,length(PathT));
- path=substring(PathT,0,#-1);
- flg=1;
- );
- );
- );
- if(flg==0, // 17.10.13(Norbert)
- tex=PathT;
- path="";
- );
- if(indexof(flow,"r")>0,
- tmp=Dq+PathR+"\R"+Dq+" --vanilla --slave < "+Fhead+".r";
- // 17.09.14
- println(SCEOUTPUT,tmp);
- );
- if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- tmp="del "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- );
- if(tex=="xelatex",
- tmp="set Path = %Path%;"+Dq+path+Dq;
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- tmp="xelatex"+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- tmp="del "+texmainfile+".dvi";
- println(SCEOUTPUT,tmp);
- );
- if(tex=="pdflatex" % tex=="pdftex",//16.11.22from
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- );//16.11.22until
- if(tex=="lualatex",//16.12.16
- tmp=Dq+PathT+Dq+" "+texmainfile+".tex";
- println(SCEOUTPUT,tmp);
- if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14
- );//16.12.16
- if(!isstring(Pathpdf),
- tmp=indexof(PathS,"\scilab");// 15.12.12
- tmp=substring(PathS,0,tmp-1)+"\SumatraPDF\SumatraPDF.exe";
- ,
- tmp=Pathpdf;
- );
- tmp=Dq+tmp+Dq+" "+texmainfile+".pdf";
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"exit 0");
- closefile(SCEOUTPUT);
- if(indexof(Dirwork,":")==0, // 14.01.15
- drive="C:";
- ,
- drive="";
- );
- setdirectory(drive+Dirwork);
-);
-
-Addpackage(packorg):=(
-//help:Addpackage("bm");
-//help:Addpackage(["bm","enumerate"]);
-//help:Addpackage(["bm","[c]{somepackage}"]);
- regional(packL,tmp);
- packL=packorg; //17.06.25from
- if(!islist(packL),packL=[packL]);
- packL=apply(packL,replace(#,"\","/"));
- forall(1..(length(packL)),
- tmp=packL_#;
- if(substring(tmp,0,11)=="ketpicstyle",
- tmp=replace(Dirhead+"/"+tmp,"\","/");
- );
- if(indexof(tmp,"[")==0,
- packL_#="{"+tmp+"}";
- );
- );
- ADDPACK=concat(ADDPACK,packL); //17.06.25until
-);
-
-Viewtex():=(
- regional(texfile,tmp,tmp1,sep);
- texfile=Fhead+"main";
-// if(iswindows(),sep="\",sep="/"); // 17.04.07
-// sep="/";
- SCEOUTPUT=openfile(texfile+".tex");
- tmp="\documentclass{article}"; // 16.06.09from
- if(indexof(PathT,"platex")>0,
- tmp=replace(tmp,"article","jarticle");
- if(indexof(PathT,"uplatex")>0, //17.08.13from
- tmp=replace(tmp,"jarticle","ujarticle");
- );//17.08.13until
- ); // 16.06.09until
- println(SCEOUTPUT,tmp);
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0) ,
- //16.11.23,12.16
- if(indexof(PathT,"pdflatex")>0,
- println(SCEOUTPUT,"\usepackage[pdftex]{pict2e}");//16.11.24
- ,
- println(SCEOUTPUT,"\usepackage{pict2e}");//16.12.16
- println(SCEOUTPUT,"\usepackage{luatexja}");//16.12.18
- );
- tmp=replace(Dirhead,"\","/"); //17.10.30from
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic2e}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer2e}");
- );
- ,
- tmp=replace(Dirhead,"\","/");
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
- );
- );//17.10.30until
- println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
- println(SCEOUTPUT,"\usepackage{graphicx}");
- println(SCEOUTPUT,"\usepackage{color}");
- forall(ADDPACK, // 16.05.16from
- println(SCEOUTPUT,"\usepackage"+#); //17.05.25
- );// 16.05.16until
- println(SCEOUTPUT,"");
-// println(SCEOUTPUT,"\def\ketcindy{{K\kern-.20em%"); // deleted 16.11.27,recovered11.29 redeleted17.04.07
-// println(SCEOUTPUT,"\lower.5ex\hbox{E}\kern-.125em{TCindy}}}");
-// println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\setmargin{20}{20}{20}{20}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\begin{document}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\verb|"+Fhead+"| by \ketcindy");// 16.01.12, 18, 16.04.08
-// println(SCEOUTPUT,"\verb|"+Fhead+"| by KeTCindy");// 16.11.29 temporarily
- println(SCEOUTPUT,"\vspace{5mm}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\input{"+Fhead+".tex}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\end{document}");
- closefile(SCEOUTPUT);
- if(iswindows(),
- kc():=(
- println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04
- );
- Makebat(texfile);
- ,
- kc():=(
- println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04
- );
- Makeshell(texfile);
- );
- WritetoRS(2); //17.09.19
-);
-
-Viewparent():=( //17.04.13
- if(!isexists(Dirwork,Texparent+".tex"),
- if(isstring(Texparent),
- drawtext(mouse().xy,Texparent+".tex not exist",
- size->24,color->[1,0,0]);
- ,
- drawtext(mouse().xy,"Texparent not defined",
- size->24,color->[1,0,0]);
- );
- ,
- if(iswindows(),
- Makebat();
- ,
- Makeshell();
- );
- WritetoRS(2); //17.09.29
- kc();
- );
-);
-
-Makecmdlist(libname):=(
-//help:Makecmdlist("ketcindylib");
- regional(cmdall,cmd,flg,tmp,tmp1,tmp2,out);
- setdirectory(Dirlib);
- tmp=load(libname+".cs");
- cmdall=tokenize(tmp,":=");
- out=[];
- forall(cmdall,cmd,
- tmp=max([0,length(cmd)-50]);
- tmp1=";"+substring(cmd,tmp,length(cmd));
- flg=0;
- forall(reverse(1..length(tmp1)),
- if(flg==0,
- if(substring(tmp1,#-1,#)==";",
- tmp=substring(tmp1,#,length(tmp1));
- tmp2=substring(tmp,0,1);
- if(length(tmp)>0,
- if(!contains([" ","/"],tmp2),
- out=append(out,tmp);
- flg=1;
- );
- );
- );
- );
- );
- );
- setdirectory(Dirwork);
- tmp=length(out)-1;
- out=out_(2..tmp);
- out=sort(out);
-);
-
-Savecmdlist(cmdlist,cmdfile):=(
- SCEOUTPUT=openfile(cmdfile+".cs");
- forall(cmdlist,
- println(SCEOUTPUT,#);
- );
- closefile(SCEOUTPUT);
-);
-
-Quicksort(seq):=(
- regional(pivot,left,right,out);
- if(length(seq)<2,
- out=seq;
- ,
- pivot = max(seq_1,seq_2);
- left = [];
- right = [];
- forall(seq,
- if(#< pivot,
- left=append(left,#);
- ,
- right=append(right,#);
- );
- );
- left = Quicksort(left);
- right = Quicksort(right);
- out=concat(left,right);
- );
- out;
-);
-
-Lessstr(st1,st2):=(
- regional(tmp,tmp1,tmp2,out);
- tmp=min(length(st1),length(st2));
- flg=0;
- forall(1..tmp,
- if(flg==0,
- tmp1=substring(st1,#-1,#);
- tmp2=substring(st2,#-1,#);
- if(tmp1<tmp2,
- out=(1<2);
- flg=1;
- ,
- if(tmp1>tmp2,
- out=(1>2);
- flg=1;
- );
- );
- );
- );
- if(flg==0,
- if(length(st1)<length(str2),
- out=(1<2);
- ,
- out=(1>2);
- );
- );
- out;
-);
-
-Figpdf():=Figpdf(Texparent,[]);
-Figpdf(Arg1):=(
- if(isstring(Arg1),
- Figpdf(Arg1,[]);
- ,
- Figpdf(Texparent,Arg1);
- );
-);
-Figpdf(fnameorg,optionorg):=(
-//help:Figpdf();
-//help:Figpdf([10,,10,,[0,2] ]);(margin(4),move)
-//help:Figpdf([[0,0]]);(move)
-//help:Figpdf(options=[5,5,5,5,[0,0]]]);
- regional(options,fname,mar,pos,dp,sc,tmp,tmp1,tmp2,sep);
- fname=fnameorg;
- if(indexof(fnameorg,".")==0,
- fname=fnameorg+".tex";
- );
- tmp=apply(optionorg,if(isstring(#),parse("["+#+"]"),#)); // 16.04.07
- tmp=select(tmp,#!=[]);
- options=optionorg;//16.11.08from
-// mar=[5,5,5,5];
- dp=[0,-3];
- tmp=select(options,islist(#));
- if(length(tmp)>0,
- dp=tmp_1;
- options=remove(options,tmp);
- );
- tmp=4-length(options);
- tmp1=apply(1..tmp,5);
- mar=concat(options,tmp1);
- mar=apply(mar,if(length(#)==0,5,#));//16.11.08until
- pos=[mar_1+dp_1,mar_3+dp_2];
- sc=10;
- tmp=indexof(ULEN,"cm");
- if(tmp>0,
- tmp1=Removespace(substring(ULEN,0,tmp-1));
- sc=parse(tmp1)*10;
- );
- tmp=indexof(ULEN,"mm");
- if(tmp>0,
- tmp1=Removespace(substring(ULEN,0,tmp-1));
- sc=parse(tmp1);
- );
- tmp="\documentclass{article}"; // 16.06.09from
- if(indexof(PathT,"platex")>0,
- tmp=replace(tmp,"article","jarticle");
- if(indexof(PathT,"uplatex")>0, //17.08.13from
- tmp=replace(tmp,"jarticle","ujarticle");
- );//17.08.13until
- );
- FigPdfList=append(FigPdfList,tmp); // 16.06.09until
- tmp1="\special{papersize=W mm,H mm}";
- tmp=(XMAX-XMIN)*sc+(mar_1+mar_2);
- tmp1=replace(tmp1,"W",text(tmp));
- tmp=(YMAX-YMIN)*sc+(mar_3+mar_4);
- tmp1=replace(tmp1,"H",text(tmp));
-// if(iswindows(),sep="\",sep="/");//17.04.08
-// sep="/";
- FigPdfList=append(FigPdfList,tmp1);
- if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")>0, //17.11.05from
- FigPdfList=append(FigPdfList,
- "\usepackage{pict2e}");
- tmp=replace(Dirhead,"\","/");
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- FigPdfList=append(FigPdfList,
- "\usepackage{ketpic2e,ketlayer2e}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- FigPdfList=concat(FigPdfList,
- ["\usepackage{"+tmp+"/ketpic2e}",
- "\usepackage{"+tmp+"/ketlayer2e}"]);
- );
- ,
- tmp=replace(Dirhead,"\","/");
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- FigPdfList=append(FigPdfList,
- "\usepackage{ketpic,ketlayer}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- FigPdfList=concat(FigPdfList,
- ["\usepackage{"+tmp+"/ketpic}",
- "\usepackage{"+tmp+"/ketlayer}"]);
- );
- );//17.11.05until
- FigPdfList=append(FigPdfList,
- "\usepackage{amsmath,amssymb}");
- FigPdfList=append(FigPdfList,
- "\usepackage{graphicx,color}");
- forall(ADDPACK, // 16.05.16from
- tmp1="\usepackage"+#; //17.07.10
- FigPdfList=append(FigPdfList,tmp1); // 16.09.05until
- );
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,
- "\setmargin{0}{0}{0}{0}");
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,"\begin{document}");
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,
- "\begin{layer}{50}{0}");
- tmp1="\putnotese{X}{Y}{\input{";
- tmp1=replace(tmp1,"X",text(pos_1));
- tmp1=replace(tmp1,"Y",text(pos_2));
- FigPdfList=append(FigPdfList,tmp1+Fhead+".tex}}");
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,"\end{layer}");
- FigPdfList=append(FigPdfList,"");
- FigPdfList=append(FigPdfList,"\end{document}");
- if(fnameorg!=Texparent,
- SCEOUTPUT=openfile(fname);
- forall(FigPdfList,println(SCEOUTPUT,#));
- closefile(SCEOUTPUT);
- );
- FigPdfList;
-);
-
-Makehelplist(libname):=(
- regional(cmdall,cmd,flg,lev,tmp,tmp1,out);
- tmp=load(libname);
- cmdall=tokenize(tmp,"//help:");
- cmdall=select(cmdall,substring(#,1,3)!=");");
- flg=0;
- forall(1..3,
- if(flg==0,
- if(substring(cmdall_#,0,7)=="start()",
- cmdall=cmdall_((#+1)..length(cmdall));
- flg=1;
- );
- );
- );
- flg=0;
- tmp=length(cmdall);
- forall(0..2,
- if(flg==0,
- if(substring(cmdall_(tmp-#),0,5)=="end()",
- cmdall=cmdall_(1..(tmp-#-1));
- flg=1;
- );
- );
- );
- out=[];
- forall(cmdall,cmd,
- tmp1=indexof(cmd,"(");
- lev=1;
- flg=0;
- forall((tmp1+1)..length(cmd),
- if(flg==0,
- tmp=substring(cmd,#-1,#);
- if(tmp=="(",lev=lev+1);
- if(tmp==")",
- lev=lev-1;
- if(lev==0,
- flg=1;
- out=append(out,substring(cmd,0,#)+";");
- );
- );
- );
- );
- );
- sort(out);
-);
-
-Helplist():=Helplist(Dirlib,["+","+3d"],"helpJ");
-// 15.05.22
-Helplist(Arg):=(
- if(islist(Arg),
- Helplist(Dirlib,Arg,"helpJ"); // 15.06.20
- ,
- if(indexof(Arg,"help")>0,
- Helplist(Dirlib,["+","+3d"],Arg);
- ,
- Helplist(Arg,["+","+3d"],"helpJ");
- );
- );
-);
-Helplist(Arg1,Arg2):=(
- if(islist(Arg1),
- Helplist(Dirlib,Arg1,Arg2);
- ,
- if(indexof(Arg2,"help")>0,
- Helplist(Dirlib,Arg1,Arg2);
- ,
- Helplist(Arg,["+","+3d"],Arg2);
- );
- );
-);
-Helplist(dir,files,help):=(
-//help:Helplist();
-//help:Helplist("helpE");
- regional(ketfiles,tmp,tmp1,tmp2);
- setdirectory(dir);
- if(contains(files,"+"),
- tmp=remove(files,["+"]);
- ketfiles=concat(["+basic1","+basic2","+out"],tmp);
- ,
- ketfiles=files;
- );
- ketfiles=apply(ketfiles,replace(#,"+","ketcindylib"));
- ketfiles=apply(ketfiles,#+"r.cs"); // 15.11.05 from
- tmp=apply(files,replace(#,"+","ketcindylib"));
-// tmp=apply(files,replace(#,"r.cs",""));
-// tmp=remove(tmp,["ketcindylibout"]);
-// tmp=apply(tmp,replace(#,"basic",""));
- tmp=apply(tmp,#+help+".txt");
- ketfiles=concat(ketfiles,tmp);// 15.11.05 until
- tmp1=[];
- forall(ketfiles,
- tmp=Makehelplist(#);
- tmp1=concat(tmp1,tmp);
- );
- if(!islist(HLIST), // 16.12.31from
- HLIST=sort(tmp1);
- ,
- HLIST=sort(concat(HLIST,tmp1));
- ); // 16.12.31until
- setdirectory(Dirwork);
-);
-
-
-Help():=(
- forall(HLIST,
- println(#);
- );
-);
-Help(strorg):=(
-//help:Help("Plot");
-//help:Help("*");
- regional(str,sel,tmp,tmp1,tmp2,flg,Endflg);
- if(length(HLIST)>0,flg=0,flg=-1);
- str=replace(strorg,"'",Dq); // 15.11.25
- if(length(str)==0,
- forall(HLIST,
- if(indexof(#,"*")>0,
- println(#);
- );
- flg=1;
- );
- ,
- if(str=="*",
- sel=HLIST;
- ,
- sel=select(HLIST,substring(#,0,length(str))==str);
- );
- if(length(sel)>0,flg=1);
- forall(sel,
- tmp=indexof(#,"(");
- if(substring(#,tmp-2,tmp-1)!="*",
- println(#);
- ,
-// println(substring(#,0,tmp-1));
- tmp1=substring(#,tmp,length(#)-2);
- tmp2=indexof(tmp1,"//");
- Endflg=0;
- forall(1..4,
- if(Endflg==0,
- tmp2=indexof(tmp1,"//");
- if(tmp2==0,
- println(" "+tmp1);
- Endflg=1;
- ,
- println(" "+substring(tmp1,0,tmp2-1));
- tmp1=substring(tmp1,tmp2+1,length(tmp1));
- );
- );
- );
- );
- );
- );
- if(flg==-1,println(" Help not read in"));
- if(flg==0,println(" no example"));
-);
-
-Helpkey(str):=(
- regional(tmp,tmp1,tmp2);
- tmp1=select(HLIST,indexof(#,str)>0);
- forall(tmp1,
- tmp=substring(#,0,indexof(#,"*")-1);
- Help(tmp);
- );
-);
-Helpkey(str1,str2):=(
-//help:Helpkey(keyword);
-//help:Helpkey(keyword1,keyword2);
- regional(tmp,tmp1,tmp2);
- tmp1=select(HLIST,indexof(#,str1)>0);
- tmp1=select(tmp1,indexof(#,str2)>0);
- forall(tmp1,
- tmp=substring(#,0,indexof(#,"*")-1);
- Help(tmp);
- );
-);
-
-Slidework():=Slidework(Dirwork); // 16.06.10
-Slidework(dirorg):=(
-//help:Slidework(directory);
- regional(dir,tmp); // 16.06.25
- dir=replace(dirorg,unicode("000a"),""); // 16.06.25
- dir=replace(dir,"/",pathsep());//17.11.20from
- dir=replace(dir,"\",pathsep());
- tmp=length(dir);
- if(substring(dir,tmp-1,tmp)==pathsep(),
- dir=substring(dir,0,tmp-1);
- );//17.11.20until
- if(isexists(dir,""), // 16.12.20
- Changework(dir);
- println(makedir(dir,"fig"));//17.11.23
- tmp=dir+pathsep()+"fig"; //17.04.16from
- Changework(tmp);// 17.02.19until
- ,
- println(dir+ " not exists");
- );
-);
-
-Setslidepage():=( // 17.03.05
- regional(tmp1,tmp2,tmp3);
- tmp1=["letterc","boxc","framec","shadowc","xpos","size"];
- tmp2=apply([1,2,4,5,7,8],SlideColorList_#);
- tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
- println(tmp3);
-);
-Setslidepage(list):=( // 16.12.22
-//help:Setslidepage([letterc,boxc,framec,shadowc,xpos,size]);
- regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
- letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
- shadowc=[0,0,0,0.5]; mboxc="yellow";
- if(!islist(SlideColorList),
- SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
- letterc,mboxc,mboxc,mboxc,62,2,letterc];
- );
- numlist=[1,2,4,5,7,8];
- forall(1..(length(list)),
- if(length(list_#)>0,
- tmp=numlist_#;
- SlideColorList_tmp=list_#;
- );
- );
- SlideColorList_3=SlideColorList_2;
- SlideColorList_6=SlideColorList_5;
-);
-
-Setslidemain():=( // 17.03.05
- regional(tmp1,tmp2,tmp3);
- tmp1=["letterc","boxc","framec","xpos","size"];
- tmp2=apply([9,10,12,13,14],SlideColorList_#);
- tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
- println(tmp3);
-);
-Setslidemain(list):=( // 16.12.22
-//help:Setslidemain([letterc,boxc,framec,xpos,size]);
- regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
- letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
- shadowc=[0,0,0,0.5]; mboxc="yellow";
- if(!islist(SlideColorList),
- SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
- letterc,mboxc,mboxc,mboxc,62,2,letterc];
- );
- numlist=[9,10,12,13,14];
- forall(1..(length(list)),
- if(length(list_#)>0, //17.01.04
- tmp=numlist_#;
- SlideColorList_tmp=list_#;
- );
- );
- SlideColorList_11=SlideColorList_10;
-);
-
-Setslidebody():=( // 17.03.05
- regional(tmp1,tmp2,tmp3);
- tmp1=["letterc","style","thindense"];
- tmp2=[SlideColorList_(15),BodyStyle,ThinDense];
- tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#);
- println(tmp3);
-);
-Setslidebody(str):=(
- regional(clr,style,thin);
- if(isstring(str),
- Setslidebody(str,"\Large\bf\boldmath",0.1);
- ,
- if(length(str)==1,Setslidebody(str_1));
- if(length(str)==2,Setslidebody(str_1,str_2));
- if(length(str)==3,Setslidebody(str_1,str_2,str_3));
- );
-);
-Setslidebody(str,Arg):=( //17.01.08
- if(isstring(Arg),
- Setslidebody(str,Arg,0.1);
- ,
- Setslidebody(str,"\Large\bf\boldmath",Arg);
- );
-);
-Setslidebody(str,style,density):=( // 16.12.22,17.01.06,01.08
-//help:Setslidebody(["black",,0]);
-//help:Setslidebody(["blue","\Large\bf\boldmath",0.1]);
- regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc);
- letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
- shadowc=[0,0,0,0.5]; mboxc="yellow";
- if(!islist(SlideColorList),
- SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
- letterc,mboxc,mboxc,mboxc,62,2,letterc];
- );
- if(length(str)>0,SlideColorList_(15)=str);
- if(length(style)>0,BodyStyle=style);
- ThinDense=density;//17.01.08
-);
-
-Setslidehyper():=( 17.12.16from
- Setslidehyper(["cl=true,lc=blue,fc=blue",125,70,1]);
-);
-Setslidehyper(Arg):=(
- if(isstring(Arg),
- Setslidehyper(Arg,["cl=true,lc=blue,fc=blue",125,70,1]);
- ,
- Setslidehyper("",Arg);
- );
-);
-Setslidehyper(driverorg,options):=(
-//help:Setslidehyper();
-//help:Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue","Pos=[125,70]","Size=1"]);
- regional(driver,eqL,reL,stL,,str,tmp,tmp1,tmp2);
- driver=driverorg;
- if(length(driver)==0,
- if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")==0,
- driver="dvipdfmx";
- );
- );
- tmp=Divoptions(options);
- eqL=tmp_5;
- reL=tmp_6;
- stL=tmp_7;
- if(length(stL)>0,
- str=stL_1;
- ,
- str="";
- );
- if(length(str)==0,
- str="cl=true,lc=blue,fc=blue";
- );
- if(length(driver)==0,
- tmp1="["+str+"]";
- ,
- tmp1="["+driver+","+str+"]";
- );
- tmp1=replace(tmp1,"cl=","colorlinks=");
- tmp1=replace(tmp1,"lc=","linkcolor=");
- tmp1=replace(tmp1,"fc=","filecolor=");
- tmp1=replace(tmp1,"uc=","urlcolor=");
- ADDPACK=select(ADDPACK,indexof(#,"hyperref")==0);
- Addpackage(tmp1+"{hyperref}");
- LinkPosH=125;
- LinkPosV=70;
- LinkSize=1;
- if(length(reL)>0,
- LinkPosH=reL_1;
- if(length(reL)>1,LinkPosV=reL_2);
- if(length(reL)>2,LinkSize=max(reL_3,0.1));
- );
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,1));
- tmp2=substring(#,tmp,length(#));
- tmp2=parse(tmp2);
- if(tmp1=="P",
- LinkPosH=tmp2_1;
- LinkPosV=tmp2_2;
- );
- if(tmp1=="S",
- LinkSize=max(tmp2,0.1);
- );
- );
-); //17.12.16until
-
-Settitle(cmdL):=Settitle(cmdL,[]); // 180330changed
-Settitle(cmdL,options):=(
-//help:Settitle(cmdL);
-//help:Settitle(name,cmdL);
-//help:Settitle(options=["Title=slide0","Layery=0","Color=blue"]);
- regional(tmp,tmp1,tmp2,eqL,layery,color,size,font);
- TitleName="slide0"; //180330
- layery="0";
- color="blue";
- size="\Large";
- font="\bf";
- tmp=Divoptions(options);
- eqL=tmp_5;
- forall(eqL,
- tmp1=Toupper(substring(#,0,1));
- tmp=indexof(#,"=");
- tmp2=substring(#,tmp,length(#));
- if(tmp1=="L",
- layery=tmp2;
- );
- if(tmp1=="C",
- color=tmp2;
- );
- if(tmp1=="S",
- size=tmp2;
- if(substring(size,0,1)!="\",size="\"+size);
- );
- if(tmp1=="F",
- font=tmp2;
- if(substring(font,0,1)!="\",font="\"+font);
- );
- if(tmp1=="T", //180330
- TitleName=tmp2;
- );
- );
- TitleCmdL=["{"+size+font];
- if(indexof(color,"[")>0,
- tmp=replace(color,"[","{");
- tmp=replace(tmp,"]","}");
- tmp1=Indexall(tmp,",");
- if(length(tmp1)>=3,
- tmp="\color[cmyk]"+tmp;
- ,
- tmp="\color[rgb]"+tmp;
- );
- ,
- tmp="\color{"+color+"}";
- );
- TitleCmdL=append(TitleCmdL,tmp);
- TitleCmdL=concat(TitleCmdL,["","\begin{layer}{120}{"+layery+"}"]);
- forall(1..(length(cmdL)),
- tmp=cmdL_#;
- if(length(tmp)>0,
- if(#==1,
- tmp="{\Huge \putnote"+tmp+"}"
- ,
- tmp="\putnote"+tmp;
- );
- TitleCmdL=append(TitleCmdL,tmp);
- );
- );
- TitleCmdL=concat(TitleCmdL,["\end{layer}","","}"]);
-);
-
-Maketitle():=(
- if(!isstring(TitleName), //17.04.13from
- drawtext(mouse().xy,"Settitle not defined",
- size->24,color->[1,0,0]);
- , //17.04.13until
- Maketitle(TitleName);
- );
-);
-Maketitle(name):=(
-//help:Maketitle();
- regional(texfile,texmain,tmp,tmp1,sep);
- texfile=name;
- texmain=name+"main";
- SCEOUTPUT=openfile(texfile+".tex");
- forall(TitleCmdL,
- println(SCEOUTPUT,#);
- );
- closefile(SCEOUTPUT);
- SCEOUTPUT=openfile(texmain+".tex");
- tmp="\documentclass[landscape,10pt]{article}";
- if(indexof(PathT,"platex")>0,
- tmp=replace(tmp,"article","jarticle");
- if(indexof(PathT,"uplatex")>0, //17.08.13from
- tmp=replace(tmp,"jarticle","ujarticle");
- );//17.08.13until
- );
- println(SCEOUTPUT,tmp);
- tmp="\special{papersize=\the\paperwidth,\the\paperheight}";
- println(SCEOUTPUT,tmp);
- tmp=replace(Dirhead,"\","/");//17.11.01from
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketpic,ketlayer,ketslide}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}");
- );//17.11.01until
- println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
- println(SCEOUTPUT,"\usepackage{bm,enumerate}");
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
- println(SCEOUTPUT,"\usepackage{graphicx}");
- ,
- println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}");
- );
- println(SCEOUTPUT,"\usepackage[usenames]{xcolor}");
- forall(ADDPACK,
-// if(indexof(#,"[")==0,
-// println(SCEOUTPUT,"\usepackage{"+#+"}");
-// ,
- println(SCEOUTPUT,"\usepackage"+#); // 17.07.10
-// );
- );
- if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE");
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"\ketslideinit");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\begin{document}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\input{"+texfile+".tex}");
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\end{document}");
- closefile(SCEOUTPUT);
- if(iswindows(),
- Makebat(texmain,"tv");
- ,
- Makeshell(texmain,"tv");
- );
- kc();
-);
-
-Repeatsameslide(repeatflg,sestr,addedL):=(
- regional(seL,flg1,ss,nn,nrep,tmp,tmp1,tmp2,tmp3,str,j,k);
- // global RepeatList, SCEOUTPUT
- nrep=length(RepeatList);
- flg1=0;
- forall(addedL,ss,
- if(repeatflg==0,
- if(substring(ss,0,1)!="%", //16.01.04
- println(SCEOUTPUT,ss);
- );//16.01.04
- ,
- forall(1..nrep,nn,
- if(sestr=="",
- RepeatList_nn=append(RepeatList_nn,ss);
- );
- );
- if(sestr=="",
- seL=[1];
- ,
- tmp1=substring(sestr,1,length(sestr)-1);
- tmp1=replace(tmp1,",-",".."+text(nrep));
- tmp1=replace(tmp1,"-,","1..");
- tmp1="["+tmp1+"]"; //17.01.03
- seL=flatten(parse(tmp1)); //17.01.03
- );
- if(contains(seL,1),
- if(substring(ss,0,1)!="%", //16.01.04
- println(SCEOUTPUT,ss);
- );
- seL=remove(seL,[1]);
- flg1=1;
- );
- forall(1..(length(seL)),nn,
- tmp=seL_nn;
- if(tmp<=length(RepeatList), //17.01.12from
- RepeatList_tmp=append( RepeatList_tmp,ss);
- ,
- println(" "+sestr+" : "+text(tmp)+" > "+text(length(RepeatList)));
- );
- );
- if(ThinFlg==1,//16.01.05from
- if(flg1==1,seL=append(seL,1));
- seL=remove(1..nrep,seL);
- str=ss; // 17.05.28from
- repeat(10,
- tmp1=Indexall(str,"{\color");
- if(length(tmp1)>0,
- tmp2=Indexall(str,"}");
- tmp=select(tmp2,tmp1_1<#);
- tmp=substring(str,tmp1_1,tmp_1);
- str=replace(str,tmp+" ","");
- str=replace(str,tmp,"");
- );
- );//17.05.28until
- if(contains(seL,1),
- if(substring(str,0,1)!="%",
- if(NonThinFlg==0,
- if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
- println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23
- println(SCEOUTPUT,str);
- println(SCEOUTPUT,"}%");
- ,
- println(SCEOUTPUT,str);
- );
- );
- if(NonThinFlg==1,
- if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
- println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23
- );
- println(SCEOUTPUT,str);
- );
- if(NonThinFlg==2,
- println(SCEOUTPUT,str);
- if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15
- println(SCEOUTPUT,"}%");
- );
- );
- seL=remove(seL,[1]);
- );
- );
- if(substring(ss,0,1)!="%", //16.01.04
- forall(1..(length(seL)),nn,
- tmp=seL_nn;
- if(NonThinFlg==0,
- tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23
- tmp1=[tmp1,str,"}%"];
- );
- if(NonThinFlg==1,
- tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23
- tmp1=[tmp1,str];//17.01.08until
- );
- if(NonThinFlg==2,
- tmp1=[str,"}%"];
- );
- RepeatList_tmp=concat( RepeatList_tmp,tmp1);
- );
- );
- );//16.01.05until
- );
- );//16.12.05until
-);
-
-Presentation(texfile):=Presentation(texfile,texfile);
-Presentation(texfile,txtfile):=(
-//help:Presentation(texfile,txtfile);
- regional(file,flgL,flg,verbflg,slideL,ns,slideorgL,wall,sld,slidecmd,tmp,tmp0,tmp1,
- tmp2,tmp3,tmp4,tmp5,newoption,top,repeatflg,nrep,nrepprev,,repstr,
- sestr,npara,paradt,parafiles,hyperflg,paractr,
- letterc,boxc,shadowc,mboxc,sep);
- slidecmd=["\ketcletter","\ketcbox","\ketdbox","\ketcframe",
- "\ketcshadow","\ketdshadow","\slidetitlex","\slidetitlesize",
- "\mketcletter","\mketcbox","\mketdbox","\mketcframe",
- "\mslidetitlex","\mslidetitlesize"];
- if(!isstring(BodyStyle),//17.01.06
- BodyStyle="\Large\bf\boldmath";
- );
- repeatflg=0;
- RepeatList=[];
- paractr=0; //16.12.31
- if(indexof(texfile,".")==0,file=texfile+".tex",file=texfile);
- if(indexof(txtfile,".")==0,tmp1=txtfile+".txt",tmp1=txtfile);
- tmp=load(tmp1);
- tmp=replace(tmp,"////","||||");// 16.05.11, 06.24(reactivated)
- slideL=tokenize(tmp,"//");
- slideorgL=slideL; // 16.07.11
- slideL=apply(slideL,Removespace(#));
- tmp=select(1..length(slideL),length(slideL_#)>0); // 16.07.11from
- slideL=apply(tmp,slideL_#);
- slideorgL=apply(tmp,slideorgL_#);
-// slideL=select(slideL,length(#)>0); // 16.07.11until
- flg=0; // 16.06.09from
- forall(1..10,
- if(flg==0,
- if(substring(slideL_1,0,1)!="%",
- flg=1;
- ,
- slideL=slideL_(2..length(slideL));
- slideorgL=slideorgL_(2..length(slideorgL));
- );
- );
- ); // 16.06.09until
- flgL=[];
- SCEOUTPUT = openfile(file);
- tmp=tokenize(slideL_1,"::");
- tmp1=tmp_1;
- if(length(tmp)>1,
- tmp2=tmp_2;
- tmp3=tmp_(3..length(tmp));//16.06.25
- ,
- tmp2="";
- tmp3=tmp_(2..length(tmp));//16.06.25
- );
- wall=""; // 16.06.10
- if(length(tmp3)>0,//16.06.25from
- tmp=substring(tmp3_1,0,1);//180330
- if((tmp!="\")&(tmp!="%")&(indexof(tmp3_1,"=")==0), //180330
- wall=tmp3_1;
- tmp3=tmp3_(2..length(tmp3));
- );
- );//16.06.25until
- tmp="%%% "+tmp1+" "+txtfile;// 16.06.09from
- println(SCEOUTPUT,tmp);
- tmp="\documentclass[landscape,10pt]{article}";
- if(indexof(PathT,"platex")>0,
- tmp=replace(tmp,"article","jarticle");
- if(indexof(PathT,"uplatex")>0, //17.08.13from
- tmp=replace(tmp,"jarticle","ujarticle");
- );//17.08.13until
- );
- println(SCEOUTPUT,tmp);// 16.06.09from
- tmp=select(1..(length(tmp3)),indexof(tmp3_#,"\usepackage")>0);//17.06.18from
- forall(tmp,
- println(SCEOUTPUT,tmp3_#);
- );
- tmp=remove(1..(length(tmp3)),tmp);
- tmp3=tmp3_tmp;//17.06.18until
-// if(iswindows(),sep="\",sep="/"); // 17.04.08
-// sep="/";
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
- if(indexof(PathT,"lualatex")>0,
- println(SCEOUTPUT,"\usepackage{luatexja}");
- );
- println(SCEOUTPUT,"\usepackage{pict2e}");
- println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}");// 17.04.08from
- ,
- println(SCEOUTPUT,"\special{papersize=\the\paperwidth,\the\paperheight}");
- );// 17.04.08until
- tmp=replace(Dirhead,"\","/");//17.11.01from
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}");
- );
- if(length(wall)==0,
- tmp=replace(Dirhead,"\","/");//17.11.01from
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketslide}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}");
- );
- ,
- tmp=replace(Dirhead,"\","/");
- tmp=replace(tmp,"scripts","tex/latex");
- if(isexists(tmp,""),
- println(SCEOUTPUT,"\usepackage{ketslide2}");
- ,
- tmp=replace(Dirhead+"/ketpicstyle","\","/");
- println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide2}");
- );
- );//17.04.08until
- println(SCEOUTPUT,"\usepackage{amsmath,amssymb}");
- println(SCEOUTPUT,"\usepackage{bm,enumerate}");
- if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0),
- println(SCEOUTPUT,"\usepackage{graphicx}");
- ,
- println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}");
- );
-// println(SCEOUTPUT,"\usepackage[usenames]{color}");
-// println(SCEOUTPUT,"\usepackage{color}");//17.06.14
- println(SCEOUTPUT,"\usepackage{xcolor}");//17.07.31
- letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0];
- shadowc=[0,0,0,0.5]; mboxc="yellow";
-// if(!islist(SlideColorList), //17.03.02from
-// SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3,
-// letterc,mboxc,mboxc,mboxc,62,2,letterc];
-// , //17.03.02until
- tmp4="abcdefghijklmno";
- forall(1..15,
- tmp=SlideColorList_#;
- if(islist(tmp),
- tmp=text(tmp);
- tmp=substring(tmp,1,length(tmp)-1);
- if(length(SlideColorList_#)==4,//17.01.07from
- println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{cmyk}{"+tmp+"}");
- );
- if(length(SlideColorList_#)==3,
- println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{rgb}{"+tmp+"}");
- );//17.01.07until
- SlideColorList_#="slidecolor"+tmp4_#;
- );
- );
-// ); //17.03.02
- println(SCEOUTPUT,"\def\setthin#1{\def\thin{#1}}");//17.08.23
- println(SCEOUTPUT,"\setthin{"+text(ThinDense)+"}");//17.08.23
- forall(ADDPACK,// 16.06.09from
-// if(indexof(#,"[")==0, // 16.09.05from
-// println(SCEOUTPUT,"\usepackage{"+#+"}");
-// ,
- println(SCEOUTPUT,"\usepackage"+#); //17.07.10
-// );
- );// 16.06.09until
- tmp=select(ADDPACK,indexof(#,"{hyperref}")>0);//16.12.31from
- if(length(tmp)>0,
- hyperflg=1;
- ,
- hyperflg=0; //16.12.31until
- );
- forall(tmp3,
- println(SCEOUTPUT,#);
- );
- if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE"); // 16.06.09
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"\ketslideinit");
- println(SCEOUTPUT,"");
- forall(tmp, // 15.07.21
- if(substring(#,0,1)=="\", println(SCEOUTPUT,#));
- );
- if(!isstring(PageStyle),PageStyle="headings");//17.04.09
- println(SCEOUTPUT,"\pagestyle{"+PageStyle+"}");//17.04.09
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\begin{document}");
- println(SCEOUTPUT,"");
- if(length(wall)>0,
- println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
- println(SCEOUTPUT,"");
- );
- if(length(tmp2)>0,
- if(indexof(tmp2," no")==0, // 16.11.11from
- println(SCEOUTPUT,"\begin{layer}{120}{0}");
- if(substring(tmp2,0,1)!="\",
- tmp2="\putnotese{0}{0}{\input{fig/"+tmp2+".tex}}";//16.12.27
- );
- println(SCEOUTPUT,tmp2);
- println(SCEOUTPUT,"\end{layer}");
- println(SCEOUTPUT,"");
- ,
- tmp=indexof(tmp2,"=");
- if(tmp==0,
- top="10mm";
- ,
- top=substring(tmp2,tmp,length(tmp2));
- );
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\vspace*{"+top+"}");
- println(SCEOUTPUT,"");
- ); // 16.11.11until
- );
- println(SCEOUTPUT,"\def\mainslidetitley{22}");
- forall(1..14, //16.12.22from
- tmp=SlideColorList_#;
- if(!isstring(tmp),tmp=text(tmp));
- if(length(tmp)>0,
- tmp="\def"+slidecmd_#+"{"+tmp+"}";
- println(SCEOUTPUT,tmp);
- );
- );//16.12.22until
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\color{"+SlideColorList_(15)+"}");
- println(SCEOUTPUT,BodyStyle);//17.01.07
- println(SCEOUTPUT,"\thispagestyle{empty}");//17.01.29
- println(SCEOUTPUT,"\addtocounter{page}{-1}");//17.01.29
- println(SCEOUTPUT,"");
- verbflg=0; //16.06.28
- repeatflg=0;//16.12.02
- nrep=0;//16.12.27
- nrepprev=0;//17.01.03
- npara=0;//16.12.27
- forall(2..length(slideL),ns,
- ThinFlg=0;
- NonThinFlg=0;
- flg=0;
- tmp1="";
- tmp2="";
- tmp3="";
- sld=removespace(slideL_ns); // 16.06.28
- sestr="";
- if((substring(sld,0,1)=="%") & (substring(sld,0,2)!="%%"), // 17.06.23
- Repeatsameslide(repeatflg,"",[slideL_ns]);
- if(repeatflg>0,
- tmp=indexof(sld,"]::");
- if(tmp>0,
- if(substring(sld,1,2)!="%",//17.05.31
- if(substring(sld,1,5)=="thin", ThinFlg=1); // 17.05.28
- sestr=substring(sld,1,tmp);
- sld=substring(sld,tmp+2,length(sld));
- tmp=indexof(sestr,"[");
- sestr=substring(sestr,tmp-1,length(sestr));//17.01.05
- );
- );
- );
- if(substring(sld,1,7)=="repeat", // 16.12.09from
- tmp=indexof(sld,"=");
- tmp5=substring(sld,tmp,length(sld));
- tmp=indexof(tmp5,",");
- if(tmp>0,//17.01.03from
- tmp5=substring(tmp5,0,tmp-1);
- );//17.01.03until
- repeatflg=1;
- if(length(tmp5)>0,
- nrep=parse(tmp5);
- tmp=[];
- if(length(wall)>0,
- tmp=["","\input{fig/"+wall+".tex}"];
- );
- tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]);
- RepeatList=apply(1..nrep,if(#==1,[],tmp));
- );
- if(sestr=="",flg=1);
- tmp=indexof(sld,",");//17.01.03from
- if(tmp>0,
- sld="%"+substring(sld,tmp,length(sld));
- if(indexof(sld,"=")==0,sld=sld+"=");
- );//17.01.03until
- );
- if(substring(sld,1,5)=="para",
- paractr=paractr+1;
- repeatflg=1;
- tmp=indexof(sld,"=");
- tmp=substring(sld,tmp,length(sld));
- if(length(tmp)==0, //17.01.03
- npara=0;
- ,
- paradt=tokenize(tmp,":");
- tmp=fileslist(Dirwork+"/fig/"+paradt_1);
- if(length(tmp)>0,
- parafiles=tokenize(tmp,",");
- if(indexof(paradt_4,"input")>0,
- tmp0=indexof(paradt_4,",");//17.01.29from
- if(tmp0>0,
- paradt=append(paradt,substring(paradt_4,tmp0,length(paradt_4)));
- paradt_4=substring(paradt_4,0,tmp0-1);
- );//17.01.29until
- parafiles=select(parafiles,indexof(#,".tex")>0);
- if(indexof(paradt_4,"\input")==0,paradt_4="\"+paradt_4);//16.12.17
- );
- if(indexof(paradt_4,"include")>0,
- parafiles=select(parafiles,indexof(#,".pdf")>0);
- );
- npara=length(parafiles);
- ,
- println(Dirwork+"/fig/"+paradt_1+" not found");
- parafiles=[];
- npara=0;
- );
- if(nrep==0,
- nrep=npara;
- if(length(wall)>0,
- tmp=["","\input{fig/"+wall+".tex}"];
- );
- tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]);
- RepeatList=apply(1..nrep,if(#==1,[],tmp));
- );
- );
- forall(1..nrep, //16.12.28
- tmp4=[]; //16.12.31from
- if(hyperflg>0,
- tmp4=["\hypertarget{para"+text(paractr)+"pg"+text(#)+"}{}"];
- );//16.12.31until
- if(npara>0, //17.01.03
- tmp4=concat(tmp4,["","\begin{layer}{120}"+paradt_2]);
- if(#<=npara, //16.12.28from
- tmp=parafiles_#;
- ,
- tmp=parafiles_npara;
- );
- tmp="{"+paradt_4+"{fig/"+paradt_1+"/"+tmp+"}}";
- if(length(paradt)>=5,
- tmp="{\scalebox{"+text(paradt_5)+"}"+tmp+"}";
- );
- if(substring(paradt_3,0,1)=="\",
- tmp=paradt_3+tmp;
- ,
- tmp="\putnote"+paradt_3+tmp;
- );
- tmp4=concat(tmp4,[tmp]);//16.12.31
- ,
- tmp4=concat(tmp4,["","\begin{layer}{120}{0}"]);
- );
- if((hyperflg>0) & (LinkSize>0.15),
- tmp="{"+text(LinkPosV)+"}{\hyperlink{para"; // 17.01.12from
- tmp1=tmp+text(paractr)+"pg";
- tmp2=tmp+text(paractr-1)+"pg"+text(nrepprev);
- if(#>1,tmp=tmp1+text(1),tmp=tmp2);
- tmp3=[text(LinkPosH-29*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut|\!\lhd$}}}}}"];
- if(#>1,tmp=tmp1+text(max(#-3,1)),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH-24*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut\!\! \lhd\!\!\lhd\!$}}}}}");
- if(#>1,tmp=tmp1+text(#-1),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH-17*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(4.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut\!\!\lhd\!\!$}}}}}");
- tmp="{"+text(LinkPosV)+"}{\hyperlink{para";
- tmp2=tmp+text(paractr+1)+"pg"+text(1);
- if(#<nrep,tmp=tmp1+text(#+1),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH-10*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(4.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut\!\rhd\!$}}}}}");
- if(#<nrep,tmp=tmp1+text(min(#+3,nrep)),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH-5*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{"
- +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut\!\!\rhd\!\!\rhd\!$}}}}}");
- if(#<nrep,tmp=tmp1+text(nrep),tmp=tmp2);
- tmp3=append(tmp3,
- text(LinkPosH)+"}"+tmp+"}{\fbox{\Ctab{" // 17.01.19
- +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize)
- +"}{\scriptsize $\mathstrut \!\rhd\!\!|$}}}}}");
- tmp3=apply(tmp3,tmp,"\putnotew{"+tmp);
- tmp4=concat(tmp4,tmp3);// 17.01.12untilr
- tmp="\putnotew{"+text(LinkPosH)+"}{"+text(LinkPosV+6)+"}";//17.10.21from
- tmp=tmp+"{\scriptsize\color{black} "+text(#)+"/"+text(nrep)+"}";
- tmp4=append(tmp4,tmp);//17.10.21until
- );
- tmp4=concat(tmp4,["\end{layer}",""]);//16.12.31until
- Repeatsameslide(repeatflg,text([#]),tmp4);
- );
- );
- );
- if(substring(sld,0,2)=="%%", //17.06.23from
- println(SCEOUTPUT,sld);
- flg=1;
- ); //17.06.23until
- if(flg==0,
- if(indexof(sld,"\begin{verbatim}")==1, // 16.06.28from
- Repeatsameslide(repeatflg,sestr,[slideL_ns]);
- verbflg=1;
- flg=1;
- ); // 16.06.28
- if(indexof(sld,"\end{verbatim}")==1,
- Repeatsameslide(repeatflg,sestr,[slideL_ns]);
- verbflg=0;
- flg=1;
- ); // 16.06.28until
- if(flg==0,
- tmp=replace(sld,"||||","//"); // 16.05.11
- tmp=tokenize(tmp,"::"); // 16.05.11
- tmp1=tmp_1;
- if(length(tmp)>1,tmp2=tmp_2,tmp2="");
- if(length(tmp)>2,tmp3=tmp_3,tmp3="");
- if(length(tmp)>3,tmp4=tmp_4,tmp4="");
- if(length(tmp)>4,tmp5=tmp_5,tmp5="");
- if(contains(["main","new","same"],tmp1),
- if(tmp1=="new", // 16.11.09from
- newoption="";
- if(substring(tmp2,0,1)=="[",newoption=tmp2);
- );
- if(tmp1=="same",
- if(length(tmp2)==0,tmp2=newoption);
- );// 16.11.09until
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"%%%%%%%%%%%%%%%%%%%%");
- println(SCEOUTPUT,"");
- );
- );
- if(flg==0&tmp1=="main",
- if(repeatflg==1,
- forall(2..(length(RepeatList)),nrep,
- tmp=RepeatList_nrep;
- forall(tmp,
- if(substring(#,0,1)!="%", //16.01.04
- println(SCEOUTPUT,#);
- );
- );
- );
- println(SCEOUTPUT,"");
- repeatflg=0;RepeatList=[];
- nrepprev=nrep;//17.01.03
- nrep=0;//16.12.27
- npara=0;//16.12.27
- );
- if(length(wall)>0,
- println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
- );
- println(SCEOUTPUT,"\mainslide{"+tmp2+"}");
- println(SCEOUTPUT,"");
- tmp2="";
- flg=1;
- );
- if(flg==0&tmp1=="new",
- if(repeatflg==1,
- forall(2..(length(RepeatList)),nrep,
- tmp=RepeatList_nrep;
- forall(tmp,
- if(substring(#,0,1)!="%", //16.01.04
- println(SCEOUTPUT,#);
- );
- );
- );
- println(SCEOUTPUT,"");
- repeatflg=0;RepeatList=[];
- nrepprev=nrep;//17.01.03
- nrep=0;
- npara=0;
- );
- if(length(wall)>0,
- Repeatsameslide(repeatflg,sestr,["\input{fig/"+wall+".tex}"]);
- );
- tmp="\newslide";
- NewSlideOption=""; //17.01.04
- if(substring(tmp2,0,1)=="[",
- NewSlideOption=tmp2; //17.01.04
- tmp=tmp+tmp2;
- tmp2=tmp3;
- tmp3=tmp4;
- tmp4=tmp5;
- );
- tmp=tmp+"{"+tmp2+"}";
- Repeatsameslide(repeatflg,sestr,[tmp,"","\vspace*{18mm}",""]);
- tmp2="";
- flg=1;
- );
- if(flg==0&tmp1=="same",
- if(repeatflg==1,
- forall(2..(length(RepeatList)),nrep,
- tmp=RepeatList_nrep;
- forall(tmp,
- if(substring(#,0,1)!="%", //16.01.04
- println(SCEOUTPUT,#);
- );
- );
- );
- println(SCEOUTPUT,"");
- repeatflg=0;RepeatList=[];
- nrepprev=nrep;//17.01.03
- nrep=0;
- npara=0;
- );
- if(length(wall)>0,
- println(SCEOUTPUT,"\input{fig/"+wall+".tex}");
- );
- tmp="\sameslide"+NewSlideOption; //17.01.04;
-// if(substring(tmp2,0,1)=="[",
-// tmp=tmp+tmp2;
-// tmp2=tmp3;
-// tmp3=tmp4;
-// );
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\vspace*{18mm}");
- println(SCEOUTPUT,"");
- tmp4=tmp3;
- tmp3=tmp2;
- tmp2="";
- flg=1;
- );
- if(flg==0&tmp1=="itemize",
- Repeatsameslide(repeatflg,sestr,["\begin{itemize}"]);
- flgL=append(flgL,"i");
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="enumerate",
- Repeatsameslide(repeatflg,sestr,["\begin{enumerate}"+tmp2]);
- flgL=append(flgL,"e");
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="verbatim", //16.06.28from
- Repeatsameslide(repeatflg,sestr,["\begin{verbatim}"]);
- flgL=append(flgL,"v");
- tmp1="";
- tmp2="";
- tmp3="";
- verbflg=1;
- flg=1;
- ); //16.06.28until
- if(flg==0&tmp1=="layer",
- Repeatsameslide(repeatflg,sestr,[""]);
- tmp="\begin{layer}";
- if(length(tmp2)>0,
- tmp=tmp+tmp2;
- ,
- tmp=tmp+"{120}{0}";
- );
- Repeatsameslide(repeatflg,sestr,[tmp]);
- flgL=append(flgL,"l");
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="putnote",
- tmp="\putnote"+tmp2+"{";
- if(indexof(tmp3,"include")==0,
- tmp1=indexof(tmp3,",");
- if(tmp1==0,
- tmp=tmp+"\input{fig/"+tmp3+".tex}}";
- ,
- tmp2=substring(tmp3,tmp1,length(tmp3));
- tmp3=substring(tmp3,0,tmp1-1);
- tmp=tmp+"\scalebox{"+tmp2+"}{\input{fig/"+tmp3+".tex}}}";
- );
- ,
- tmp2=indexof(tmp3,"[");
- tmp3=substring(tmp3,tmp2-1,length(tmp3));
- tmp=tmp+"\includegraphics"+tmp3+"{fig/"+tmp4+"}}";
- );
- Repeatsameslide(repeatflg,sestr,[tmp]);
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="item",
- NonThinFlg=1;
- Repeatsameslide(repeatflg,sestr,["\item"]);
- tmp3="";
- flg=1;
- );
- if(flg==0&tmp1=="end",
- tmp=flgL_(length(flgL));
- if(tmp=="i",
- Repeatsameslide(repeatflg,sestr,["\end{itemize}"]);
- );
- if(tmp=="e",
- Repeatsameslide(repeatflg,sestr,["\end{enumerate}"]);
- );
- if(tmp=="l",
- Repeatsameslide(repeatflg,sestr,["\end{layer}",""]);
- );
- if(tmp=="v", // 16.06.28from
- Repeatsameslide(repeatflg,sestr,["\end{verbatim}",""]);
- verbflg=0;
- ); // 16.06.28until
- flgL=flgL_(1..(length(flgL)-1));
- tmp2="";
- tmp3="";
- flg=1;
- );
- if(flg==0, // 16.06.28from
- if(verbflg==0,
- tmp2=tmp1;
- ,
- tmp2=slideorgL_ns; // 16.07.11
- tmp2=replace(tmp2,"||","//"); // 16.07.10
- tmp3="";
- );
- ); // 16.06.28until
- if(length(tmp2)>0,
- if(tmp2=="...", tmp2="");
- if(NonThinFlg==1,NonThinFlg=2);
- Repeatsameslide(repeatflg,sestr,[tmp2]);
- );
- if(length(tmp3)>0,
- Repeatsameslide(repeatflg,sestr,["\begin{layer}{120}{0}"]);
- if(substring(tmp3,0,1)=="{",
- tmp=tmp3;
- tmp3=tmp4;
- ,
- tmp="{60}{0}";
- );
- tmp1=indexof(tmp3,",");
- if(tmp1==0,
- tmp3="\putnotes"+tmp+"{\input{fig/"+tmp3+".tex}}";
- ,
- tmp2=substring(tmp3,tmp1,length(tmp3));
- tmp3=substring(tmp3,0,tmp1-1);
- tmp3="\putnotes"+tmp+"{\scalebox{"+tmp2+"}
- {\input{fig/"+tmp3+".tex}}}";
- );
- Repeatsameslide(repeatflg,sestr,[tmp3,"\end{layer}",""]);
- );
- );
- );
- if(repeatflg==1,
- forall(2..(length(RepeatList)),nrep,
- tmp=RepeatList_nrep;
- forall(tmp,
- if(substring(#,0,1)!="%", //16.01.04
- println(SCEOUTPUT,#);
- );
- );
- );
- println(SCEOUTPUT,"");
- );
- println(SCEOUTPUT,"");
- println(SCEOUTPUT,"\end{document}");
- closefile(SCEOUTPUT);
-);
-
-Mkslides():=(
- regional(sep,parent,texparentorg,tmp,tmp1,tmp2,tmp3,tmp4,flg);
- tmp4=Fhead;
- Fhead="";
- if(!iswindows(), //17.10.13
- Dirwork=replace(Dirwork,"\",pathsep());
- parent=replace(Dirwork+Shellparent,"\",pathsep());
- ,
- Dirwork=replace(Dirwork,"/",pathsep());
- parent=replace(Dirwork+Batparent,"/",pathsep());// 16.05.29
- );
- Dirwork=replace(Dirwork,pathsep()+"fig","");
- Setdirectory(Dirwork);
- if(length(Texmain)>0, // 15.08.14 from
- Texparent=Texmain;
- );
- texparentorg=Texparent; //17.04.10from
- if(isstring(Slidename), // 15.08.14 from
- Texparent=Slidename;
- );//17.04.10until
- if(!isexists(Dirwork,Texparent+".txt"), // 17.04.12from
- drawtext(mouse().xy,Texparent+".txt not exist in "+Dirwork,
- size->24,color->[1,0,0]);
- , // 17.04.12until
- Presentation(Texparent); // 15.08.14 until
- if(iswindows(),
- tmp2=Batparent;
- parent=replace(Dirwork+Batparent,sep+"fig","");// 16.05.29
- if(indexof(Pathpdf,"Adobe")>0, //17.12.09from
- Makebat(Texparent,"ttv");
- ,
- Makebat(Texparent,"tv");
- ); //17.12.09until
- kc():=(
- println("kc : "+kc(parent,Dirlib,Fnametex)); // 16.06.10, 17.02.19
- );
- kc();
- Batparent=tmp2;
- ,
- tmp2=Shellparent;
- parent=replace(Dirwork+Shellparent,sep+"fig","");// 16.05.29
- Shellparent=replace(Shellparent,sep+"fig","");
- if(indexof(Pathpdf,"Adobe")>0, //17.12.09from
- Makeshell(Texparent,"ttv");
- ,
- Makeshell(Texparent,"tv");
- ); //17.12.09until
- kc():=(
- println("kc : "+kc(parent,Mackc+Dirlib,Fnametex)); // 16.06.10
- );
- kc();
- Shellparent=tmp2;
- );
- );
- Dirwork=Dirwork+pathsep()+"fig"; //17.10.16
- setdirectory(Dirwork);
- Fhead=tmp4;
- Texparent=texparentorg;//17.04.10
-);
-
-Mkslidesummary():=( // 17.10.26 for R
- regional(texparentorg);
- texparentorg=Texparent;
- if(isstring(Slidename),
- Texparent=Slidename;
- );
- Mkslidesummary(Texparent,Texparent+"digest",["m","Wait=3"]);
- Texparent=texparentorg;
-);
-Mkslidesummary(fin,fout):=
- Mkslidesummary(fin,fout,["m","Wait=3"]);
-Mkslidesummary(inputfile,outputfile,options):=(
-//help:Mkslidesummary(fin,fout,options);
- regional(fin,fout,out,figflg,dirworkorg,dirtop,tmp);
- dirworkorg=Dirwork;//17.04.10from
- dirtop=replace(Dirwork,pathsep()+"fig","");
- Changework(dirtop);//17.04.10uptp
- fin=inputfile;
- if(indexof(fin,".")==0,fin=fin+".tex");
- fout=outputfile;
- if(indexof(fout,".")==0,fout=fout+".tex");
- cmdL=[
- "Dt=readLines('"+fin+"')",[],
- "num=grep('\\hypertarget',Dt,fixed=TRUE)",[],
- "Dt=Dt[setdiff(1:length(Dt),num)]",[],
- "Smain=c();Snew=c();Ssame=c()",[],
- "for(J in 1:length(Dt)){",[],
- " Tmp=length(grep('\\mainslide{',Dt[J],fixed=TRUE))",[],
- " if(Tmp>0){Smain=c(Smain,1)}else{Smain=c(Smain,0)}",[],
- " Tmp=length(grep('\\newslide{',Dt[J],fixed=TRUE))",[],
- " if(Tmp>0){Snew=c(Snew,1)}else{Snew=c(Snew,0)}",[],
- " Tmp=length(grep('\\sameslide',Dt[J],fixed=TRUE))",[],
- " if(Tmp>0){Ssame=c(Ssame,1)}else{Ssame=c(Ssame,0)}",[],
- "}",[],
- "Nnew=c();Nsame=c()",[],
- "for(J in 1:length(Dt)){",[],
- " if((Snew[J]==1)|(Smain[J]==1)){Nnew=c(Nnew,J)}",[],
- " if(Ssame[J]==1){Nsame=c(Nsame,J)}",[],
- "}",[],
- "Out=Dt[1:Nnew[1]]",[],
- "for(J in Looprange(2,length(Nnew))){",[],
- " Tmp=max(c(1,Nsame[Nsame<Nnew[J]]))",[],
- " Tmp=max(c(Tmp,Nnew[J-1]))+1",[],
- " Out=c(Out,Dt[Tmp:Nnew[J]])",[],
- "}",[],
- "Tmp=max(c(Nsame[-1],Nnew[-1]))+1",[],
- "Out=c(Out,Dt[Tmp:length(Dt)])",[],
- "writeLines(Out,'"+fout+"',sep='\n')",[],
- "cat('////',file='resultR.txt',sep='')",[],
- "quit()",[]
- ];
- CalcbyR("out",cmdL,append(options,"Cat=n"));
- wait(1000);
- Changework(dirtop);//17.04.10
- tmp=replace(fout,".tex","");
- if(iswindows(),
- Makebat(tmp,"tv");
- ,
- Makeshell(tmp,"tv");
- );
- kc();
- Changework(dirworkorg);//17.04.10
-);
-
-Example(exorg):=Example(exorg,"");
-Example(exorg,suborg):=(
-//help:Example("Mxfun","diff");
- regional(ex,tmp,tmp1,tmp2);
- ex=replace(exorg,"'",Dq);
- sub=replace(suborg,"'",Dq);
- setdirectory(Dirlib);
- tmp=load("examples.txt");
- setdirectory(Dirwork);
- tmp=tokenize(tmp,"//");
- tmp=tmp_(1..(length(tmp)-1));
- tmp1=select(tmp,substring(#,0,length(ex))==ex);
- tmp1=sort(tmp1);
- if(length(sub)>0,
- tmp1=select(tmp1,indexof(#,sub)>0);
- );
- forall(tmp1,
- if((indexof(#,"##")>0) % (indexof(#,"~#")>0),
- tmp=indexof(#,",");
- println(substring(#,tmp,length(#)));
- ,
- println(#);
- );
- );
-);
-
-BBdata():=Bbdata(BBTarget,0);
-BBdata(fname):=Bbdata(fname,0); // 16.04.09
-BBdata(fname,optionorg):=(
-//help:BBdata(filename);
-//help:BBdata(options=0(automatic),1(make),"w=","h=");
- regional(fout,flg,path,file,kcfile,options,eqL,reL,stL,
- waiting,addop,tmp,tmp1,tmp2);
- path="";
- file=fname;
- flg=0;
- waiting=2;
- forall(reverse(1..length(fname)),
- if(flg==0,
- tmp=substring(fname,#-1,#);
- if(tmp=="/" % tmp=="\", // 14.01.15
- path=substring(fname,0,#-1);
- file=substring(fname,#,length(fname));
- flg=1;
- );
- );
- );
- if(path=="",path=Dirwork);//16.10.05
- if(indexof(file,".")==0,file=file+".pdf");
- if(islist(optionorg),options=optionorg,options=[optionorg]);
- tmp=divoptions(options);
- eqL=tmp_5;
- reL=tmp_6;
- stL=tmp_7;
- flg=0;
- addop="";
- if(length(reL)>0,
- tmp=reL_1;
- if(tmp==1,flg=1);
- );
- forall(stL,
- tmp=Toupper(substring(#,0,1));
- if(tmp=="M",flg=1);
- );
- forall(eqL,
- tmp=indexof(#,"=");
- tmp1=Toupper(substring(#,0,2));
- tmp2=substring(#,tmp,length(#));
- if(tmp1=="W=",
- addop=addop+",width="+tmp2;
- options=remove(options,[#]);
- );
- if(tmp1=="H=",
- addop=addop+",height="+tmp2;
- options=remove(options,[#]);
- );
- );
- tmp=indexof(file,".");
- tmp1=substring(file,0,tmp-1);
- fout=tmp1+".txt";
- if(iswindows(),
- kcfile="kc.bat";
- ,
- kcfile="kc.sh";
- );
- if(flg==0,
- tmp=load(fout); //
- if(length(tmp)==0,
- flg=1;
- ,
- tmp=tokenize(tmp,"%%");
- tmp=tmp_2;
- tmp1=indexof(tmp,":");
- tmp=substring(tmp,tmp1,length(tmp));
- tmp=Removespace(tmp);
- if(tmp!=file,flg=1);
- );
- );
- if(length(path)==0,
- path=Dirwork;
- );
- if(flg==1,
- setdirectory(path);
- tmp=load(file);
- setdirectory(Dirwork);
- if(length(tmp)==0,
- println(" => "+file+" not exists");
- flg=-1;
- );
- );
- if(flg==1,
- SCEOUTPUT = openfile(kcfile);
- if(!iswindows(),
- println(SCEOUTPUT,"#!/bin/sh");
- );
- println(SCEOUTPUT,"cd "+Dq+path+Dq);
- tmp=replace(PathT,"pdflatex","extractbb"); //16.11.22
- tmp=replace(tmp,"pdftex","extractbb"); //16.11.22
- tmp=replace(tmp,"xelatex","extractbb");
- tmp=replace(tmp,"uplatex","extractbb"); //17.09.20
- tmp=replace(tmp,"platex","extractbb");
- tmp=replace(tmp,"latex","extractbb");
- tmp=tmp+" -O "+file;
- if(iswindows(),
- tmp=tmp+" > "+Dirwork+"\"+fout;
- ,
- tmp=tmp+" > "+Dirwork+"/"+fout;
- );
- println(SCEOUTPUT,tmp);
- println(SCEOUTPUT,"exit 0");
- closefile(SCEOUTPUT);
- kc(Dirwork+"/"+kcfile,Mackc+Dirlib,Fnametex); // 16.06.07
- );
- if(flg>=0,
- tmp1=0;
- repeat(floor(waiting*1000/WaitUnit),
- if(tmp1==0,
- wait(10);
- tmp=load(fout);
- if(indexof(tmp,"CreationDate")>0,
- tmp1=1;
- );
- );
- );
- if(length(tmp)==0,
- println(fout+" not generated. Maybe "+kcfile+" not run.");
- ,
- tmp=tokenize(tmp,"%%");
- tmp=select(tmp,indexof(#,"Bounding")>0);
- tmp=tmp_2; //
- tmp1=indexof(tmp,":");
- tmp=substring(tmp,tmp1,length(tmp));
- tmp=removespace(tmp);
- tmp=tokenize(tmp," ");
- tmp1="";
- forall(tmp,
- tmp1=tmp1+Sprintf(#,2)+" ";
- );
- tmp1=removespace(tmp1)+addop;
- tmp2="\includegraphics[bb="+tmp1+"]{"+file+"}";
- println(tmp2);
- );
- );
-// setdirectory(Dirwork);
- tmp2; // 16.04.25
-);
-
-//help:end();
-
diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt deleted file mode 100644 index 0c89e3e7..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt +++ /dev/null @@ -1,115 +0,0 @@ -//help:start(); -//help:drawimage*(import image into the screen); -//help:drawtext*(write letters on the screen); -//help:Option1*(specify the style of drawing lines); -//help:Option2*(specify the way of writing data out); -//help:Option3*(specify the way of reading and writing data in); -//help:Changestyle*(change the style for drawing plot data); -//help:Workprocess*(display the process of execution); -//help:Textformat*(convert number into string with specific number of digits); -//help:Assign*(replace the name of variable in the string by some specific value); -//help:Flattenlist*(flatten the list of data); -//help:Dotprod*(inner product); -//help:Crossprod*(exterior product); -//help:Ptstart*(starting point of plot data); -//help:Ptend*(ending point of plot data); -//help:Numptcrvtenn*(number of points in plot data); -//help:Ptcrv*(the n-th point of plot data); -//help:Invert*(reverse the orientation of curve); -//help:ParamonCurve*(information (parameter value etc.) of the point in plot data); -//help:PointonCurve*(the point in the plot data specified by the given information); -//help:Nearestptcrv*(the point in the curve which is nearest to the given point); -//help:Nearestpt*(the points in two given curves which are nearest each other); -//help:Derivative*(calculate the differential coefficient); -//help:Integrate*(numerical integration); -//help:Findarea*(calculate the area of the region surrounded by a closed curve); -//help:Findlength*(calculate the length of curve); -//help:Com2nd*(add the R command to write out plot data into TeX); -//help:Texcom*(write command into TeX output exactly as written here); -//help:Setunitlen*(specify the unit length); -//help:Setmarklen*(specify the unit length of the tickmarks on coordinate axis); -//help:Setorigin*(specify the position the origin); -//help:Fontsize*(specify the size of font); - //help:Setpen*(specify the thickness of line); -//help:Setpt*(specify the size of point); -//help:Definecolor*(define the color for user's own use); -//help:Setcolor*(specify the color); -//help:Joincrvs*(join curves); -//help:Partcrv*(cut out some part of the curve); -//help:Pointdata*(generate the plot data of point -//additional option : "Size="); -//help:Listplot*(generate the plot data of a polyline); -//help:Lineplot*(generate the plot data of line); -//help:Plotdata*(generate the plot data of function -//additional option : "Num=", "Exc=", "Dis="); -//help:Paramplot*(generate the plot data of parametric function -//additional option : "Num=", "Exc=", "Dis="); -//help:Circledata*(generate the plot data of circle -//additional option : "Num=", "Rng="); -//help:Framedata*(generate the plot data of rectangle); -//help:Ovaldata*(generate the plot data of oval shape); -//help:Arrowhead*(generate the plot data of arrowhead -//option : size, sharpness, shape and position in the arrow); -//help:Arrowdata*(generate the plot data of arrow line -//option : size of arrowhead, sharpness(angle),position of arrowhead); -//help:Anglemark*(generate the plot data of angle mark option : size); -//help:Paramark*(generate the plot data of right angle mark option : size); -//help:Bowdata*(generate the plot data of bow arched curve -//option : curvatute, size of the blank space, letter); -//help:Deqplot*(generate the solution curve of differential equation -//additional option : "Num="); -//help:Hatchdata*(add hatching into some region -// option : slope, degree, space betwen lines)); -//help:Enclosing*(generate the plot data of closed curve connecting some curves); -//help:Shade*(add shading into some region option : depth); -//help:Rotatepoint*(rotate the point, option : center); -//help:Translatepoint*(pararell transport of the point); -//help:Scalepoint*(magnify or reduce the position of point option : center); - //help:Reflectpoint*(reflect the point); -//help:Rotatedata*(rotate the plot data option : center); -//help:Scaledata*(magnify or reduce the plot data option : center); -//help:Reflectdata*(reflect the plot data); -//help:Mksegments*(generate the plot data of all segments on the screen); -//help:Mkcircles*(generate the plot data of all circles on the screen): -//help:Setax*(specify the setting of coordinate axes); -//help:Htickmark*(put a tickmark on the horizontal coordinate axis); -//help:Vtickmark*(put a tickmark on the vertical coordinate axis); -//help:Drwxy*(draw coordinate axes); -//help:Addax*(specify whether coordinate axes are drawn or not); -//help:Expr*(write mathematical expressions at a specific position); -//help:Letter*(write letters at a specific position); -//help:Letterrot*(write sloped letters at a specific position): -//help:Exprrot*(write sloped mathematical expressions at a specific position): -//help:Putpoint*(put a point at the specific position); -//help:Bezier*(generate the plot data of Bezier curve); -//help:Mkbezierptcrv*(generate the plot data of Bezier curve by automatically taking controll points); -//help:CRspline*(generate the plot data of Catmull-Rom spline curve); -//help:Beziersmooth*(generate the plot data of Bezier spline curve); -//help:Bspline*(generate the plot data of B-spline curve); -//help:PtonLine*(put a point on a specific line); -//help:PtonSeg*(put a point on a specific segment); -//help:PutonCurve*(put a point on a specific curve); -//help:Setscaling*(specify the rate of magnification in the vertical direction); - //help:Tabledatalight*(generate the plot data of table without geometric points - //additional option : rules to be removed); - //help:Tgrid*(return the coordinates of a cell in the table); - //help:Tlistplot*(draw segment connecting two lattice points in the table); -//help:ChangeTablestyle*(change the style for drawing rules in the table); -//help:Tabledata*(generate the plot data of table with geometric points - //option : usual options+rules to be removed); -//help:Tabledata*(xLst=apply(1..5,10);yLst=apply(1..4,8);rmvL=[];); -//help:Findcell*(return the information of a cell in the table); -//help:Putcell*(write letters in a specific cell of the table); -//help:Putcellexpr*(write mathematical expressions in a specific cell of the table); -//help:Putrow*(write letters in a specific row of the table)); -//help:Putrowexpr*(write mathematical expressions in a specific row of the table); -//help:PutcoL*(write letters in a specific column of the table)); -//help:PutcoLexpr*(write mathematical expressions in a specific column of the table)); -//help:Setwindow*(specify the area of drawing); -//help:Defvar*(the definition of a variable is called by R); -//help:Deffun*(the definition of a function is called by R); -//help:Extractdata*(endow attribute to the imported plot data); -//help:ReadOutData*(import the plot data); -//help:WriteOutData*(export the plot data); -//help:Removespace*(remove spaces of in front and behind); -//help:end(); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt deleted file mode 100644 index 93e5e323..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt +++ /dev/null @@ -1,139 +0,0 @@ -//help:start(); -//help:drawimage*(ç”»åƒã‚’ç”»é¢ã«èªã¿è¾¼ã‚€); -//help:drawtext*(ç”»é¢ã«æ–‡å—を書ã込む); -//help:Option1*(線種を指定.コマンドã®ã‚ªãƒ—ション); -//help:Option2*(書ã出ã—を指定.コマンドã®ã‚ªãƒ—ション); -//help:Option3*(外部ファイルã®èªè¾¼ï¼æ›¸è¾¼ã®æŒ‡å®šï¼Žã‚³ãƒžãƒ³ãƒ‰ã®ã‚ªãƒ—ション); -//help:Changestyle*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã®ã‚ªãƒ—ションを変更); -//help:Workprocess*(å®Ÿè¡Œæ‰‹é †ã‚’è¡¨ç¤º); -//help:Textformat*(数値ã®æ–‡å—列化ã§æ¡æ•°æŒ‡å®š); -//help:Assign*(æ–‡å—列内ã®å¤‰æ•°ã¸ã®å‰²å½“ã¦); -//help:Flattenlist*(データリストを平å¦åŒ–); -//help:Dotprod*(内ç©); -//help:Crossprod*(外ç©); -//help:Ptstart*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã®å§‹ç‚¹); -//help:Ptend*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã®çµ‚点); -//help:Numptcrvtenn*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã®ç‚¹ã®æ•°); -//help:Ptcrv*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã®n番目ã®ç‚¹); -//help:Invert*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã®å‘ãを逆ã«ã™ã‚‹); -//help:ParamonCurve*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ä¸Šã®ç‚¹ã®æƒ…å ±); -//help:PointonCurve*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ä¸Šã®æƒ…å ±ã«ã‚ˆã‚‹ç‚¹); -//help:Nearestptcrv*(点ã«ã¤ã„ã¦ãƒ—ãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ä¸Šã®æœ€è¿‘点); -//help:Nearestpt*(2曲線ã®æœ€è¿‘点); -//help:Derivative*(微分係数); -//help:Integrate*(数値ç©åˆ†); -//help:Findarea*(閉曲線ã«å›²ã¾ã‚ŒãŸé¢ç©); -//help:Findlength*(曲線ã®é•·ã•); -//help:Com2nd*(TeXã®æ›¸ã出ã—コマンドを入れる); -//help:Texcom*(TeXã®ã‚³ãƒžãƒ³ãƒ‰ã‚’直接記述); -//help:Setunitlen*(å˜ä½é•·ã‚’指定); -//help:Setmarklen*(å¾®å°å˜ä½é•·ã‚’指定); -//help:Setorigin*(原点ã®ä½ç½®ã‚’指定); -//help:Fontsize*(フォントサイズを指定); - //help:Setpen*(ç·šã®å¤ªã•ã‚’指定); -//help:Setpt*(点ã®å¤§ãã•ã‚’指定); -//help:Definecolor*(ユーザー色を定義); -//help:Setcolor*(色を指定); -//help:Joincrvs*(曲線をã¤ãªã’ã‚‹); -//help:Partcrv*(部分曲線を作る); -//help:Pointdata*(点データを表示ï¼ä½œæˆ -//è¿½åŠ ã‚ªãƒ—ã‚·ãƒ§ãƒ³ : "Size="); -//help:Listplot*(線分や折れ線データを作æˆ); -//help:Lineplot*(直線データを作æˆ); -//help:Plotdata*(関数ã®ã‚°ãƒ©ãƒ•ã‚’ä½œæˆ -//è¿½åŠ ã‚ªãƒ—ã‚·ãƒ§ãƒ³ : "Num=", "Exc=", "Dis="); -//help:Paramplot*(媒介変数ã®é–¢æ•°ã®ã‚°ãƒ©ãƒ•ã‚’ä½œæˆ -//è¿½åŠ ã‚ªãƒ—ã‚·ãƒ§ãƒ³ : "Num=", "Exc=", "Dis="); -//help:Circledata*(円ã®ãƒ‡ãƒ¼ã‚¿ã‚’ä½œæˆ -//è¿½åŠ ã‚ªãƒ—ã‚·ãƒ§ãƒ³ : "Num=", "Rng="); -//help:Framedata*(長方形ã®ãƒ‡ãƒ¼ã‚¿ã‚’作æˆ); -//help:Ovaldata*(オーãƒãƒ«ãƒ‡ãƒ¼ã‚¿ã‚’作æˆ); -//help:Arrowhead*(éƒã‚’ä½œæˆ -//オプション : 大ãã•ï¼Œé–‹ã角,形状ã¨ä½ç½®); -//help:Arrowdata*(矢å°ã‚’ä½œæˆ -//オプション : 大ãã•ï¼Œé–‹ã角,矢ã˜ã‚Šä½ç½®); -//help:Anglemark*(角度マークを作æˆ. オプション : 角ã®å°ã®å¤§ãã•); -//help:Paramark*(垂直マークを作æˆ. オプション : 角ã®å°ã®å¤§ãã•); -//help:Bowdata*(弓形をæã -//オプション : 曲ãŒã‚Šï¼Œç©ºç™½ã‚µã‚¤ã‚ºï¼Œæ–‡å—); -//help:Deqplot*(微分方程å¼ã®è§£æ›²ç·šã‚’ä½œæˆ -//è¿½åŠ ã‚ªãƒ—ã‚·ãƒ§ãƒ³ : "Num="); -//help:Hatchdata*(斜線塗り. オプション : 傾ã(度),間隔); -//help:Enclosing*(複数曲線をã¤ãªã’ã¦é–‰æ›²ç·šã‚’作æˆ); -//help:Shade*(シェーディング. オプション : 濃ã•); -//help:Rotatepoint*(点を回転. オプション : ä¸å¿ƒ); -//help:Translatepoint*(点を平行移動); -//help:Translatedata*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã‚’平行移動); -//help:Scalepoint*(点を縮å°ï¼æ‹¡å¤§. オプション : ä¸å¿ƒ); -//help:Reflectpoint*(点をé¡æ˜ ); -//help:Rotatedata*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã‚’回転. オプション : ä¸å¿ƒ); -//help:Scaledata*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã‚’縮å°ï¼æ‹¡å¤§. オプション : ä¸å¿ƒ); -//help:Reflectdata*(プãƒãƒƒãƒˆãƒ‡ãƒ¼ã‚¿ã‚’é¡æ˜ ); -//help:Mksegments*(ç”»é¢ã«ã‚ã‚‹ã™ã¹ã¦ã®ç·šåˆ†ãƒ‡ãƒ¼ã‚¿ã‚’作æˆ); -//help:Mkcircles*(ç”»é¢ã«ã‚ã‚‹ã™ã¹ã¦ã®å††ãƒ‡ãƒ¼ã‚¿ã‚’作æˆ): -//help:Setax*(座標軸を指定); -//help:Htickmark*(横軸ã«ç›®ç››ã‚Šã‚’æã); -//help:Vtickmark*(縦軸ã«ç›®ç››ã‚Šã‚’æã); -//help:Drwxy*(座標軸をæã); -//help:Addax*(座標軸をæãã‹æã‹ãªã„ã‹ã®æŒ‡å®š); -//help:Expr*(æ•°å¼ã‚’書ã込む); -//help:Letter*(æ–‡å—を書ã込む); -//help:Letterrot*(傾ã„ãŸæ–‡å—を書ã込む): -//help:Exprrot*(傾ã„ãŸæ•°å¼ã‚’書ã込む): -//help:Putpoint*(幾何点をã¨ã‚‹); -//help:Bezier*(ベジェ曲線データを作æˆ); -//help:Mkbezierptcrv*(制御点を自動的ã«ã¨ã£ã¦ãƒ™ã‚¸ã‚§ã‚’作æˆ); -//help:CRspline*(Catmull-Romスプラインを作æˆ); -//help:Beziersmooth*(ベジェスプラインを作æˆ); -//help:Bspline*(B-スプラインを作æˆ); -//help:PtonLine*(直線上ã«ç‚¹ã‚’ã¨ã‚‹); -//help:PtonSeg*(線分上ã«ç‚¹ã‚’ã¨ã‚‹); -//help:PutonCurve*(曲線上ã«ç‚¹ã‚’ã¨ã‚‹); -//help:Setscaling*(縦方å‘ã®å€çŽ‡ã‚’指定); - //help:Tabledatalight*(幾何点をもãŸãªã„è¡¨ãƒ‡ãƒ¼ã‚¿ä½œæˆ - //è¿½åŠ ã‚ªãƒ—ã‚·ãƒ§ãƒ³ : ラベルã®ã¨ã³ï¼Œæç”»é ˜åŸŸã‚’è¡¨ã«åˆã‚ã›ã‚‹ã‹); - //help:Tgrid*(表ã®ã‚»ãƒ«ã®åº§æ¨™ã‚’è¿”ã™); - //help:Tlistplot*(表ã®2æ ¼å点をçµã¶ç·šåˆ†); -////help:ChangeTablestyle*(表ã®ç½«ç·šã®ã‚¹ã‚¿ã‚¤ãƒ«å¤‰æ›´); -//help:Tabledata*(幾何点をもã¤è¡¨ãƒ‡ãƒ¼ã‚¿ã‚’ä½œæˆ - //è¿½åŠ ã‚ªãƒ—ã‚·ãƒ§ãƒ³ : ラベルã®ã¨ã³ï¼Œæç”»é ˜åŸŸã‚’è¡¨ã«åˆã‚ã›ã‚‹ã‹); -//help:Tabledata*(xLst=apply(1..5,10);yLst=apply(1..4,8);rmvL=[];); -//help:Findcell*(表ã®ã‚»ãƒ«ã®æƒ…å ±ã‚’è¿”ã™); -//help:Putcell*(表ã®ã‚»ãƒ«ã«æ–‡å—を書ã入れる); -//help:Putcellexpr*(表ã®ã‚»ãƒ«ã«æ•°å¼ã‚’書ã入れる); -//help:Putrow*(表ã®è¡Œã«æ–‡å—を書ã入れる)); -//help:Putrowexpr*(表ã®è¡Œã«æ•°å¼ã‚’書ã入れる); -//help:PutcoL*(表ã®åˆ—ã«æ–‡å—を書ã入れる)); -//help:PutcoLexpr*(表ã®åˆ—ã«æ•°å¼ã‚’書ã入れる)); -//help:Setwindow*(æç”»é ˜åŸŸã‚’æŒ‡å®š); -//help:Defvar*(変数をRã«æ¸¡ã™); -//help:Deffun*(関数をRã«æ¸¡ã™); -//help:Extractdata*(èªã¿è¾¼ã‚“ã データã«å±žæ€§ã‚’与ãˆã‚‹); -//help:ReadOutData*(データをèªã¿è¾¼ã‚€); -//help:WriteOutData*(データを書ã出ã™); -//help:Removespace*(å‰å¾Œã®ã‚¹ãƒšãƒ¼ã‚¹ã‚’除ã); -//help:Drawlinetype*(線種を指定ã—ã¦æ›²ç·šã‚’æã); -//help:Intersectcrvs*(交点リストを求ã‚ã‚‹); -//help:IntersectcrvsPp*(交点ã¨ãƒ‘ラメータ値ã®ãƒªã‚¹ãƒˆã‚’求ã‚ã‚‹); -//help:Implicitplot*(陰関数ã®ã‚°ãƒ©ãƒ•ã‚’æã); -//help:Boxplot*(箱ヒゲ図をæã(R使用)); -//help:CalcbyR*(Rã®ã‚³ãƒžãƒ³ãƒ‰ã‚’実行ã—ã¦çµæžœã‚’è¿”ã™); -//help:CalcbyS*(Scilabã®ã‚³ãƒžãƒ³ãƒ‰ã‚’実行ã—ã¦çµæžœã‚’è¿”ã™); -//help:Framedata2*(左下ã¨å³ä¸Šã®ç‚¹ã§é•·æ–¹å½¢ã‚’æã); -//help:HIstplot*(ヒストグラムをæã(R使用)); -//help:Hyperbolaplot*(åŒæ›²ç·šã‚’æã); -//help:Ellipseplot*(楕円をæã); -//help:Ospline*(Oshimaã®ã‚¹ãƒ—ラインをæã); -//help:Parabolaplot*(放物線をæã); -//help:PlotdataR*(Rã®é–¢æ•°ã®ã‚°ãƒ©ãƒ•ã‚’æã); -//help:Polygonplot*(æ£å¤šè§’形をæã); -//help:Putintersect*(交点ã«å¹¾ä½•ç‚¹ã‚’ã¨ã‚‹); -//help:Rulerscale*(点ã®å³ã¨ä¸Šã«ç›®ç››ã‚’æã); -//help:Segmark*(線分ã«ãƒžãƒ¼ã‚¯ã‚’ã¤ã‘ã‚‹); -//help:Sprintf*(å°æ•°ç‚¹ä»¥ä¸‹ã®é•·ã•ã‚’固定ã—ãŸæ–‡å—列ã«å¤‰æ›); -//help:Readcsv*(csvファイルをèªã¿è¾¼ã¿); -//help:Writecsv*(csvファイルを書ãè¾¼ã¿); -//help:Drwpt*(点をTeXã«æã.オプション:白抜ã 0); - - -//help:end(); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvhelpE.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvhelpE.txt deleted file mode 100644 index 9a7edb2e..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvhelpE.txt +++ /dev/null @@ -1,4 +0,0 @@ -//help:start(); -//help:Moviedata*(generate movie/para data); -//help:Paraamble*(Define preamble and postamble); -//help:end(); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvhelpJ.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvhelpJ.txt deleted file mode 100644 index 354d6596..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvhelpJ.txt +++ /dev/null @@ -1,4 +0,0 @@ -//help:start(); -//help:Moviedata*(movieデータを定義 -//オプション : "Cut=1秒ã®ã‚³ãƒžæ•°(20)", "Div=全体ã®ã‚³ãƒžæ•°(80)"); -//help:end(); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvlogr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvlogr.txt deleted file mode 100644 index 70b42e5a..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvlogr.txt +++ /dev/null @@ -1,28 +0,0 @@ -//2017.12.09 -// Parafolder debugged (Viewtex ->WritetoRS) -// Mkanimation debugged ( \ -> / for windows ) -//2017.12.07 -// Setpara options changed -// Animatefile changed (\figsize, OpA) -//2017.11.24 -// Mkflipanime added -// Old movie function removed -// Flipbook removed -// Mkanimation changed (for R) -//2017.11.21 -// Ketinitmv, Paraamble, Mkmovie changed (for R) -//2017.11.03 -// Mkanimation changed (ketpic.sty etc ) -//2017.10.28 -// Parafolder changed (timing of display of counter,time) -//2017.10.24 -// Parafolder changed (file.exists added) -//2017.10.14 -// Mkanimation changed ("Rem=" option added) -//2017.10.13 -// Ketinitmv changed (Shellfile removed) -// Parafolder debugged -//2017.10.12 -// Parafolder changed ( cmdL for making TeX files) -//2017.10.08 -// Mkanimation added diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs deleted file mode 100644 index e9978e7b..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs +++ /dev/null @@ -1,564 +0,0 @@ -// Copyright (C) 2014 Masataka Kaneko, Setsuo Takato, KETCindyJapan project team -// -//This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU General Public License as published by -// the Free Software Foundation; either version 3 of the License, or -// (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with this program. If not, see <http://www.gnu.org/licenses/> -// - -println("ketcindymv(20171124) loaded"); - -//help:start(); - -Setpara(path,fstr,sL):=Setpara(path,fstr,sL,[],[]); // 16.12.27added -Setpara(pathorg,fstr,sL,options):= //17.11.25(3lines) - Setpara(pathorg,fstr,sL,options,[]); -Setpara(pathorg,fstr,sL,options,optionsanim):=( -//help:Setpara("folder name","funstr","range",options,optionsanim); -//help:Setpara(folder,funstr,range,options); -//help:Setpara(options=["m/r","Div=25"]); -//help:Setpara(options2anim1=["Frate=10","Scale=1"]); -//help:Setpara(options2anim2=["OpA=[loop,controls,buttonsize=3mm]"]); -//help:Setpara(options2anim3=["OpA=+step"]); -//help:Setpara(options2anim4=["Mag=1600","Title=folder"]); - regional(path);//17.04.10 - if(length(pathorg)==0, path=Slidename,path=pathorg);//17.04.10 - ParaPath=path; - ParaFstr=fstr; - ParaSL=sL; - ParaOp=options; - ParaOpAnim=optionsanim; //17.11.25 - GLISTback=GLIST; - GCLISTback=GCLIST; - GOUTLISTback=GOUTLIST; - POUTLISTback=POUTLIST; - VLISTback=VLIST; - FUNLISTback=FUNLIST; - LETTERlistback=LETTERlist; - COM0thlistback=COM0thlist; - COM1stlistback=COM1stlist; - COM2ndlistback=COM2ndlist; -); - -Parafolder():=Parafolder(ParaPath,ParaFstr,ParaSL,ParaOp); -Parafolder(path,fstr,sL):=Parafolder(path,fstr,sL,[]); -Parafolder(path,fstr,sLorg,optionorg):=( -//help:Parafolder(foldername,1..4); -//help:Parafolder(foldername,"s=[0,1]"); -//help:Parafolder("mf(s)",foldername,"s=[0,1]"); -//help:Parafolder(options=["m/r","Div=25","Wait=20"]); -//help:Paraslide(para=folder:layery:pos:input,scale); -//help:Paraslide(para=folder:layery:pos:include:[width=100]); - regional(nn,sL,tmp,tmp1,tmp2,strL,eqL,waiting, - mkr,mktex,ndiv,options,sfL); - if(!isstring(ParaPath), - println("Setpara not executed"); - , - sL=sLorg;//16.12.24from - if(!isstring(sL), - tmp=indexof(fstr,"("); - tmp1=substring(fstr,tmp,length(fstr)); - tmp=indexof(tmp1,")"); - tmp1=substring(tmp1,0,tmp-1); - , - tmp=indexof(sL,"=");//16.12.21from - if(length(tmp)>0, - tmp1=substring(sL,0,tmp-1); - ); - ); - parse("Movieframe("+tmp1+"):="+fstr); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - strL=tmp_7; - if(length(strL)==0,options=append(options,"m"));//16.12.18 - mkr="A"; - mktex="A"; - ndiv=25; - waiting=20; - forall(eqL, - tmp=Indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="D", - ndiv=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - forall(strL, - tmp1=Toupper(substring(#,0,1)); - if(tmp1=="M", - mkr="Y"; mktex="Y"; - ); - ); - sL=sLorg; - if(isstring(sL), - tmp=indexof(sL,"="); - tmp1=parse(substring(sL,tmp,length(sL))); - sL=apply(0..ndiv,tmp1_1+#*(tmp1_2-tmp1_1)/ndiv); - ); - if(!isexists(Dirwork,path), - if(ErrFlag!=-1, - makedir(Dirwork,path) - , - println(" ==> Changework may not work properly"); - sL=[]; - ); - , - tmp=fileslist(Dirwork+pathsep()+path); //17.12.09(3lines); - tmp=length(tmp); - if((mkr=="Y") & (tmp>0), - tmp1=replace(Dirwork,"\","/");//17.10.13 - cmdL=[ - "setwd",[Dq+tmp1+"/"+path+Dq], - "fL=as.matrix(list.files())",[], - "apply",["fL",2,"file.remove"], - "setwd",[Dq+tmp1+Dq], - ]; - CalcbyR("rvf",cmdL,["Cat=n","m"]); - tmp=Dirwork+pathsep()+path; - repeat(1..30, - if(length(fileslist(tmp))>0,wait(10)); - ); - );//17.02.20until - ); - sfL=[]; - forall(1..(length(sL)),nn, - GLIST=GLISTback; - GCLIST=GCLISTback; - GOUTLIST=GOUTLISTback; - POUTLIST=POUTLISTback; - VLIST=VLISTback; - FUNLIST=FUNLISTback; - LETTERlist=LETTERlistback; - COM0thlist=COM0thlistback; - COM1stlist=COM1stlistback; - COM2ndlist=COM2ndlistback; - tmp1=Sprintf(nn/1000,3); - tmp=indexof(tmp1,"."); - tmp1=substring(tmp1,tmp,length(tmp1)); - FnameR=path+"/p"+tmp1+".r"; - sfL=append(sfL,FnameR); - Fnametex=replace(FnameR,".r",".tex"); - Movieframe(sL_nn); //17.10.13 - if(!isexists(Dirwork,FnameR) % mkr=="Y", - if(ErrFlag!=-1, - WritetoRS(2); //17.12.09 - ); - ); - ); - tmp1=replace(Dirwork,"\","/"); //17.10.13 - cmdL=[ - "setwd",[Dq+tmp1+"/"+path+Dq], - "Mkallfile=function(fname){",[], - " Ctr<<- Ctr+1",[], - " tmp=readLines(fname)",[], - " first=1",[], - " if(Ctr>1){",[], - " first=7",[], - " cat('Ketinit()\n',file='all.r',append=TRUE)",[], - " }",[], - " for(J in first:(length(tmp)-1)){",[], - " cat(paste(tmp[J],'\n',sep=''),file='all.r',append=TRUE)",[], - " }",[], - " cat('print(',Ctr,')\n',file='all.r',append=TRUE)",[], - " Tmp=proc.time()-Tm",[], - " cat('print(',Tmp[3],')\n',file='all.r',append=TRUE)",[], - "}",[], - "if(file.exists('all.r')){file.remove('all.r')}",[], //17.10.24 - "fL=list.files()",[], - "Ctr=0",[], - "Tm<-invisible(proc.time())",[], - "for(fname in fL){",[], - " if(length(grep('.r',fname))>0){Mkallfile(fname)}",[], // 17.11.24 - "}",[], - "source('all.r')",[], - "setwd",[Dq+tmp1+Dq] - ]; - if(ErrFlag!=-1, - if(!isexists(Dirwork,Fnametex) % mktex=="Y", - CalcbyR("all",cmdL,["Cat=n","m","Wait="+text(waiting)]); - , - println("Parafolder "+path+" finished");//16.12.20 - ); - if(length(after)>0, // 16.12.27 - parse(after); - ); - FnameR=Fhead+".r"; - Fnametex=Fhead+".tex"; - ); - ); -); - -Animatefile():=Animatefile(Dirwork,ParaPath); -Animatefile(path,folder):=( -//help:Animatefile(); -//help:Animatefile(Dirwork,ParaPath); - regional(FRate, Scale, OpA, pa,fname,eqL,tmp,tmp1,tmp2); - tmp=divoptions(ParaOpAnim); //17.11.24 - eqL=tmp_5; - FRate="10"; - Scale="1"; - OpA="loop,controls,buttonsize=3mm"; - remflg=0; - forall(eqL, - tmp1=Toupper(substring(#,0,2)); - tmp=indexof(#,"="); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="FR", - FRate=tmp2; - ); - if(tmp1=="SC", - Scale=tmp2; - ); - if(tmp1=="OP", // 17.12.07from - if(length(tmp2)>0, - tmp2=replace(tmp2,"[",""); - tmp2=replace(tmp2,"]",""); - if(substring(tmp2,0,1)=="+", - OpA=OpA+","+substring(tmp2,1,length(tmp2)); - , - OpA=tmp2; - ); - ); - ); - ); - if(length(OpA)>0,OpA="["+OpA+"]"); - pa=replace(path,"\","/"); - fname="anim"+folder+".tex"; - tmp=Dirwork+"/"+folder; - path=replace(tmp,"\","/"); - if(iswindows(),tmp=replace(tmp,"/","\")); - tmp1=fileslist(tmp); - tmp1=tokenize(tmp1,","); - tmp1=select(tmp1,indexof(#,".tex")>0); - SCEOUTPUT= openfile(fname); - println(SCEOUTPUT,"\def\parapath{"+pa+"}%"); //17.06.22 - println(SCEOUTPUT,"\def\figsize{"+Scale+"}%"); //17.12.07 - println(SCEOUTPUT,"\begin{animateinline}"+OpA+"{"+FRate+"}%"); - forall(1..(length(tmp1)), - if(Scale==1, // 17.08.30from - tmp="\input{\parapath/"; - tmp=tmp+folder+"/"+tmp1_#+"}%"; - , - tmp="\scalebox{\figsize}{\input{\parapath/";//17.12.07 - tmp=tmp+folder+"/"+tmp1_#+"}}%"; - ); // 17.08.30until - println(SCEOUTPUT,tmp); -// println(SCEOUTPUT,""); //17.06.25 - if(#<length(tmp1), - println(SCEOUTPUT,"\newframe%"); - ); - ); - println(SCEOUTPUT,"\end{animateinline}%"); - closefile(SCEOUTPUT); - println(fname+" has been generated"); -); - -Mkanimation():=( - regional(remflg,tmp,eqL,tmp1,tmp2); - if(!isexists(Dirwork,ParaPath), //17.10.14from - Parafolder(); - ); - Animatefile(); //17.10.14until - Mkanimation(Dirwork,ParaPath); -); -Mkanimation(folder):=Mkanimation(Dirwork,folder); -Mkanimation(path,folder):=( -//help:Mkanimation(); -//help:Mkanimation(path,folder); - regional(Fheadbkup,Pathpdfbkup,tex,article,parent, - eqL,mag,title,tmp,tmp1,tmp2,tmp3,flg); - tmp=Divoptions(ParaOpAnim); //17.11.25from - eqL=tmp_5; - mag="1600"; - title=folder; - forall(eqL, - tmp=Indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="M", - mag=tmp2; - ); - if(tmp1=="T", - title=tmp2; - ); - ); //17.11.25until - Fheadbkup=Fhead; - Fhead="animate"+folder; - Pathpdfbkup=Pathpdf; - Pathpdf=PathAd; - tmp1=replace(PathT,pathsep(),"/"); - tmp=indexall(tmp1,"/");//17.10.14from - if(length(tmp)>0, - tex=substring(tmp1,tmp_(length(tmp)),length(tmp1)); - , - tex=tmp1; - );//17.10.14until - if((tex=="platex")%(tex=="uplatex"), - if(tex=="platex",article="jarticle",article="ujarticle"); - , - article="article"; - ); - SCEOUTPUT=openfile(Fhead+".tex"); - println(SCEOUTPUT,"\documentclass[landscape]{"+article+"}"); - if((tex=="platex")%(tex=="uplatex")%(tex=="latex"), - tmp="\special{papersize=\the\paperwidth,\the\paperheight}"; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"\mag="+mag);//17.11.25 - ); - if((tex=="pdflatex")%(tex=="lualatex")%(tex=="xelatex"), - if((tex=="pdflatex")%(tex=="xelatex"), - println(SCEOUTPUT,"\usepackage[pdftex]{pict2e}"); - , - println(SCEOUTPUT,"\usepackage{pict2e}"); - println(SCEOUTPUT,"\usepackage{luatexja}"); - ); - tmp=replace(Dirhead,"\","/"); //17.10.30from - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic2e}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer2e}"); - ); - , - tmp=replace(Dirhead,"\","/"); //17.10.30from - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}"); - ); - ); - println(SCEOUTPUT,"\usepackage{amsmath,amssymb}"); - println(SCEOUTPUT,"\usepackage{bm,enumerate}"); - if((tex=="platex")%(tex=="uplatex")%(tex=="latex"), - println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}"); - println(SCEOUTPUT,"\usepackage[dvipdfmx]{animate}"); - , - println(SCEOUTPUT,"\usepackage{graphicx}"); - println(SCEOUTPUT,"\usepackage{animate}"); - ); - println(SCEOUTPUT,"\usepackage{xcolor}"); - forall(ADDPACK, tmp1, - tmp=indexof(tmp1,"{animate}")+indexof(tmp1,"{hyperref}"); - if(tmp==0, - println(SCEOUTPUT,"\usepackage"+tmp1); - ); - ); - println(SCEOUTPUT,"\pagestyle{empty}"); - println(SCEOUTPUT,"\setmargin{0}{0}{0}{0}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\begin{document}"); - println(SCEOUTPUT,"\large"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\vspace*{25mm}"); - println(SCEOUTPUT,""); - tmp=floor(parse("290*1000/"+mag)); - print(SCEOUTPUT,"\Ctab{"+text(tmp)+"mm}{"); - print(SCEOUTPUT,"\fbox{\Large\bf "+title+"}"); - println(SCEOUTPUT,"}"); - tmp=parse("6*1000/"+mag); - println(SCEOUTPUT,"\vspace{"+text(tmp)+"mm}"); - println(SCEOUTPUT,""); - tmp=indexof(ULEN,"cm"); - if(tmp>0, - tmp1=substring(ULEN,0,tmp-1); - tmp1=parse(replace(tmp1," ",""))*10; - ); - tmp=indexof(ULEN,"mm"); - if(tmp>0, - tmp1=substring(ULEN,0,tmp-1); - tmp1=parse(replace(tmp1," ","")); - ); - tmp=parse("300*1000/"+mag); - tmp1=(tmp-(XMAX-XMIN)*tmp1)/2; - tmp1=tmp1+parse("("+mag+"-1000)/100*1.3"); - print(SCEOUTPUT,"\hspace*{"+text(tmp1)+"mm}"); - tmp=replace(path,"\","/"); //17.12.09(2lines) - println(SCEOUTPUT,"\input{"+tmp+"/anim"+folder+".tex}"); - println(SCEOUTPUT,"\end{document}"); - closefile(SCEOUTPUT); - if(iswindows(), - parent=Dirwork+Batparent; - Makebat(Fhead,"ttv"); - kc():=( - println("kc : "+kc(parent,Dirlib,Fnametex)) - ); - kc(); - , - parent=Dirwork+Shellparent; - Makeshell(Fhead,"ttv"); - kc():=( - println("kc : "+kc(parent,Mackc+Dirlib,Fnametex)); - ); - kc(); - ); - Fhead=Fheadbkup; - Pathpdf= Pathpdfbkup; -); - -Mkflipanime():=( - regional(remflg,tmp,eqL,tmp1,tmp2); - if(!isexists(Dirwork,ParaPath), //17.10.14from - Parafolder(); - ); - Mkflipanime(Dirwork,ParaPath); -); -Mkflipanime(folder):=Mkflipanime(Dirwork,folder); -Mkflipanime(path,folder):=( -//help:Mkfilpanime(); -//help:Mkflipanime(path,folder); - regional(Fheadbkup,tex,article,parent,eqL,mag,title, - tmp,tmp1,tmp2,tmp3,texfiles,flg); - tmp=Divoptions(ParaOpAnim); //17.11.25from - eqL=tmp_5; - mag="1600"; - title=folder; - forall(eqL, - tmp=Indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="M", - mag=tmp2; - ); - if(tmp1=="T", - title=tmp2; - ); - ); //17.11.25until - Fheadbkup=Fhead; - Fhead="flipanime"+folder; - tmp1=replace(PathT,pathsep(),"/"); - tmp=indexall(tmp1,"/");//17.10.14from - if(length(tmp)>0, - tex=substring(tmp1,tmp_(length(tmp)),length(tmp1)); - , - tex=tmp1; - );//17.10.14until - if((tex=="platex")%(tex=="uplatex"), - if(tex=="platex",article="jarticle",article="ujarticle"); - , - article="article"; - ); - SCEOUTPUT=openfile(Fhead+".tex"); - println(SCEOUTPUT,"\documentclass[landscape]{"+article+"}"); - if((tex=="platex")%(tex=="uplatex")%(tex=="latex"), - tmp="\special{papersize=\the\paperwidth,\the\paperheight}"; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"\mag="+mag);//17.11.25 - ); - if((tex=="pdflatex")%(tex=="lualatex")%(tex=="xelatex"), - if((tex=="pdflatex")%(tex=="xelatex"), - println(SCEOUTPUT,"\usepackage[pdftex]{pict2e}"); - , - println(SCEOUTPUT,"\usepackage{pict2e}"); - println(SCEOUTPUT,"\usepackage{luatexja}"); - ); - tmp=replace(Dirhead,"\","/"); //17.10.30from - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic2e}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer2e}"); - ); - , - tmp=replace(Dirhead,"\","/"); //17.10.30from - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}"); - ); - ); - println(SCEOUTPUT,"\usepackage{amsmath,amssymb}"); - println(SCEOUTPUT,"\usepackage{bm,enumerate}"); - if((tex=="platex")%(tex=="uplatex")%(tex=="latex"), - println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}"); - , - println(SCEOUTPUT,"\usepackage{graphicx}"); - ); - println(SCEOUTPUT,"\usepackage{xcolor}"); - forall(ADDPACK, tmp1, - if(tmp==0, - println(SCEOUTPUT,"\usepackage"+tmp1); - ); - ); - println(SCEOUTPUT,"\pagestyle{empty}"); - println(SCEOUTPUT,"\setmargin{0}{0}{0}{0}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\begin{document}"); - println(SCEOUTPUT,"\large"); - println(SCEOUTPUT,""); - tmp=fileslist(Dirwork+pathsep()+folder); - tmp=tokenize(tmp,","); - texfiles=select(tmp,indexof(#,".tex")>0); - forall(texfiles, - println(SCEOUTPUT,"\vspace*{25mm}"); - println(SCEOUTPUT,""); - tmp=floor(parse("290*1000/"+mag)); - print(SCEOUTPUT,"\Ctab{"+text(tmp)+"mm}{"); - print(SCEOUTPUT,"\fbox{\Large\bf "+title+"}"); - println(SCEOUTPUT,"}"); - tmp=parse("6*1000/"+mag); - println(SCEOUTPUT,"\vspace{"+text(tmp)+"mm}"); - println(SCEOUTPUT,""); - tmp=indexof(ULEN,"cm"); - if(tmp>0, - tmp1=substring(ULEN,0,tmp-1); - tmp1=parse(replace(tmp1," ",""))*10; - ); - tmp=indexof(ULEN,"mm"); - if(tmp>0, - tmp1=substring(ULEN,0,tmp-1); - tmp1=parse(replace(tmp1," ","")); - ); - tmp=parse("300*1000/"+mag); - tmp1=(tmp-(XMAX-XMIN)*tmp1)/2; - tmp1=tmp1+parse("("+mag+"-1000)/100*1.3"); - print(SCEOUTPUT,"\hspace*{"+text(tmp1)+"mm}"); - println(SCEOUTPUT,"\input{"+folder+"/"+#+"}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\newpage"); - ); - println(SCEOUTPUT,"\end{document}"); - closefile(SCEOUTPUT); - if(iswindows(), - parent=Dirwork+Batparent; - Makebat(Fhead,"tv"); - kc():=( - println("kc : "+kc(parent,Dirlib,Fnametex)) - ); - kc(); - , - parent=Dirwork+Shellparent; - Makeshell(Fhead,"tv"); - kc():=( - println("kc : "+kc(parent,Mackc+Dirlib,Fnametex)); - ); - kc(); - ); - Fhead=Fheadbkup; -); - -//help:end(); - diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutlogr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutlogr.txt deleted file mode 100644 index 94752a33..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutlogr.txt +++ /dev/null @@ -1,59 +0,0 @@ -// 2018.03.27 -// functions of C changed -// CalcbyC added -// Sfbdparadata,Crvsfparadata added -// 2018.03.24 -// WriteCdata changed ( 99999 ) -// 2018.03.03 -// ConvertFdtoC changed ( varnames converted to u,v ) -// 2018.03.01 -// Cform,ConvertFdtoC added -// 2018.02.27 -// Rfun debugged -// 2018.02.22 -// CalcbyR changed (adding ".txt" to wfile) -// 2018.02.20 -// CalcbyR changed (Quick return of Erromessage) -// 2018.02.12 -// MkprecommandR changed ( for GLIST ) -// 2018.02.11 -// Mkprecommand debugged -// CalcbyR debugged ("ans" replaced to name ) -// 2018.02.01 -// CalcbyR changed (for matrix, wait=5 ) -// 2018.01.31 -// CalcbyR changed (for list of list ) -// 2018.01.29 -// CalcbyR debugged and changed (case of result is null ) -// 2018.01.27 -// CalcbyR changed ( output like Maxima(::),"Out") -// 2018.01.07 -// Hatchdata debugged (fun removed ) -// 2017.12.24 -// Mkobjpoly,Mkobjplate debugged -// Changeobjscalce changed for R -// 2017.12.23 -// Mkobjsymbcmd debugged -// Setoptions changed -// Mkobjthickcmd added -// 2017.12.22 -// Mkobjcrvcmd debugged -// 2017.10.24 -// Maxima2Cindydata added -// 2017.10.12 -// kcR debugged ( for Mac, => 2> ) -// 2017.10.07 -// CalcbyR debugged ( => WritetoRS ) -// ReadCdata changed ( execstr removed ) -// 2017.10.02 -// Imlicitplot changed (for R) -// 2017.09.29 -// WritetoS debugged (LibnameS) -// Dotfilldata changed -// 2017.09.24 -// Circledata, WritetoR, PrecommandR debugged -// 2017.09.23 -// Hatchdata debugged -// 2017.09.18 -// Hatchdata changed (for R) -// SCIWR,SCIRE removed diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutr.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutr.cs deleted file mode 100644 index 1bb3e343..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindyliboutr.cs +++ /dev/null @@ -1,5935 +0,0 @@ -// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -// -//This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU General Public License as published by -// the Free Software Foundation; either version 3 of the License, or -// (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with this program. If not, see <http://www.gnu.org/licenses/> -// - -println("ketcindyout(20180327) loaded"); - -//help:start(); - -WritetoS(fname,cmdL):=( -// help:WritetoS("outdata",cmdL); - regional(tmp,tmp1,tmp2,filename); - if(indexof(fname,".")==0, - filename=fname+".sce"; - , - filename=fname; - ); - SCEOUTPUT = openfile(filename); - tmp="cd('"+Dirwork+"');//"; - println(SCEOUTPUT,tmp); -// tmp1=replace(Dirlib,"\","/"); - tmp="Ketlib=lib("+Dq+LibnameS+Dq+");//"; //17.09.29 - println(SCEOUTPUT,tmp); - tmp="Ketinit();//"; - println(SCEOUTPUT,tmp); - tmp="Setwindow([XMIN,XMAX],[YMIN,YMAX]);"; // 16.06.26from - tmp=Assign(tmp,["XMIN",XMIN,"XMAX",XMAX,"YMIN",YMIN,"YMAX",YMAX]); - println(SCEOUTPUT,tmp); // 16.06.26until - if(iswindows(), // 17.01.11from - println(SCEOUTPUT,"setlanguage('en')"); - ); // 17.01.11until - tmp="pi=%pi;////"; - println(SCEOUTPUT,tmp); - forall(cmdL, - println(SCEOUTPUT,#+"//"); - ); - closefile(SCEOUTPUT); -); - -kcS(path,fname):=kcS(path,fname,[]); -kcS(path,fname,optionorg):=( -//help:kcS(PathS,"boxdata"); -//help:kcS(options=["r/m"]); - regional(options,tmp,tmp1,tmp2,eqL,strL,filename,flg); - if(indexof(fname,".")==0, - filename=fname+".sce"; - , - filename=fname; - ); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - strL=tmp_7; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - ); - flg=0; - forall(strL, - if(Toupper(substring(#,0,1))=="R", - flg=0; - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="M", - flg=1; - ); - ); - if(flg==0, - tmp2=replace(filename,".sce",".txt"); - tmp1=load(tmp2); - if(length(tmp1)==0, - flg=1; - ); - ); - if(flg==1, - tmp1=""; // 15.10.08 from - if(iswindows(), - tmp2=Batparent; - , - tmp2=Shellparent; - ); - flg=0; - forall(reverse(1..length(tmp2)), - if(flg==0, - tmp=substring(tmp2,#-1,#); - if(tmp=="/" % tmp=="\", // 14.01.15 - tmp1=substring(tmp2,0,#-1); - tmp2=substring(tmp2,#,length(tmp2)); - flg=1; - ); - ); - ); - if(length(tmp1)>0, - setdirectory(tmp1); - ); // 15.10.08 to - if(iswindows(), - SCEOUTPUT = openfile("kc.bat"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp=Dq+path+Dq+" -nb -nwni -f "+filename; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit"); - closefile(SCEOUTPUT); - println(kc(Dirwork+Batparent,Dirlib,Fnametex));// 16.05.29, 0605 - , - SCEOUTPUT = openfile("kc.sh"); - println(SCEOUTPUT,"#!/bin/sh"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp=Dq+path+Dq+" -nwni -f "+filename; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - println(kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex));// 16.05.29 - ); - wait(WaitUnit); - setdirectory(Dirwork); - ); -); - -SetpathS():=( - regional(tmp,tmp1); - if(!isstring(PathS), // 15.12.11 - Setdirectory(Dirbin); // 15.12.07 - tmp=load(Shellfile); - if(iswindows(), - tmp=tokenize(tmp," -nb"); - PathS=tmp_1; - , - tmp=tokenize(tmp," -nwni"); - tmp=tokenize(tmp_1,"/Applications/sci"); - PathS="/Applications/sci"+tmp_2; - ); - setdirectory(Dirwork); - ); - PathS; -); - -ErrhandleS(fname):=( // 2016.02.28 - regional(str); //17.04.14 - if(indexof(PathS,"-6.")==0, - str=["if iserror(-1) then"," error=lasterror()+'????';"]; - str=append(str," errclear(-1);"); // 16.03.14 - str=append(str," Fd=mopen("+Dq+wfile+Dq+",'wt');"); - str=append(str," mfprintf(Fd,'%s','Error: '+error);"); - str=append(str," mclose(Fd);"); - str=append(str," quit();"); - str=append(str,"end;"); - str; - , - str=[]; //17.04.14 - ); -); - -Testfunstr(funstr,varx,vary):=( - regional(var,val,fun,tmp,tmp1,tmp2); - fun=replace(funstr,".x","(1)"); // 16.05.19 - fun=replace(fun,".y","(2)"); // 16.05.19 - tmp=indexof(varx,"="); - var=substring(varx,0,tmp-1); - val=substring(varx,tmp+1,length(varx)); - tmp=indexof(val,","); - val=substring(val,0,tmp-1); - tmp1=replace(fun,var,"("+val+")"); - tmp=indexof(vary,"="); - var=substring(vary,0,tmp-1); - val=substring(vary,tmp+1,length(vary)); - tmp=indexof(val,","); - val=substring(val,0,tmp-1); - tmp1=replace(tmp1,var,"("+val+")"); - tmp1; -); - -CalcbyS(name,cmd):=CalcbyS(name,SetpathS(),cmd,[]); -CalcbyS(name,Arg1,Arg2):=( - if(isstring(Arg1), - CalcbyS(name,Arg1,Arg2,[]); - , - CalcbyS(name,SetpathS(),Arg1,Arg2); - ); -); -CalcbyS(name,path,cmd,optionorg):=( -//help:CalcbyS("a",cmd); -//help:CalcbyS(options= ["m/r","Wait=10","Cat=middle"]]); -//help:CalcbyS(options1= ["Ncol=2","File=result","Dig=5"]]); - regional(options,tmp,tmp1,tmp2,tmp3,tmp4,realL,strL,eqL, - ncoL,cat,dig,flg,wflg,file,nc,arg,cmdS,cmdlist,wfile,ext, - waiting, errcheck); - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - realL=tmp_6; - strL=tmp_7; - cat="M";//16.11.24 - ncoL=2; - ext=".txt"; - waiting=10; - dig=5; - wfile=""; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,2)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="CA", - cat=Toupper(substring(tmp2,0,1));// 16.11.24 - options=remove(options,[#]); - ); - if(tmp1=="NC", - ncoL=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="EX", - if(indexof(tmp2,".")==0,ext="."+tmp2,ext=tmp2); - options=remove(options,[#]); - ); - if(tmp1=="WA", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="DI", - dig=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="FI", // 16.06.26from - wfile=tmp2; - options=remove(options,[#]); - ); // 16.06.26until - ); - if(wfile=="", - if(cat=="Y", - wfile=Fhead+name; - , - wfile="resultS"; - ); - ); - if(indexof(wfile,".")==0,// 16.06.26from - wfile=wfile+ext; - ); // 16.06.26until - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - if(CONTINUED==0, - if((wflg==0) & (cat=="Y"), // 16.11.24 - tmp=load(wfile); - if(length(tmp)==0,wflg=1); - ); - ); - file=Fhead+name; - cmdS=cmd; - cmdlist=[]; - forall(1..floor(length(cmdS)/2),nc, //17.05.18 - tmp1=cmdS_(2*nc-1); - tmp1=replace(tmp1,LFmark,""); // 16.06.12 - tmp1=replace(tmp1,CRmark,""); // 16.12.13 - if(nc==length(cmdR)/2, //16.10.23from - if(indexof(tmp1,"=")==0,tmp1="="+tmp1); - ); //16.10.23from - if(substring(tmp1,0,1)=="=", -// tmp1=name+tmp1; // 16.12.20 - ); - tmp2=cmdS_(2*nc); // list of argments - tmp3=""; - tmp4=""; - errcheck=0; - forall(tmp2,arg, - if(isstring(arg), - if(Toupper(arg)=="ERROR", - errcheck=1; - , - tmp3=tmp3+replace(arg,"'",Dq)+","; - ); - , - if(!islist(arg), - tmp3=tmp3+textformat(arg,dig)+","; - , - tmp=select(arg,isstring(#) % islist(#)); - if(length(tmp)>0, - tmp3=tmp3+"list("; - tmp4=")"; - , - tmp3=tmp3+"["; - tmp4="]"; - ); - forall(arg, - if(isstring(#), - tmp3=tmp3+replace(#,"'",Dq)+","; - , - if(!islist(#), // 15.11.01 from - tmp3=tmp3+textformat(#,dig)+","; - , - tmp=textformat(#,dig); - tmp=replace(tmp,"],[","];["); - tmp3=tmp3+tmp+","; - ); // 15.11.01 until - ); - ); - tmp3=substring(tmp3,0,length(tmp3)-1)+tmp4+","; - ); - ); - ); - if(length(tmp3)>0, - tmp3=substring(tmp3,0,length(tmp3)-1); - tmp1=tmp1+"("+tmp3+");"; - ); - if(errcheck==1, - if(indexof(Dirlib,"sciL5")>0, // 17.03.20 - cmdlist=append(cmdlist,"errcatch(-1,'continue','nomessage');"); - ); // 17.03.20 - ); - cmdlist=append(cmdlist,tmp1); - if(errcheck==1, - tmp=ErrhandleS(wfile); - cmdlist=concat(cmdlist,tmp); - ); - ); - if(CONTINUED==1, - ComOutList=concat(ComOutList,cmdlist); - , - if(cat=="Y", - tmp=[]; - tmp=append(tmp,"Fd=mopen("+Dq+file+".txt"+Dq+",'wt');"); - // 16.03.11 from - tmp=append(tmp,"mfprintf(Fd,'%s',"+name+");"); - tmp=append(tmp,"mclose(Fd);"); - cmdlist=concat(cmdlist,tmp); -// tmp="fprintfMat("+Dq+file+".txt"+Dq+","+name+")"; -// cmdlist=append(cmdlist,tmp); // 16.03.11 until - , -// tmp="mputl(['????'],"+Dq+file+".txt"+Dq+");"; // 16.06.2 from -// cmdlist=concat(cmdlist,[tmp]); // 16.06.2 until - ); - if(cat!="Y", // 16.12.18 - cmdlist=append(cmdlist,"mputl('||||','"+wfile+"')"); - ); - cmdlist=append(cmdlist,"quit()"); - if(wflg==0, - tmp1=load(file+".sce"); - if(length(tmp1)==0, - wflg=1; - , - tmp1=tokenize(tmp1,"////"); - tmp1=tokenize(tmp1_2,"//"); - tmp1=tmp1_(1..(length(tmp1)-1)); - if(length(tmp1)!=length(cmdlist), - wflg=1; - , - tmp=select(1..length(tmp1),tmp1_#!=cmdlist_#); - if(length(tmp)>0, wflg=1); - ); - ); - ); - if(wflg==0,wflg=-1); // 15.10.16 - if(wflg==1, - if(length(wfile)>0, // 15.10.05 - SCEOUTPUT=openfile(wfile); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - ); - WritetoS(file+".sce",cmdlist); - kcS(path,file,concat(options,["m"])); // 15.09.25 - ); - flg=0; - tmp1=floor(waiting*1000/WaitUnit); - repeat(tmp1, - if(flg==0, - tmp=load(wfile); - if(length(tmp)>=4, - tmp2=substring(tmp,length(tmp)-4,length(tmp)); - if(tmp2=="////" % tmp2=="||||" % tmp2=="????", // 16.08.09 - if(indexof(Toupper(tmp),"ERROR")>0, - println(tmp); - flg=2; - , - flg=1; - ); - ); - tmp2=#*WaitUnit/1000; - , - if(wflg==-1, - flg=-1; - , - wait(WaitUnit); - ); - ); - ); - ); - if(flg<=0, - ErrFlag=1; - if(flg==-1, - println(wfile+" does not exist"); - , - tmp="("+text(waiting)+" s )"; - println(wfile+" not generated "+tmp); - ); - , - if(flg==1, - println(" CalcbyS succeeded "+name+"("+text(tmp2)+" sec)"); //16.06.03 - , - ErrFlag=1; - ); - ); - ); - if(wflg>-1, -// wait(WaitUnit); - ); -); - -Scifun(name,fun,argL):=Scifun(name,fun,argL,[]);//16.10.22 -Scifun(name,fun,argL,optionorg):=( -//help:Scifun("1","date()",[]); -//help:Scifun(options=["Disp=y"]); - regional(nm,options,eqL,disp,cmdL,fname, - tmp,tmp1,tmp2); - nm="sc"+name; - fname=Fhead+nm+".txt"; - options=optionorg; - tmp=divoptions(options); - precise=6; - disp=1; - pack=[]; - set=[]; - add=""; - eqL=tmp_5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,3)); - tmp2=substring(#,tmp,length(#)); - if((tmp1=="DIS") % (tmp1=="DSP") , - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="F") % (tmp=="N"), - disp=0; - ); - options=remove(options,[#]); - ); - ); - cmdL=[]; - cmdL=concat(cmdL,[ - nm+"="+fun,argL, - "Fd=mopen",[Dq+fname+Dq,Dq+"wt"+Dq], - "Sla=char(47)+char(47);",[], - "mputl",["string("+nm+")+Sla","Fd"], - "mputl",["Sla","Fd"], - "mclose",["Fd"] - ]); - options=append(options,"Wait=2"); - CalcbyS(nm,cmdL,options); - if(ErrFlag==0, - tmp=load(fname); - tmp=replace(tmp,"////",""); - tmp=tokenize(tmp,"//"); - tmp=apply(tmp,if(!isstring(#),textformat(#,6),Dq+#+Dq)); - if(length(tmp)==1, - tmp=tmp_1; - ); - tmp=nm+"="+text(tmp); - parse(tmp); - if(disp==1, // 15.11.24 - println(nm+" is : "); - println(parse(nm)); - ); - ); - parse(nm); -); - -WritetoR(fname,cmdL):=WritetoR(fname,cmdL,[]); -WritetoR(fname,cmdL,options):=( -// help:WritetoR("outdata",cmdL); - regional(eqL,tmp,tmp1,tmp2,filename,waiting); - if(indexof(fname,".")==0, - filename=fname+".r"; - , - filename=fname; - ); - tmp=divoptions(options); - eqL=tmp_5; - waiting=5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - if(Toupper(substring(tmp1,0,1))=="W", - waiting=parse(tmp2); - ); - ); - SCEOUTPUT = openfile(filename); - tmp1=replace(Dirwork,"\","/"); - tmp="setwd("+Dq+tmp1+Dq+")##"; - println(SCEOUTPUT,tmp); - tmp1=replace(Libname,"\","/"); // 17.09.24from -// tmp="load('"+tmp1+".Rdata')"; # 17.10.12 - tmp="source('"+tmp1+".r')##"; // 17.09.24temporarily - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"Ketinit()##"); // 16.07.07 - tmp="Setwindow(c(XMIN,XMAX),c(YMIN,YMAX))####"; // 16.06.26from - tmp=Assign(tmp,["XMIN",XMIN,"XMAX",XMAX,"YMIN",YMIN,"YMAX",YMAX]); - println(SCEOUTPUT,tmp); - forall(cmdL, - println(SCEOUTPUT,#+"##"); - ); - closefile(SCEOUTPUT); -// flg=0; -// tmp1=floor(waiting*1000/WaitUnit); -// repeat(tmp1, -// if(flg==0, -// tmp=load(filename); -// if(length(tmp)>0, -// flg=1; -// , -// wait(WaitUnit); -// ); -// ); -// ); -); - -kcR(path,fname):=kcR(path,fname,[]); -kcR(path,fname,optionorg):=( -//help:kcR(PathR,"boxdata"); -//help:kcR(options=["m/r","Wait=10"]); - regional(options,tmp,tmp1,tmp2,eqL,strL,filename,ferr,flg); - if(indexof(fname,".")==0, - filename=fname+".r"; - , - filename=fname; - ); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - strL=tmp_7; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - ); - flg=0; - forall(strL, - if(Toupper(substring(#,0,1))=="R", - flg=0; - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="M", - flg=1; - options=remove(options,[#]); - ); - ); - if(flg==0, - tmp2=replace(filename,".r",".txt"); - tmp1=load(tmp2); - if(length(tmp1)==0, - flg=1; - ); - ); - if(flg==1, - tmp1=""; // 15.10.08 from - if(iswindows(), - tmp2=Batparent; - , - tmp2=Shellparent; - ); - flg=0; - forall(reverse(1..length(tmp2)), - if(flg==0, - tmp=substring(tmp2,#-1,#); - if(tmp=="/" % tmp=="\", // 14.01.15 - tmp1=substring(tmp2,0,#-1); - tmp2=substring(tmp2,#,length(tmp2)); - flg=1; - ); - ); - ); - if(length(tmp1)>0, - setdirectory(tmp1); - ); // 15.10.08 to - ferr="errormessageR.txt";//16.10.22from - SCEOUTPUT=openfile(ferr); - closefile(SCEOUTPUT);//16.10.22uptp - if(iswindows(), - SCEOUTPUT = openfile("kc.bat"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp=Dq+path+"\R"+Dq+" --vanilla --slave < "+filename+" 2> "+ferr; - //16.10.22 - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit"); - closefile(SCEOUTPUT); - println(kc(Dirwork+Batparent,Dirlib,Fnametex));// 16.05.29,06.05 - , - SCEOUTPUT = openfile("kc.sh"); - println(SCEOUTPUT,"#!/bin/sh"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - if(PathR=="",tmp="R",tmp=PathR);//16.10.20 - tmp=tmp+" --vanilla --slave < "+filename+" 2> "+ferr;//17.10.12 - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - println(kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex));// 16.05.29,06.05 - ); - wait(WaitUnit); - setdirectory(Dirwork); - ); -); - -Dataframe(nmL,dL):=Dataframe(nmL,dL,[]); -Dataframe(nmL,dL,options):=( -//help:Dataframe(["name","no1","no2"],dtL); -//help:Dataframe(options=["Dig=5"]); - regional(dig,tmp,tmp1,tmp2,out); - dig=5; - tmp=Divoptions(options); - tmp=tmp_5; - forall(tmp, - tmp1=Toupper(substring(#,0,1)); - tmp2=indexof(#,"="); - tmp2=substring(#,tmp2,length(#)); - if(tmp1=="D", - dig=parse(tmp2); - ); - ); - out="data.frame("; - forall(1..(length(nmL)), - tmp1=nmL_#; - tmp2=column(dL,#); - tmp2=apply(tmp2,if(isstring(#),Dq+#+Dq,format(#,dig))); - tmp=tmp1+"="+tmp2+","; - out=out+tmp; - ); - out=substring(out,0,length(out)-1)+")"; - out=replace(out,"[","c("); - out=replace(out,"]",")"); -); - -CalcbyR(name,cmd):=CalcbyR(name,PathR,cmd,[]); -CalcbyR(name,Arg1,Arg2):=( - if(isstring(Arg1), - CalcbyR(name,Arg1,Arg2,[]); - , - CalcbyR(name,PathR,Arg1,Arg2); - ); -); -CalcbyR(name,path,cmd,optionorg):=( -//help:CalcbyR(name,cmd); -//help:CalcbyR(options=["m/r","Wait=2","Out=yes","Pre=yes","Res=" ]); - regional(options,tmp,tmp1,tmp2,tmp3,realL,strL,eqL, - cat,dig,preflg,flg,wflg,file,nc,arg,cmdR,cmdlist,wfile,waiting); - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - realL=tmp_6; - strL=tmp_7; - dig=5; - cat="Y"; - wfile=""; - preflg=1; - waiting=5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if((tmp1=="C")%(tmp1=="O"), - cat=Toupper(substring(tmp2,0,1)); - options=remove(options,[#]); - ); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="P", //18.01.27 - tmp2=substring(Toupper(tmp2),0,1); - if(tmp2=="Y",preflg=1); - if(tmp2=="N",preflg=0); - options=remove(options,[#]); - ); - if(tmp1=="D", - dig=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="F", - wfile=tmp2; //18.02.27 - options=remove(options,[#]); - ); - if(tmp1=="R", - wfile=tmp2; //180227 - options=remove(options,[#]); - ); - ); - if(wfile=="", - if(cat=="Y", - wfile=Fhead+name+".txt"; - , - wfile="result.txt"; - ); - ); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - if(CONTINUED==0, - if((wflg==0) & (cat!="N"), // 16.11.13 - tmp=load(wfile); - if(length(tmp)==0,wflg=1); - ); - ); - file=Fhead+name; - cmdR=[]; - if(preflg==1, //18.01.27from - cmdR=MkprecommandR(); - ); - cmdR=concat(cmdR,cmd); //18.01.27until - cmdlist=[]; - if(dig>5, //16.10.28from - cmdlist=append(cmdlist,"options(digits="+text(dig+2)+");"); - ); //16.10.28until - forall(1..floor(length(cmdR)/2),nc, //17.05.18 - tmp1=cmdR_(2*nc-1); - tmp1=replace(tmp1,LFmark,""); // 16.06.12 - if(nc==length(cmdR)/2, //16.10.23from -// if(indexof(tmp1,"=")==0,tmp1="="+tmp1);//16.12.20 - ); //16.10.23uptp - if(substring(tmp1,0,1)=="=", - tmp1=name+tmp1; - ); - tmp2=cmdR_(2*nc); // list of argments - tmp3=""; - forall(tmp2,arg, - if(isstring(arg), - tmp3=tmp3+replace(arg,"'",Dq)+","; - , - if(length(arg)==1, - tmp3=tmp3+textformat(arg,dig)+","; - , - tmp3=tmp3+"c("; - forall(arg, - tmp3=tmp3+textformat(#,dig)+","; - ); - tmp3=substring(tmp3,0,length(tmp3)-1)+")"+","; - ); - ); - ); - if(length(tmp3)>0, - tmp3=substring(tmp3,0,length(tmp3)-1); - tmp1=tmp1+"("+tmp3+")"; - ); - cmdlist=append(cmdlist,tmp1); - ); - tmp1=cmdlist_(length(cmdlist)); - if(indexof(tmp1,"=")==0, - tmp1=tokenize(tmp1,"::"); - if(length(tmp1)==1, - tmp2=name+"="+tmp1_1; - , - tmp2=name+"=list("; - forall(tmp1, - tmp2=tmp2+#+","; - ); - tmp2=substring(tmp2,0,length(tmp2)-1)+")"; - ); - cmdlist_(length(cmdlist))=tmp2; - ); - if(CONTINUED==1, - ComOutList=concat(ComOutList,cmdlist); - , - if(cat=="Y", //16.10.23from - tmp="sharp=rawToChar(as.raw(35))"; - cmdlist=append(cmdlist,tmp); - tmp="sharps=paste(sharp,sharp,'\n',sep='')"; - cmdlist=append(cmdlist,tmp); - tmp="if(Length("+name+")==0){"+name+"='nodata'}"; //18.01.29 - cmdlist=append(cmdlist,tmp); - cmdlist=append(cmdlist,"if(is.matrix("+name+")){"); - cmdlist=append(cmdlist," tmp=list()");//18.02.01from - cmdlist=append(cmdlist," for(ii in 1:Length("+name+")){"); - cmdlist=append(cmdlist," tmp=c(tmp,list(Op(ii,"+name+")))"); - cmdlist=append(cmdlist," }"); - cmdlist=append(cmdlist," "+name+"=tmp"); - cmdlist=append(cmdlist,"}");//18.02.01until - cmdlist=append(cmdlist,"if(is.list("+name+")){"); -// tmp=" cat(names("+name+"),file='"+wfile+"',sep=',')"; //18.01.27deleted -// cmdlist=append(cmdlist,tmp); -// tmp=" cat(sharps,file='"+wfile+"',append=TRUE)"; -// cmdlist=append(cmdlist,tmp); - cmdlist=append(cmdlist," for(ii in Looprange(1,length("+name+"))){"); - cmdlist=append(cmdlist," if(is.list("+name+"[[ii]])){"); - tmp=" cat('[',file='"+wfile+"',sep='',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - tmp=" cat(sharps,file='"+wfile+"',sep='',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - tmp=" for(jj in Looprange(1,length("+name+"[[ii]]))){"; - cmdlist=append(cmdlist,tmp); - tmp=" cat("+name+"[[ii]][[jj]],file='"+wfile+"',sep=',',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - tmp=" cat(sharps,file='"+wfile+"',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - cmdlsit=append(cmdlist," }"); - cmdlist=append(cmdlist," }"); - tmp=" cat(']',file='"+wfile+"',sep=',',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - tmp=" cat(sharps,file='"+wfile+"',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - cmdlist=append(cmdlist," }else{"); - tmp=" cat("+name+"[[ii]],file='"+wfile+"',"; - tmp=tmp+"sep=',',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - tmp=" cat(sharps,file='"+wfile+"',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - cmdlist=append(cmdlist," }"); - cmdlist=append(cmdlist," }"); - cmdlist=append(cmdlist,"}else{"); - tmp=" cat("+name+",file='"+wfile+"',sep=',')"; - cmdlist=append(cmdlist,tmp); - tmp=" cat(sharps,file='"+wfile+"',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - cmdlist=append(cmdlist,"}"); - tmp="cat('////',file='"+wfile+"',sep=',',append=TRUE)"; - cmdlist=append(cmdlist,tmp); - ); //16.10.23until - if(cat!="Y", // 16.12.18 - cmdlist=append(cmdlist,"cat('////',file='"+wfile+"',sep='')"); - ); - cmdlist=append(cmdlist,"quit()"); - if(wflg==0, - tmp1=load(file+".r"); - if(length(tmp1)==0, - wflg=1; - , - tmp1=tokenize(tmp1,"####"); // 15.09.25 from - tmp1=tokenize(tmp1_2,"##"); - tmp1=tmp1_(1..(length(tmp1)-1)); - if(length(tmp1)!=length(cmdlist), - wflg=1; - , - tmp=select(1..length(tmp1),tmp1_#!=cmdlist_#); - if(length(tmp)>0, wflg=1); - ); - ); // 15.09.25 to - ); - if(wflg==0,wflg=-1); // 15.10.16 - if(wflg==1, - if(length(wfile)>0, // 15.10.05 - SCEOUTPUT=openfile(wfile); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - ); - WritetoR(file+".r",cmdlist); //17.10.08 - SCEOUTPUT=openfile("errormessageR.txt");//18.02.20from - println(SCEOUTPUT,""); - closefile(SCEOUTPUT);//18.02.20until - kcR(PathR,file,concat(options,["m"])); // 15.09.25 - ); - flg=0; - tmp1=floor(waiting*1000/WaitUnit); - repeat(tmp1, - if(flg==0, - tmp=load(wfile); - if(length(tmp)>=4, - tmp2=substring(tmp,length(tmp)-4,length(tmp)); - if(tmp2=="////", - tmp=substring(tmp,0,length(tmp)-4); - flg=1; - tmp2=#*WaitUnit/1000; - ); - , - if(wflg==-1, - flg=-1; - , - wait(WaitUnit); - tmp=load("errormessageR.txt");//18.02.20 - if(length(tmp)>1, - println(tmp); - flg=-2; - );//18.02.20 - ); - ); - ); - ); - if(flg<=0, - ErrFlag=1; - if(flg==-1, - println(wfile+" does not exist"); - , - if(flg==0, - tmp="("+text(waiting)+" s )"; - println(wfile+" not generated "+tmp); - ); - ); - , - println(" CalcbyR succeeded "+name+" ("+text(tmp2)+" sec)"); - if(cat=="Y", // 16.10.29,11.25 - tmp1=tokenize(tmp,"##"); //16.10.23from - tmp1=tmp1_(1..(length(tmp1)-1)); - tmp2=[]; - forall(tmp1,tmp3, - if(!isstring(tmp3), - tmp=format(tmp3,dig); - , - if(indexof(tmp3,",")==0, - tmp=Dqq(tmp3); //180227 - , - tmp=tmp3; - if(substring(tmp3,0,2)=="c(", - tmp=substring(tmp3,2,length(tmp3)-1); - ); - tmp=tokenize(tmp,","); - tmp=textformat(tmp,dig); - ); - ); - tmp2=append(tmp2,tmp); - ); - if(length(tmp2)==1, - tmp2=tmp2_1; - if(length(tmp2)==1,tmp2=tmp2_1); - if(isstring(tmp2), - if(indexof(tmp2,"nodata")>0,tmp2="[]"); //180227from - tmp2=parse(tmp2); - ); - tmp3=textformat(tmp2,dig);//180227until - , - tmp3=""; - forall(tmp2, - if(length(#)==0, - tmp3=tmp3+"[],"; - , - tmp3=tmp3+#+","; - ); - ); - tmp3="["+substring(tmp3,0,length(tmp3)-1)+"]"; - tmp3=replace(tmp3,"[,","["); - tmp3=replace(tmp3,",]","]"); - ); - tmp=name+"="+tmp3;//180227 - parse(tmp); - ); - ); - ); -); - -Rfun(name,fun,argL):=Rfun(name,fun,argL,[]);//16.10.22 -Rfun(name,fun,argL,optionorg):=( -//help:Rfun("1","rnorm",[10]); -//help:Rfun(options=["Disp=y"]); - regional(nm,options,eqL,disp,cmdL, - tmp,tmp1,tmp2); - nm="R"+name; - options=optionorg; - tmp=divoptions(options); - precise=6; - disp=1; - pack=[]; - set=[]; - add=""; - eqL=tmp_5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,3)); - tmp2=substring(#,tmp,length(#)); - if((tmp1=="DIS") % (tmp1=="DSP") , - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="F") % (tmp=="N"), - disp=0; - ); - options=remove(options,[#]); - ); - ); - cmdL=[]; - cmdL=concat(cmdL,[ - nm+"="+fun,argL, - ]); - options=concat(options,["Wait=2"]); - CalcbyR(nm,cmdL,options); - if(ErrFlag==0, - if(disp==1, // 15.11.24 - println(nm+" is : "); - println(parse(nm)); - ); - ); - parse(nm); -); - -Readcsv(file):=Readcsv(Dirwork,file,[]); -Readcsv(Arg1,Arg2):=( - if(isstring(Arg2), - Readcsv(Arg1,Arg2,[]); - , - Readcsv(Dirwork,Arg1,Arg2); - ); -); -Readcsv(pathorg,file,optionorg):=( -//help:Readcsv("ex.csv"); -//help:Readcsv(directory,"ex.csv"); -//help:Readcsv(options=["Head=yes","Sep=-999","Flat=no","Use=R"]); - regional(path,fname,fout,options,eqL,header,cmdL,sep, - dt,nrow,tmp,tmp1,tmp2,csv,use,flat); - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - header=1; - sep="-999"; - csv="Y"; // 16.12.12 - use="R"; - flat="N"; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - tmp=Toupper(substring(tmp1,0,2)); - if(tmp=="HE", - tmp=Toupper(substring(tmp2,0,1)); - if(tmp=="F" % tmp=="N", - header=0; - options=remove(options,[#]); - ); - ); -// if(tmp=="WA", // removed:17.02.19 -// waiting=parse(tmp2); -// options=remove(options,[#]); -// ); - if(tmp=="SE", - sep=tmp2; - options=remove(options,[#]); - ); - if(tmp=="CS", - csv=Toupper(substring(tmp2,0,1)); - options=remove(options,[#]); - ); - if(tmp=="US", - use=Toupper(substring(tmp2,0,1)); - options=remove(options,[#]); - ); - if(tmp=="FL", - flat=Toupper(substring(tmp2,0,1)); - options=remove(options,[#]); - ); - ); - if(flat=="Y",csv="N"); - sep=","+sep; - tmp=indexof(file,"."); - if(tmp==0, - fname=file+".csv"; - fout=file+"sep.csv"; - , - fname=file; - tmp1=substring(file,0,tmp-1); - tmp2=substring(file,tmp-1,length(file)); - fout=tmp1+"sep"+tmp2; - ); - path=pathorg; - if(!isexists(path,fname), - println(path+" "+fname+" not found"); - , - path=replace(path,"\","/"); - if(use=="S", - cmdL=[ // 16.12.20from - "cd('"+path+"')",[], - "Dt=mgetl('"+fname+"');",[], - "cd('"+Dirwork+"')",[], - "Dt2=[]",[], - "for I=1:size(Dt,1), - Tmp=Dt(I,:)+'"+sep+"'; - Dt2=[Dt2;Tmp]; - end",[], - "mputl(Dt2,'"+fout+"')",[] - ]; - CalcbyS("sep",cmdL,options); - , - cmdL=[ - "setwd",[Dq+path+Dq], - "tmp1=readLines",[Dq+fname+Dq,"warn=FALSE"], - "fun=function(s) paste(s,"+Dq+sep+Dq+",sep="+Dq+Dq+")",[], - "tmp2=sapply(tmp1,fun)",[], - "writeLines",["tmp2",Dq+fout+Dq] - ]; - CalcbyR("sep",cmdL,concat(options,["Cat=n"])); - ); // 16.12.20until - if(ErrFlag==1, - println("Readcsv not completed"); - , - dt=load(fout); - dt=tokenize(dt,sep); - dt=dt_(1..(length(dt)-1));//16.12.20 - if(isstring(dt_1),// 17.02.10from - if(indexof(dt_1,",")==0,csv="N"); - , - csv="N"; - );// 17.02.10until - if(csv=="Y", - dt=apply(dt,tokenize(#,",")); - , - dt=apply(dt,[#]); - ); - forall(1..(length(dt)),nrow, - tmp1=dt_nrow; - tmp2=[]; - forall(tmp1, - if(!isstring(#), - tmp=#; - , - if(substring(#,0,1)==Dq, - tmp=parse(#); - , - tmp=#; - ); - ); - tmp2=append(tmp2,tmp); - ); - dt_nrow=tmp2; - ); - if(header==0,dt=dt_(2..(length(dt)))); - if(length(dt)==1, - dt=dt_1 - , - if(length(dt_1)==1, - dt=apply(dt,#_1); - ); - ); - dt; - ); - ); -); - -Writecsv(nmL,data,file):=Writecsv(nmL,data,file,[]); -Writecsv(nmL,dataorg,file,optionorg):=( -//help:Writecsv([],data,"ex.csv"); -//help:Writecsv(["a","b"],data,"ex.csv"); -//help:Writecsv(optins=["Col=1"]); - regional(nameL,data,eqL,strL,ncol,nrow,fname,dig,tmp,tmp1,tmp2); - ncol=0; // 17.02.09from - dig=5; - if(isstring(dataorg),data=parse(dataorg),data=dataorg); - if(islist(data_1), - ncol=length(data_1); - data=flatten(data); - ); // 17.02.09until - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - if(Toupper(substring(tmp1,0,1))=="C", - ncol=parse(tmp2); - options=remove(options,[#]); - ); - ); - if(indexof(file,".")==0,fname=file+".csv",fname=file); - if(ncol==0,ncol=max(1,length(nmL))); - tmp1=mod(length(data),ncol); - if(tmp1>0, - tmp=apply(1..(ncol-tmp1),-1); - data=concat(data,tmp); - ); - nrow=length(data)/ncol; - if(length(nmL)<ncol, - nameL=apply(1..ncol,"c"+text(#)); -// tmp=nameL_length(nameL)+"##";//17.02.09 - tmp=nameL_(length(nameL));//17.02.09 - nameL_(length(nameL))=tmp; - , - nameL=nmL; - ); - SCEOUTPUT=openfile(fname); - tmp=text(nameL); - println(SCEOUTPUT,substring(tmp,1,length(tmp)-1)); - forall(1..nrow, - tmp1=data_(((#-1)*ncol+1)..(#*ncol)); - tmp2=""; - forall(tmp1, - tmp2=tmp2+textformat(#,5)+","; - ); - tmp2=substring(tmp2,0,length(tmp2)-1); - println(SCEOUTPUT,tmp2); - ); - closefile(SCEOUTPUT); -); - -Hatchdata(nm,iostr,pltlist):=Hatchdata(nm,iostr,pltlist,[]); -Hatchdata(nm,iostr,pltlist,optionorg):=( //17.09.18 -//help:Hatchdata("1","ii",[["gr1"],["gr2","n"]]); -//help:Hatchdata(options=["Wait=5"]); - regional(options,name,eqL,reL,strL, - plt,fname,options,tmp,tmp1,tmp2,tmp3,flg,wflg,waiting); - name="ha"+nm; - fname=Fhead+name+".txt"; - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(length(#)==0, - options=remove(options,[#]); - ); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - if(islist(iostr), - tmp1=text(apply(iostr,Dq+#+Dq)); - tmp1=replace(tmp1,"[","list("); //16.02.14 - tmp1=replace(tmp1,"]",")"); //16.02.14 - , - tmp1=Dq+iostr+Dq; - ); - if(!islist(pltlist_1), - tmp2=apply(pltlist,if(length(#)==1,Dq+#+Dq,Chunderscore(#))); - tmp2=text(tmp2); - tmp2="list("+substring(tmp2,1,length(tmp2)-1)+"),"; - , - tmp2=""; - forall(pltlist,plt, - tmp=apply(plt,if(length(#)==1,Dq+#+Dq,Chunderscore(#))); // 16.04.06 - tmp=text(tmp); - tmp="list("+substring(tmp,1,length(tmp)-1)+")"; - tmp2=tmp2+tmp+","; - ); - ); - cmdL=MkprecommandR(); - tmp2=substring(tmp2,0,length(tmp2)-1); - tmp=[tmp1,tmp2]; - tmp=concat(tmp,reL); - cmdL=concat(cmdL,[ - "Setscaling",[SCALEY], - "Setunitlen",[Dq+ULEN+Dq], - name+"=Hatchdata",tmp, //16.12.23 - "WriteOutData",[Dq+fname+Dq,Dq+name+Dq,name] - ]); - options=append(options,"Wait="+text(waiting)); - if(wflg==1,options=concat(options,["m"])); - if(wflg==-1,options=concat(options,["r"])); - options=append(options,"Cat=no"); - if(ErrFlag==0, - CalcbyR(name,cmdL,options); - ); - if(ErrFlag==1, - err("Hatchdata not completed"); - , - if(ErrFlag==0, - ReadOutData(fname); - Extractdata(name,options); - ); - ); -); - -PlotdataR(name1,func,var):=PlotdataR(name1,PathR,func,var); -PlotdataR(name1,Arg1,Arg2,Arg3):=( - if(islist(Arg3), - PlotdataR(name1,PathR,Arg1,Arg2,Arg3); - , - PlotdataR(name1,Arg1,Arg2,Arg3,[]); - ); -); -PlotdataR(name1,path,func,variable,optionorg):=( -//help:PlotdataR("1","dnorm(x)","x"); -//help:PlotdataR(options=["m/r","Num=50","Wait=10"]); - regional(options,tmp,tmp1,tmp2,tmp3,name,varstr,flg,Num, - Ltype,Noflg,eqL,strL,flg,outreg,filename,wfile,cmdL,waiting); - name="grR"+name1; - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - strL=tmp_7; - Num=50; - waiting=5; - outreg=0; - flg=0; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,tmp,length(#)); - if(Toupper(substring(#,0,1))=="N", - Num=parse(tmp1); - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="W", - waiting=parse(tmp1); - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="O", - tmp=Toupper(substring(tmp1,0,1)); - if(tmp=="T" % tmp=="Y", outreg=1); - options=remove(options,[#]); - ); - ); - tmp=indexof(variable,"="); - if(tmp>0, - varstr=variable; - , - varstr=variable+"="+textformat([XMIN,XMAX],5); - ); - varstr=replace(varstr,"[","c("); - varstr=replace(varstr,"]",")"); - filename=Fhead+name+".r"; - wfile=Fhead+name+".txt"; - cmdL=MkprecommandR(); - cmdL=concat(cmdL,[ - name+"=Plotdata",[Dq+func+Dq,Dq+varstr+Dq,Dq+"Num="+text(Num)+Dq], - "WriteOutData",[Dq+wfile+Dq,Dq+name+Dq,name] - ]); - if(ErrFlag==0, - CalcbyR(name,cmdL,concat(options,["Cat=middle","Wait="+text(waiting)])); - ); - if(ErrFlag==1, - println("PlotdataR not completed"); - , - if(outreg==1, - OutFileList=remove(OutFileList,[wfile]); - OutFileList=append(OutFileList,wfile); - ); - ReadOutData(wfile); - Extractdata(name,options); - tmp=parse(name); - tmp1=name+"="+textformat(tmp,5); - parse(tmp1); - tmp2=apply(tmp,Lcrd(#)); - tmp2; - ); -); - -PlotdiscR(nm,fun,varrng):=PlotdiscR(nm,fun,varrng,[]); -PlotdiscR(nm,fun,varrng,options):=( -//help:PlotdiscR("1","dbinom(k,10,0.4)","k=[0,10]"); - regional(name,pb,cmdL,var,range,tmp,tmp1,tmp2,wfile); - name="grd"+nm; - tmp=indexof(varrng,"="); - var=substring(varrng,0,tmp-1); - range=parse(substring(varrng,tmp,length(varrng))); - if(length(range)==2, - range=(range_1)..(range_2); - ); - cmdL=[ - "fnb=function("+var+") "+fun,[], - name+"=sapply",[range,"fnb"] - ]; - wfile=Fhead+name+".txt"; - if(ErrFlag==0, - CalcbyR(name,cmdL,options); - ); - if(ErrFlag==1, - println("PlotdiscR not completed"); - , - tmp1=load(wfile); - tmp1=substring(tmp1,0,length(tmp1)-4); - tmp1=replace(tmp1,"##",""); - pb=tokenize(tmp1,","); - tmp=apply(range,[#,pb_(#+1)]); - Listplot(name,tmp,options); - ); -); - -Boxplot(nm,dataorg,ypos,dy):=Boxplot(nm,dataorg,ypos,dy,[]); -Boxplot(nm,dataorg,ypos,dy,optionorg):=( -//help:Boxplot("1",dt,2,1/2,[""]); - regional(options,name,data,bp,cmdL,waiting,tmp,tmp1,tmp2,tmp3,tmp4, - out,eqL,strL,pstr,ext,file,flg,wrflg); - name="bp"+nm; - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - strL=tmp_7; - waiting=3; - wrflg=0; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - if(Toupper(substring(tmp1,0,1))=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="R", - wrflg=-1; - options=remove(options,[#]); - ); - if(tmp=="M", - wrflg=1; - options=remove(options,[#]); - ); - ); - data=dataorg; - if(isstring(data), - if(indexof(data,".")==0,data=data+".dat"); - if(iswindows(), // 15.11.10 - data=replace(data,"/","\"); - flg="\"; - , - data=replace(data,"\","/"); - flg="/"; - ); - forall(reverse(1..length(data)), - if(length(flg)>0, - tmp=substring(data,#-1,#); - if(tmp==flg, - tmp3=substring(data,0,#-1); - tmp4=substring(data,#,length(data)); - if(indexof(tmp3,":")==0, // 11.11.10 - tmp=substring(tmp3,0,1); - if(tmp!=flg, - tmp3=Dirwork+flg+tmp3; - ); - ); - flg=""; - ); - ); - ); - if(length(flg)>0, - tmp3=Dirwork; //15.11.10 - tmp4=data; - ); - setdirectory(tmp3); - tmp=load(tmp4); - if(length(tmp)==0, ErrFlag=2); // 15.11.07 until - setdirectory(Dirwork); - , - file=Fhead+name+".dat"; - tmp=load(file); - if(length(tmp)>0, - tmp1=tokenize(tmp,","); - tmp1=tmp1_(1..(length(tmp1)-1)); - , - tmp1=[]; - ); - flg=0; - if(length(tmp1)==length(data), - tmp=tmp1-data; - tmp=select(tmp,#!=0); - if(length(tmp)>0,flg=1); - , - flg=1; - ); - if(flg==1, - SCEOUTPUT=openfile(file); - forall(data, - print(SCEOUTPUT,textformat(#,5)+","); - ); - println(SCEOUTPUT,"////"); - closefile(SCEOUTPUT); -// wait(WaitUnit); - ); - data=file; - ); - data=replace(data,"\","/"); - cmdL=[ - "tmp=readLines",[Dq+data+Dq, "warn=FALSE"], - "tmp=substring",["tmp",1,"nchar(tmp)-4"], - "data=strsplit",["tmp",Dq+","+Dq,"fix=TRUE"], - "data=data[[1]]",[], - "fun=function(s) eval(parse(text=s))",[], - "data=sapply",["data","fun"], - "data=data[!is.na(data)]",[], - "tmp=boxplot",["data","plot=FALSE"], - "tmp1=tmp$stat",[], - "tmp2=tmp$out",[], - name+"=c(tmp1,tmp2)",[] - ]; - file=Fhead+name+".txt"; - options=append(options,"Wait="+text(waiting)); - if(wrflg==1,options=append(options,"m")); - if(wrflg==-1,options=append(options,"r")); - if(ErrFlag==0, - CalcbyR(name,cmdL,options); - ); - if(ErrFlag>0, - if(ErrFlag==1,println("Boxplot not completed")); - if(ErrFlag==2,println(Dq+data+Dq+" not found")); - , - bp=parse(name); - pstr="["; - tmp1=[bp_1,ypos-dy/2]; - tmp2=[bp_1,ypos+dy/2]; - Listplot(name+text(1),[tmp1,tmp2],["Msg=no"]); - pstr=pstr+Dq+"sg"+name+text(1)+Dq+","; - tmp1=[bp_2,ypos-dy]; - tmp2=[bp_2,ypos+dy]; - tmp3=[bp_4,ypos+dy]; - tmp4=[bp_4,ypos-dy]; - Listplot(name+text(2),[tmp1,tmp2,tmp3,tmp4,tmp1],["Msg=no"]); - pstr=pstr+Dq+"sg"+name+text(2)+Dq+","; - tmp1=[bp_5,ypos-dy/2]; - tmp2=[bp_5,ypos+dy/2]; - Listplot(name+text(3),[tmp1,tmp2],["Msg=no"]); - pstr=pstr+Dq+"sg"+name+text(3)+Dq+","; - tmp1=[bp_3,ypos-dy]; - tmp2=[bp_3,ypos+dy]; - Listplot(name+text(4),[tmp1,tmp2],["dr,2","Msg=no"]); - pstr=pstr+Dq+"sg"+name+text(4)+Dq+","; - tmp1=[bp_1,ypos]; - tmp2=[bp_2,ypos]; - Listplot(name+text(5),[tmp1,tmp2],["da","Msg=no"]); - pstr=pstr+Dq+"sg"+name+text(5)+Dq+","; - tmp1=[bp_4,ypos]; - tmp2=[bp_5,ypos]; - Listplot(name+text(6),[tmp1,tmp2],["da","Msg=no"]); - pstr=pstr+Dq+"sg"+name+text(6)+Dq+","; - out=bp_(6..length(bp)); - if(length(out)>0, - out=apply(out,[#,ypos]); - Pointdata(name+text(1),out,[0,"Size=4"]); - ); - pstr=substring(pstr,0,length(pstr)-1)+"]"; - println("generate totally "+name); - tmp=name+"="+pstr; - [bp_(1..5),out]; - ); -); - -Histplot(nm,dataorg):=Histplot(nm,dataorg,[]); -Histplot(nm,dataorg,optionorg):=( -//help:Histplot("1",data(fillename)); -//help:Histplot(options=["Breaks=","Den=no","Rel=no"]); - regional(options,name,data,waiting,hp,cmdL,tmp,tmp1,tmp2,tmp3,tmp4, - out,eqL,strL,breaks,bdata,cdata,pstr,file,flg,rwflg,density,relative); - name="hp"+nm; - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - strL=tmp_7; - breaks = "breaks="+Dq+"Sturges"+Dq; - density=0; - relative=0; - waiting=3; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,tmp,length(#)); - if(Toupper(substring(#,0,1))=="B", - if(substring(tmp1,0,1)=="[", - tmp1="c("+substring(tmp1,1,length(tmp1)-1)+")"; - ); - breaks="breaks="+tmp1; - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="D", - tmp2=Toupper(substring(tmp1,0,1)); - if(tmp2=="T" % tmp2=="Y", - density=1; - ); - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="R", - tmp2=Toupper(substring(tmp1,0,1)); - if(tmp2=="T" % tmp2=="Y", - relative=1; - ); - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="W", - waiting=parse(tmp1); - options=remove(options,[#]); - ); - ); - wrflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="R", - wrflg=-1; - options=remove(options,[#]); - ); - if(tmp=="M", - wrflg=1; - options=remove(options,[#]); - ); - ); - data=dataorg; - if(isstring(data), - if(indexof(data,".")==0,data=data+".csv"); - if(iswindows(), // 15.11.10 - data=replace(data,"/","\"); - flg="\"; - , - data=replace(data,"\","/"); - flg="/"; - ); - forall(reverse(1..length(data)), - if(length(flg)>0, - tmp=substring(data,#-1,#); - if(tmp==flg, - tmp3=substring(data,0,#-1); - tmp4=substring(data,#,length(data)); - if(indexof(tmp3,":")==0, // 11.11.10 - tmp=substring(tmp3,0,1); - if(tmp!=flg, - tmp3=Dirwork+flg+tmp3; - ); - ); - flg=""; - ); - ); - ); - if(length(flg)>0, - tmp3=Dirwork; //15.11.10 - tmp4=data; - ); - setdirectory(tmp3); - tmp=load(tmp4); - if(length(tmp)==0, ErrFlag=2); // 15.11.07 until - setdirectory(Dirwork); - , - file=Fhead+name+".dat"; - tmp=load(file); - if(length(tmp)>0, - tmp1=tokenize(tmp,","); - tmp1=tmp1_(1..(length(tmp1)-1)); - , - tmp1=[]; - ); - flg=0; - if(length(tmp1)==length(data), - tmp=tmp1-data; - tmp=select(tmp,#!=0); - if(length(tmp)>0,flg=1); - , - flg=1; - ); - if(flg==1, - SCEOUTPUT=openfile(file); - forall(data, - print(SCEOUTPUT,textformat(#,5)+","); - ); - println(SCEOUTPUT,"////"); - closefile(SCEOUTPUT); -// wait(WaitUnit); - ); - data=file; - ); - data=replace(data,"\","/"); - cmdL=[ - "tmp=readLines",[Dq+data+Dq, "warn=FALSE"], - "tmp=substring",["tmp",1,"nchar(tmp)-4"], - "data=strsplit",["tmp",Dq+","+Dq,"fix=TRUE"], - "data=data[[1]]",[], - "fun=function(s) eval(parse(text=s))",[], - "data=sapply",["data","fun"], - "data=data[!is.na(data)]",[], - "tmp=hist",["data","plot=FALSE",breaks], - "tmp1=tmp$breaks",[], - "tmp2=tmp$count",[], - "tmp3=tmp$density",[], - name+"=c(tmp1,tmp2,tmp3)",[] - ]; - file=Fhead+name+".txt"; - options=append(options,"Wait="+text(waiting)); - if(wrflg==1,options=append(options,"m")); - if(wrflg==-1,options=append(options,"r")); - if(ErrFlag==0, - CalcbyR(name,cmdL,options); - ); - if(ErrFlag>0, - if(ErrFlag==1,println("Histplot not completed")); - if(ErrFlag==2,println(Dq+data+Dq+" not found")); - , -// tmp=load(file); -// tmp=replace(tmp,"/",""); -// tmp=tokenize(tmp,","); -// tmp=name+"="+textformat(tmp,5); -// parse(tmp); - hp=parse(name); - tmp1=(length(hp)-1)/3+1; - tmp2=tmp1+(length(hp)-1)/3; - bdata=hp_(1..tmp1); - if(density==0, - cdata=hp_((tmp1+1)..tmp2); - , - cdata=hp_((tmp2+1)..length(hp)); - ); - if(relative==1, - cdata=cdata/sum(cdata); - ); - options=append(options,"Msg=no"); // 15.10.03 - pstr="["; - forall(1..length(cdata), - tmp1=[bdata_#,0]; - tmp2=[bdata_#,cdata_#]; - tmp3=[bdata_(#+1),cdata_#]; - tmp4=[bdata_(#+1),0]; - Listplot(name+text(#),[tmp1,tmp2,tmp3,tmp4,tmp1],options); - pstr=pstr+Dq+"sg"+name+text(#)+Dq+","; - ); - pstr=substring(pstr,0,length(pstr)-1)+"]"; - println("generate totally "+name); - tmp=name+"="+pstr; - parse(tmp); - [bdata,cdata]; - ); -); - -Scatterplot(nm,file):=Scatterplot(nm,file,[]); -Scatterplot(nm,file,optionorg):=( -//help:Scatterplot("1",path+filename); -//help:Scatterplot(options=["Reg=yes",A,B,C,"Size"=4"]); - regional(tmp,tmp1,tmp2,fname,name,reg,eqL,reL,cdysize, - options,dtx,dty,nn,mx,my,sx,sy,sxy,rr,aa,bb,size); - name="sc"+nm; - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - reL=tmp_6; - options=remove(options,reL); - cdysize=select(options,indexof(#,"size->")>0); - options=remove(options,cdysize); - size=4; - reg="yes"; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="R", - reg=tmp2; - options=remove(options,[#]); - ); - if(tmp1=="S", - size=parse(tmp2); - options=remove(options,[#]); - ); - ); - if(indexof(file,".")==0, - fname=file+".csv"; - , - fname=file; - ); - Readcsv(nm,fname); - tmp=concat(options,cdysize); - Pointdata(name,parse("rc"+nm),append(tmp,"Size="+text(size))); - tmp=parse("rc"+nm); - dtx=apply(tmp,#_1); - dty=apply(tmp,#_2); - nn=length(dtx); - mx=sum(dtx)/nn; - my=sum(dty)/nn; - sx=sqrt(dtx*dtx/nn-mx^2); - sy=sqrt(dty*dty/nn-my^2); - sxy=dtx*dty/nn-mx*my; - rr=sxy/sx/sy; - aa=sxy/sx^2; - bb=my-aa*mx; - tmp=Assign("a*x+b",["a",aa,"b",bb]); - if(reg!="no", - Plotdata(name,tmp,"x",append(options,"Num=2")); - ); - if(length(reL)>=2, - Framedata2(name,[reL_1,reL_2]); - if(length(reL)>2, - tmp="r="+textformat(rr,3)+",\ y="; - tmp=tmp+textformat(aa,3)+"x"; - if(bb>0,tmp=tmp+"+",tmp=tmp+"-"); - tmp=tmp+textformat(abs(bb),3); - Expr([reL_3,"e",tmp]); - ); - ); - [mx,my,sx,sy,sxy,rr,bb,aa]; -); - -Rulerscale(pt,hscale,vscale):=Rulerscale(pt,hscale,vscale,0.1); -Rulerscale(pt,hscale,vscale,tick):=( -//help:Rulerscale(A,["r",0,5,1],["s2",0,2,4]); -//help:Rulerscale(A,["r",0,5,1],["f",10,"a",20,"w2","b"]); -//help:Rulerscale(A,["r",0,5,1],["r",0,10,1],0.2); - regional(pA,pos,mrk,dir,tmp,tmp1,tmp2,tmp3); - pA=Lcrd(pt); - if(length(hscale)>0, - pos=[]; mrk=[]; dir=[]; - tmp=Toupper(substring(hscale_1,0,1)); - if(tmp=="R" % tmp=="F", - if(tmp=="R", - dir="s2"; - tmp1=hscale_2; - tmp2=hscale_3; - tmp3=hscale_4; - tmp=floor((tmp2-tmp1)/tmp3); - pos=apply(0..tmp,tmp1+#*tmp3); - mrk=apply(pos,text(#)); - dir=apply(1..length(pos),"s2"); - , - forall(2..(length(hscale)-2), - tmp1=hscale_(#); - tmp2=hscale_(#+1); - tmp3=hscale_(#+2); - if(isreal(tmp1), - pos=append(pos,tmp1); - if(isstring(tmp3), - dir=append(dir,tmp2); - mrk=append(mrk,tmp3); - , - dir=append(dir,"s2"); - mrk=append(mrk,tmp2); - ); - ); - ); - if(isreal(tmp2), - pos=append(pos,tmp2); - dir=append(dir,"s2"); - mrk=append(mrk,tmp3); - ); - ); - , - pos=hscale_(2..length(hscale)); - dir=apply(pos,"s2"); - mrk=apply(pos,text(#)); - ); - pos=apply(pos,[#,pA_2]); - forall(1..length(pos), - Expr([pos_#,dir_#,mrk_#]); - tmp1=pos_#; - tmp2=pos_#-[0,tick/SCALEY]; - Listplot("rsh"+text(#),[tmp1,tmp2],["Msg=no"]); - ); - ); - if(length(vscale)>0, - pos=[]; mrk=[]; dir=[]; - tmp=Toupper(substring(vscale_1,0,1)); - if(tmp=="R" % tmp=="F", - if(tmp=="R", - dir="w2"; - tmp1=vscale_2; - tmp2=vscale_3; - tmp3=vscale_4; - tmp=floor((tmp2-tmp1)/tmp3); - pos=apply(0..tmp,tmp1+#*tmp3); - mrk=apply(pos,text(#)); - dir=apply(1..length(pos),"w2"); - , - forall(2..(length(vscale)-2), - tmp1=vscale_(#); - tmp2=vscale_(#+1); - tmp3=vscale_(#+2); - if(isreal(tmp1), - pos=append(pos,tmp1); - if(isstring(tmp3), - dir=append(dir,tmp2); - mrk=append(mrk,tmp3); - , - dir=append(dir,"w2"); - mrk=append(mrk,tmp2); - ); - ); - ); - if(isreal(tmp2), - pos=append(pos,tmp2); - dir=append(dir,"w2"); - mrk=append(mrk,tmp3); - ); - ); - , - pos=vscale_(2..length(vscale)); - dir=apply(pos,"w1"); - mrk=apply(pos,text(#)); - ); - pos=apply(pos,[pA_1,#]); - forall(1..length(pos), - Expr([pos_#,dir_#,mrk_#]); - tmp1=pos_#; - tmp2=pos_#-[tick/SCALEX,0]; - Listplot("rsv"+text(#),[tmp1,tmp2],["Msg=no"]); - ); - ); -); - -MkprecommandR():=MkprecommandR(6); -MkprecommandR(prec):=( - regional(cmdL,Plist,tmp,tmp1,tmp2); - Plist=[]; - Pnamelist=[]; - Pvaluelist=[]; - forall(remove(allpoints(),[SW,NE]), - tmp=textformat(re(Lcrd(#)),prec); - tmp=RSform(tmp); - tmp1=#.name; - tmp1=tmp1+"="+tmp+";Assignadd('"+tmp1+"',"+tmp1+")"; - Plist=append(Plist,tmp1); - ); - cmdL=[]; - forall(1..(length(Plist)), - cmdL=concat(cmdL,[Plist_#,[]]); - ); - tmp2=sort(apply(VLIST,#_1)); // 16.02.03 from - tmp=apply(allpoints(),text(#));//18.02.11 - tmp2=remove(tmp2,tmp); - tmp1=[]; - forall(tmp2,tmp, - tmp1=concat(tmp1,select(VLIST,#_1==tmp)); - ); - VLIST=tmp1;// 17.09.24from - forall(VLIST, - tmp=#_1; - tmp1=#_2; - if(!isstring(tmp1), - if(islist(tmp1), - tmp2="["; - forall(tmp1, - tmp2=tmp2+textformat(#,6)+","; - ); - tmp1=substring(tmp2,0,length(tmp2)-1)+"]"; - , - tmp1=format(tmp1,6); - ); - ); - tmp1=RSform(tmp1); - tmp1=tmp+"="+tmp1+";"; - tmp1=tmp1+"Assignadd('"+tmp+"',"+tmp+")"; - cmdL=concat(cmdL,[tmp1,[]]);//17.09.24until - ); - forall(OutFileList, - cmdL=concat(cmdL,["tmp=ReadOutData",[Dq+#+Dq]]); - ); - forall(FUNLIST, - cmdL=concat(cmdL,[#,[]]); - ); - forall(GLIST, - if(indexof(#,"ReadOutData")==0, //18.02.12 - tmp1=Rform(#); - cmdL=concat(cmdL,[tmp1,[]]); - ); - ); - cmdL; -); - - -MkprecommandS():=MkprecommandS(6); -MkprecommandS(prec):=( - regional(cmdL,Plist,Pnamelist,Pvaluelist,tmp,tmp1,tmp2); - cmdL=[]; - Plist=[]; - Pnamelist=[]; - Pvaluelist=[]; - forall(remove(allpoints(),[SW,NE]), - tmp=Lcrd(#); - tmp1=format(re(tmp_1),prec);// 15.02.05 - tmp2=format(re(tmp_2),prec); - tmp="["+tmp1+","+tmp2+"]"; - Plist=append(Plist,#.name+"="+tmp); - Pnamelist=append(Pnamelist,#.name); - Pvaluelist=append(Pvaluelist,tmp); - ); - forall(1..length(Plist), - cmdL=concat(cmdL,[Plist_#,[]]); - cmdL=concat(cmdL,["Assignrep('"+Pnamelist_#+"',"+Pvaluelist_#+")",[]]); - ); - tmp2=sort(apply(VLIST,#_1)); // 16.02.03 from - tmp1=[]; - forall(tmp2,tmp, - tmp1=concat(tmp1,select(VLIST,#_1==tmp)); - ); - VLIST=tmp1;// 16.02.03 until - forall(VLIST, - tmp=Sciform(#_1); - tmp1=#_2; // 15.02.06 - if(!isstring(tmp1), - if(islist(tmp1), - if(!isstring(tmp1_1), // 16.11.14 - tmp2="["; - forall(tmp1, - if(abs(#)<10^(-prec), // 16.01.30 - tmp2=tmp2+"0,"; - , - tmp2=tmp2+format(#,prec)+","; - ); - ); - tmp1=substring(tmp2,0,length(tmp2)-1)+"]"; - , - tmp2="list("; // 16.11.14from - forall(tmp1, - tmp2=tmp2+#+","; - ); - tmp1=substring(tmp2,0,length(tmp2)-1)+")"; - ); // 16.11.14until - , - tmp1=format(tmp1,prec); - ); - ); - cmdL=concat(cmdL,[tmp+"evstr('"+tmp1+"')",[]]); - tmp=substring(tmp,0,length(tmp)-1); - cmdL=concat(cmdL,["Assignrep('"+tmp+"',"+tmp1+")",[]]); // 15.01.27 - ); - forall(OutFileList, - tmp=["tmp=ReadOutData",[Dq+#+Dq], - "if length(tmp(1))>8,execstr(tmp),end",[]]; - cmdL=concat(cmdL,tmp); - ); - forall(FUNLIST, // 16.02.17 from - cmdL=concat(cmdL,[#,[]]); - ); // 16.02.17 until - forall(GLIST, - tmp1=Sciform(#); - cmdL=concat(cmdL,[tmp1,[]]); - ); - cmdL; -); - -PlotdataS(name1,func,var):=PlotdataS(name1,func,var,[]); -PlotdataS(nm,fun,variable,optionorg):=( -//help:PlotdataS("1","besselj(1,x)","x"); -//help:PlotdataS(options=["m/r","Num=50","Wait=5","Mx=no"]); - regional(options,name,varstr,Num,waiting,mxcheck,outreg, - eqL,strL,fname,tmp,tmp1,tmp2,tmp3,cmdL,flg,wflg); - name="grsc"+nm; - fname=Fhead+name+".txt"; - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - strL=tmp_7; - Num=50; - waiting=5; - mxcheck=0; // 16.03.02 - outreg=0; - flg=0; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="N", - Num=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="O", - tmp=Toupper(substring(tmp2,0,1)); - if(tmp=="T" % tmp=="Y", outreg=1); - options=remove(options,[#]); - ); - if(tmp1=="M", - tmp=Toupper(substring(tmp2,0,1)); - if(tmp=="T" % tmp=="Y", mxcheck=1); - options=remove(options,[#]); - ); - ); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(length(#)==0, - options=remove(options,[#]); - ); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - tmp=indexof(variable,"="); - if(tmp>0, - varstr=variable; - , - varstr=variable+"="+textformat([XMIN,XMAX],5); - ); - cmdL=MkprecommandS(); - cmdL=concat(cmdL,[ - name+"=Plotdata",[Dq+fun+Dq,Dq+varstr+Dq,Dq+"Num="+text(Num)+Dq], - "WriteOutData",[Dq+fname+Dq,Dq+name+Dq,name] - ]); - ErrFlag=0; // 16.03.02 from - if(mxcheck==1, - Mxfun(name,fun,[],["Disp=n"]); - tmp=parse("mx"+name); - if(!isstring(tmp),ErrFlag=1); - ); - options=append(options,"Wait="+text(waiting)); - if(wflg==1,options=append(options,"m")); - if(wflg==-1,options=append(options,"r"));// 16.03.02 until - if(ErrFlag==0, - CalcbyS(name,cmdL,concat(options,["cat=middle","Wait="+text(waiting)])); - ); - if(ErrFlag==1, - println(" PlotdataS not completed"); - , - if(outreg==1, // 2016.03.02 ( // ) - OutFileList=remove(OutFileList,[wfile]); - OutFileList=append(OutFileList,wfile); - ); - ReadOutData(fname); - Extractdata(name,options); - tmp=parse(name); - tmp1=name+"="+textformat(tmp,5); - parse(tmp1); -// Addgraph(name); // 16.04.04 - tmp2=apply(tmp,Lcrd(#)); - tmp2; - ); -); - -Dotfilldata(nm,iostr,pltlist):= - Dotfilldata(nm,iostr,pltlist,[]); -Dotfilldata(nm,iostr,pltlist,optionorg):=( -//help:Dotfilldata("1","ii",[["sg1"],["sg2"]]); -//help:Dotfilldata(options=[0.3,"Wait=5"]); - regional(options,name,fun,eqL,reL,strL,outreg, - plt,fname,options,tmp,tmp1,tmp2,tmp3,flg, - wflg,waiting,dense); - name="df"+nm; - fname=Fhead+name+".txt"; - fun=fnorg; - tmp=indexof(fun,"="); - if(tmp>0, - tmp1=substring(fun,0,tmp-1); - tmp2=substring(fun,tmp,length(fun)); - fun=tmp1+"-("+tmp2+")"; - ); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - dense=0.3; - waiting=5; - outreg=0; - forall(reL, - dense=#; - ); - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="O", - tmp=Toupper(substring(tmp2,0,1)); - if(tmp=="T" % tmp=="Y", outreg=1); - options=remove(options,[#]); - ); - ); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(length(#)==0, - options=remove(options,[#]); - ); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - if(islist(iostr), - tmp1=text(apply(iostr,Dq+#+Dq)); - tmp1=replace(tmp1,"[","list("); //16.02.14 - tmp1=replace(tmp1,"]",")"); //16.02.14 - , - tmp1=Dq+iostr+Dq; - ); - if(!islist(pltlist_1), - tmp2=apply(pltlist,if(length(#)==1,Dq+#+Dq,#)); - tmp2=text(tmp2); - tmp2="list("+substring(tmp2,1,length(tmp2)-1)+"),"; - , - tmp2=""; - forall(pltlist,plt, - tmp=apply(plt,if(length(#)==1,Dq+#+Dq,#)); - tmp=text(tmp); - tmp="list("+substring(tmp,1,length(tmp)-1)+")"; - tmp2=tmp2+tmp+","; - ); - ); - cmdL=MkprecommandR(); //17.09.29 - tmp2=substring(tmp2,0,length(tmp2)-1); - tmp=[tmp1,tmp2]; - tmp=concat(tmp,dense); - cmdL=concat(cmdL,[ - "Setscaling",[SCALEY], - "Setunitlen",[Dq+ULEN+Dq], - name+"=Dotfilldata",tmp, - "WriteOutData",[Dq+fname+Dq,Dq+name+Dq,name], - ]); - options=append(options,"Wait="+text(waiting)); - if(wflg==1,options=concat(options,["m"])); - if(wflg==-1,options=concat(options,["r"])); - options=append(options,"Cat=n"); - if(ErrFlag==0, - CalcbyR(name,cmdL,options); //17.09.29 - ); - if(ErrFlag==1, - println("Dotfilldata not completed"); - , - if(outreg==1, - OutFileList=remove(OutFileList,[fname]); - OutFileList=append(OutFileList,fname); - ); - if(ErrFlag==0, - ReadOutData(fname); - tmp1=parse(name); - forall(tmp1, - tmp=#_1; - draw(tmp,pointsize->1); - ); - Com2nd("tmp=ReadOutData("+Dq+fname+Dq+")"); - Com2nd("Drwpt("+name+")"); - ); - ); -); - -WritetoA(fname,cmdL):=( -// help:WritetoA("outdata",cmdL); - regional(tmp,tmp1,tmp2,filename,wfilename,endmark); - if(indexof(fname,".")==0, - filename=fname+".rr"; - , - filename=fname; - ); - wfilename=replace(filename,".rr",".txt"); - SCEOUTPUT = openfile(filename); -// tmp=replace(Dirlib,"\","/"); -// tmp="load("+Dq+tmp+"/oshima/os_muldif.rr"+Dq+")$/*####*/"; - tmp="/*####*/"; // 16.03.11 - println(SCEOUTPUT,tmp); - tmp="output("+Dq+wfilename+Dq+")$/*##*/"; // 16.05.18from - println(SCEOUTPUT,tmp); // 16.05.18until - forall(1..(length(cmdL)), - tmp1=cmdL_#; - tmp=indexof(tmp1,";"); // 16.05.18from - if(tmp>0,endmark=";",endmark="$"); - tmp1=replace(tmp1,";",""); // 16.05.18until - if(#==length(cmdL)-1, - println(SCEOUTPUT,tmp1+";/*##*/"); - , - println(SCEOUTPUT,tmp1+endmark+"/*##*/");//16.05.18 - ); - ); - closefile(SCEOUTPUT); -); - -kcA(fname):=kcA(fname,[]); -kcA(fname,optionorg):=( -//help:kcA("boxdata"); -//help:kcA(options=["r/m"]); - regional(options,tmp,tmp1,tmp2,eqL,strL,filename,flg); - if(indexof(fname,".")==0, - filename=fname+".rr"; - , - filename=fname; - ); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - strL=tmp_7; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - ); - flg=0; - forall(strL, - if(Toupper(substring(#,0,1))=="R", - flg=0; - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="M", - flg=1; - ); - ); - if(flg==0, - tmp2=replace(filename,".rr",".txt"); - tmp1=load(tmp2); - if(length(tmp1)==0, - flg=1; - ); - ); - if(flg==1, - tmp1=""; - if(iswindows(), - tmp2=Batparent; - , - tmp2=Shellparent; - ); - flg=0; - forall(reverse(1..length(tmp2)), - if(flg==0, - tmp=substring(tmp2,#-1,#); - if(tmp=="/" % tmp=="\", // 14.01.15 - tmp1=substring(tmp2,0,#-1); - tmp2=substring(tmp2,#,length(tmp2)); - flg=1; - ); - ); - ); - if(length(tmp1)>0, - setdirectory(tmp1); - ); - if(iswindows(), - SCEOUTPUT = openfile("kc.bat"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp="del "+replace(filename,".rr",".txt"); - println(SCEOUTPUT,tmp); - tmp=Dq+PathA+Dq+" -quiet -f "+Dq+filename+Dq; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit"); - closefile(SCEOUTPUT); - tmp=replace(filename,".rr",".txt"); - println(kc(Dirwork+Batparent,Dirlib,tmp)); // 16.05.29,06.05 - , - SCEOUTPUT = openfile("kc.sh"); - println(SCEOUTPUT,"#!/bin/sh"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp="rm "+replace(filename,".rr",".txt"); - println(SCEOUTPUT,tmp); - tmp=Dq+PathA+Dq+" -quiet -f "+Dq+filename+Dq; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - tmp=replace(filename,".rr",".txt"); - println(kc(Dirwork+Shellparent,Mackc+Dirlib,tmp));// 16.05.29,06.05 - - ); -// wait(WaitUnit); - setdirectory(Dirwork); - ); -); - -CalcbyA(name,cmd):=CalcbyA(name,cmd,[]); -CalcbyA(name,cmd,optionorg):=( -//help:CalcbyA("a",cmd); -//help:CalcbyA(options= ["m/r","Wait=10","Ext=txt","Dig=16"]]); - regional(options,tmp,tmp1,tmp2,tmp3,tmp4,realL,strL,eqL, - dig,flg,wflg,file,nc,arg,cmdA,cmdlist,wfile,ext,waiting,num,st); - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - realL=tmp_6; - strL=tmp_7; - wfile=""; - ext=".txt"; - waiting=2; - dig=6; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="E", - if(indexof(tmp2,".")==0,ext="."+tmp2,ext=tmp2); - options=remove(options,[#]); - ); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="D", - dig=parse(tmp2); - options=remove(options,[#]); - ); - ); - wfile=Fhead+name+ext; - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - file=Fhead+name; - cmdA=cmd; - cmdlist=[]; - forall(1..floor(length(cmdA)/2),nc, //17.5.18 - tmp1=cmdA_(2*nc-1); - tmp1=replace(tmp1,LFmark,""); // 16.06.12 - if(nc==length(cmdA)/2, - tmp=indexof(tmp1,"="); - tmp1=substring(tmp1,tmp,length(tmp1)); - if(substring(tmp1,0,1)=="[", - tmp=substring(tmp1,0,length(tmp1)-1); - , - tmp="["+Dq+"/start/"+Dq+","+tmp1; // 16.05.18 - ); - tmp=replace(tmp,"::",","+Dq+"//"+Dq+","); - tmp1=tmp+","+Dq+"////"+Dq+"]"; - ); - tmp2=cmdA_(2*nc); // list of argments - tmp3=""; - tmp4=""; - forall(tmp2,arg, - if(isstring(arg), - tmp3=tmp3+replace(arg,"'",Dq)+","; -// tmp3=tmp3+arg; - , - if(!islist(arg), - tmp3=tmp3+textformat(arg,dig)+","; - , - tmp3=tmp3+"["; - tmp4="]"; - forall(arg, - if(isstring(#), -// tmp3=tmp3+Dq+#+Dq+","; - tmp=replace(#,"'",Dq); -// tmp=#;// 2016.03.03 - tmp3=tmp3+tmp+","; - , - if(!islist(#), - tmp3=tmp3+textformat(#,dig)+","; - , - tmp=textformat(#,dig); - tmp=replace(tmp,"],[","];["); - tmp3=tmp3+tmp+","; - ); - ); - ); - tmp3=substring(tmp3,0,length(tmp3)-1)+tmp4+","; - ); - ); - ); - if(length(tmp3)>0, - tmp3=substring(tmp3,0,length(tmp3)-1); - tmp1=tmp1+"("+tmp3+")"; - ); - cmdlist=append(cmdlist,tmp1); - ); - cmdlist=append(cmdlist,"quit"); - if(wflg==0, - tmp1=load(file+".rr"); - if((length(tmp1)==0) % (indexof(tmp1,"/*####*/")==0), //15.11.26 - wflg=1; - , - tmp1=tokenize(tmp1,"/*####*/"); - tmp1=tokenize(tmp1_2,"/*##*/"); - tmp1=tmp1_(1..(length(tmp1)-1)); - tmp=select(tmp1,indexof(#,"output")>0); - tmp1=remove(tmp1,tmp); - tmp1=apply(tmp1,substring(#,0,length(#)-1)); - if(length(tmp1)!=length(cmdlist), // 15.12.06 - wflg=1; - , - tmp=select(1..length(tmp1),tmp1_#!=cmdlist_#); - if(length(tmp)>0, wflg=1); - ); - ); - ); - if(wflg==0,wflg=-1); // 15.10.16 - if(wflg==1, - if(length(wfile)>0, // 15.10.05 - SCEOUTPUT=openfile(wfile); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - ); - WritetoA(file+".rr",cmdlist); - kcA(file,concat(options,["m"])); - ); - flg=0; - tmp1=floor(waiting*1000/WaitUnit); - repeat(tmp1, - if(flg==0, - tmp=load(wfile); - if(length(tmp)>=4, - tmp2=substring(tmp,length(tmp)-5,length(tmp)); - if(tmp2=="////]", - tmp=substring(tmp,1,length(tmp)-6); - num="1234567890+-."; - tmp1=tokenize(","+tmp,",//"); - tmp3=apply(tmp1,substring(#,1,length(#))); - tmp1="["; - forall(tmp3,st, - tmp=select(1..length(st),indexof(num,substring(st,#-1,#))==0); - if((length(tmp)==0) & (length(st)<4), // 16.05.10 16=>4 - tmp1=tmp1+st+","; - , - tmp1=tmp1+Dq+st+Dq+","; - ); - ); - tmp=Indexof(tmp1,"/start/,"); // 16.05.18from - tmp1="["+Dq+substring(tmp1,tmp+7,length(tmp1)-1)+"]"; - // 16.05.18until -// tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; - parse(name+"="+tmp1); - tmp=parse(name); - if(length(tmp)==1, - tmp1=substring(tmp1,1,length(tmp1)-1); - parse(name+"="+tmp1); - ); - flg=1; - tmp2=#*WaitUnit/1000; - ); - , - if(wflg==-1, - flg=-1; - , - wait(WaitUnit); - ); - ); - ); - ); - if(flg<=0, - ErrFlag=1; - if(flg==-1, - println(wfile+" does not exist"); - , - tmp="("+text(waiting)+" s )"; - println(wfile+" not generated "+tmp); - ); - , - println(" CalcbyA succeeded "+name+" ("+text(tmp2)+" sec)"); - ); -); - -AsfunO(name,fun,argL):=AsirfunO(name,fun,argL); // 16.02.03 -AsfunO(name,fun,argL,options):=AsirfunO(name,fun,argL,options); -Asfun(name,fun,argL):=Asirfun(name,fun,argL); -Asfun(name,fun,argL,optionorg):=Asirfun(name,fun,argL,optionorg); -AsirfunO(name,fun,argL):=AsirfunO(name,fun,argL,[]); -AsirfunO(name,fun,argLorg,options):=( -//help:AsirfunO("an1","fint",["1/(x^2+1)",32,"['-','+']"]); - regional(argL,tmp,tmp1,tmp2,eqL);// 16.05.26from - tmp=divoptions(options); - eqL=tmp_5; - argL=argLorg; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,3)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="PRO", // 16.05.26from - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="T") % (tmp=="Y"), - tmp1=argL_(length(argL)); - tmp=indexof(tmp1,"|"); - if(tmp==0, - argL_(length(argL))=tmp1+"|dumb=-1,dviout=-2"; - ); - ); - ); - ); // 16.05.26until - Asirfun(name,"os_md."+fun,argL,options); -); -Asirfun(name,fun,argL):=Asirfun(name,fun,argL,[]); -Asirfun(name,fun,argL,optionorg):=( -//help:Asirfun("al1","2*(3+5^4)",[],[""]); - regional(nm,options,eqL,precise,disp,process, - cmdL,tmp,tmp1,tmp2,tmp3,tmp4,out,out2); - nm="as"+name; - options=optionorg; - tmp=divoptions(options); - precise=6; - disp=1; - process=0; - eqL=tmp_5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,3)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="PRE", - precise=parse(tmp2); - options=remove(options,[#]); - ); - if((tmp1=="DIS") % (tmp1=="DSP"), - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="F") % (tmp=="N"), - disp=0; - ); - options=remove(options,[#]); - ); - if(tmp1=="PRO", // 16.05.26from - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="T") % (tmp=="Y"), - process=1; - ); - options=remove(options,[#]); - ); // 16.05.26upt - ); - tmp=replace(Dirlib,"\","/"); - cmdL=[ - "load",[Dq+tmp+"/oshima/os_muldif.rr"+Dq], // 16.03.11 - "ctrl",[Dq+"real_digit"+Dq,precise], - "A="+fun,argL, // 16.05.26from - "A",[] - ]; - CalcbyA(nm,cmdL,options); - out=parse(nm); //16.05.26from - if(process==1, - tmp1=Bracket(out,"[]"); - tmp2=select(tmp1,abs(#_2)==2); - tmp2=apply(tmp2,#_1); - out=[]; - forall(1..length(tmp2)/2, - tmp3=tmp2_(2*#-1); - tmp4=tmp2_(2*#); - tmp=substring(as1,tmp3+1,tmp4-2); - tmp=tokenize(tmp,"],["); - out=append(out,tmp); - ); - out2=[]; - forall(out,tmp2, - tmp4=""; - forall(tmp2,tmp3, - tmp1=tokenize(tmp3,","); - if(tmp1_1==0, - tmp4=tmp4+tmp1_2+"="+tmp1_3+"+"; - , - if(tmp1_1==1, - tmp4=tmp4+tmp1_2+"+"; - , - tmp="'integrate("; - forall(2..length(tmp1), - tmp=tmp+tmp1_#+"+"; - ); - tmp=substring(tmp,0,length(tmp)-1); - tmp=tmp+","+tmp1_1+")"; - tmp4=tmp4+tmp+"+"; - ); - ); - ); - tmp4=substring(tmp4,0,length(tmp4)-1); - out2=append(out2,tmp4); - ); - out=out2; - tmp=apply(out,Dq+#+Dq); - parse(nm+"="+tmp); - ); - if(ErrFlag==0, - if(disp==1, // 15.11.24 - println(nm+" is : "); - println(parse(nm)); - ); - ); - out; //16.05.26until -); - -WritetoM(fname,cmdL,allflg):=( -// help:WritetoM("outdata",cmdL); - regional(tmp,tmp1,tmp2,filename,wfilename,outflg); - if(indexof(fname,".")==0, - filename=fname+".max"; - , - filename=fname; - ); - wfilename=replace(filename,".max",".txt"); - SCEOUTPUT = openfile(filename); - outflg=0; - forall(1..(length(cmdL)), - tmp1=cmdL_#; - - if(allflg==1, // 2016.02.23 from - if(#==1, - tmp="writefile("+Dq+Dirwork+"/"+wfilename+Dq+")$/*##*/"; - tmp=replace(tmp,"\","/"); - println(SCEOUTPUT,tmp); - outflg=1; - println(SCEOUTPUT,tmp1+"$/*##*/"); - , - println(SCEOUTPUT,tmp1+"$/*##*/"); - ); - , - if((indexof(tmp1,"disp(")>0) & (outflg==0), - tmp="writefile("+Dq+Dirwork+"/"+wfilename+Dq+")$/*##*/"; - tmp=replace(tmp,"\","/"); - println(SCEOUTPUT,tmp); - outflg=1; - println(SCEOUTPUT,tmp1+"$/*##*/"); - , - println(SCEOUTPUT,tmp1+"$/*##*/"); - ); - ); - ); - closefile(SCEOUTPUT); -); - -kcM(fname):=kcM(fname,[]); -kcM(fname,optionorg):=( -//help:kcM("boxdata"); -//help:kcM(options=["r/m"]); - regional(options,tmp,tmp1,tmp2,eqL,strL,filename,flg); - if(indexof(fname,".")==0, - filename=fname+".max"; - , - filename=fname; - ); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - strL=tmp_7; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - ); - flg=0; - forall(strL, - if(Toupper(substring(#,0,1))=="R", - flg=0; - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="M", - flg=1; - ); - ); - if(flg==0, - tmp2=replace(filename,".max",".txt"); - tmp1=load(tmp2); - if(length(tmp1)==0, - flg=1; - ); - ); - if(flg==1, - tmp1=""; - if(iswindows(), - tmp2=Batparent; - , - tmp2=Shellparent; - ); - flg=0; - forall(reverse(1..length(tmp2)), - if(flg==0, - tmp=substring(tmp2,#-1,#); - if(tmp=="/" % tmp=="\", // 14.01.15 - tmp1=substring(tmp2,0,#-1); - tmp2=substring(tmp2,#,length(tmp2)); - flg=1; - ); - ); - ); - if(length(tmp1)>0, - setdirectory(tmp1); - ); - if(iswindows(), - SCEOUTPUT=openfile(replace(filename,".max",".txt")); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - SCEOUTPUT = openfile("kc.bat"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); -// tmp="del "+replace(filename,".max",".txt"); -// println(SCEOUTPUT,tmp); - tmp=Indexall(PathM,"."); - tmp=substring(PathM,tmp_1,tmp_2-1); - tmp=parse(tmp); - if(tmp<39, - tmp="call "+Dq+Dq+PathM+Dq+Dq+" -b "+Dq+filename+Dq; - , - tmp="call "+Dq+PathM+Dq+" -b "+Dq+filename+Dq; - ); -// tmp="cmd/c "+Dq+PathM+" -b "+filename+Dq; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit"); - closefile(SCEOUTPUT); - tmp=replace(filename,".max",".txt"); - println(kc(Dirwork+Batparent,Mackc+Dirlib,tmp));// 16.05.29,06.05 - , - SCEOUTPUT = openfile("kc.sh"); - println(SCEOUTPUT,"#!/bin/sh"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp="rm "+replace(filename,".max",".txt"); - println(SCEOUTPUT,tmp); - tmp=Dq+PathM+Dq+" -b "+Dq+filename+Dq; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - tmp=replace(filename,".max",".txt"); - println(kc(Dirwork+Shellparent,Mackc+Dirlib,tmp));// 16.05.29,06.05 - ); -// wait(WaitUnit); - setdirectory(Dirwork); - ); -); - -CalcbyM(name,cmd):=CalcbyM(name,cmd,[]); -CalcbyM(name,cmd,optionorg):=( -//help:CalcbyM("a",cmdL); -//help:CalcbyM(options1= ["m/r","Wait=5","Ext=txt","Dig=6","Pow=no","All=y"]); -//help:CalcbyM(options2= ["line=1000"]); - regional(options,tmp,tmp0,tmp1,tmp2,tmp3,tmp4,realL,strL,eqL,allflg,indL,line, - dig,flg,wflg,file,nc,arg,add,powerd,cmdM,cmdlist,wfile,ext,waiting,num,st); - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - realL=tmp_6; - strL=tmp_7; - wfile=""; - ext=".txt"; - waiting=5; - dig=6; - allflg=1; - powerd="false"; - line=1000; // 16.06.13 - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="E", - if(indexof(tmp2,".")==0,ext="."+tmp2,ext=tmp2); - options=remove(options,[#]); - ); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="D", - dig=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="L", // 16.06.13 - line=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="P", - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="y") % (tmp=="F"),powerd="true"); - options=remove(options,[#]); - ); - if(tmp1=="A", // 2016.02.23 - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="N") % (tmp=="F"),allflg=0); - options=remove(options,[#]); - ); - ); - wfile=Fhead+name+ext; - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - file=Fhead+name; - cmdM=cmd; - cmdlist=[ - "powerdisp:"+powerd,"display2d:false","linel:"+text(line) //15.11.25,16.06.13 - ]; - forall(1..floor(length(cmdM)/2),nc, //17.5.18 - tmp1=replace(cmdM_(2*nc-1),"`","'");//2016.02.23 - tmp1=replace(tmp1,LFmark,""); // 16.06.12 - if(nc==length(cmdM)/2, - tmp=indexof(tmp1,"="); - tmp1=substring(tmp1,tmp,length(tmp1)); - if(substring(tmp1,0,1)=="[", - tmp=substring(tmp1,0,length(tmp1)-1); - , - tmp="["+tmp1; - ); - tmp2=""; - forall(1..length(tmp1), - if(substring(tmp1,#-1,#+1)=="::", - if(substring(tmp2,0,1)==":", tmp2=substring(tmp2,1,length(tmp2))); - cmdlist=append(cmdlist,"disp("+tmp2+")"); - tmp2=""; - , - tmp2=tmp2+substring(tmp1,#-1,#); - ); - ); - if(length(tmp2)>0, - if(substring(tmp2,0,1)==":", tmp2=substring(tmp2,1,length(tmp2))); - cmdlist=append(cmdlist,"disp("+tmp2+")"); - ); - , - tmp2=cmdM_(2*nc); // list of argments - tmp3=""; - tmp4=""; - add=""; - forall(tmp2,arg, - if(isstring(arg), - if(substring(arg,0,1)!=",", -// tmp=replace(arg,"'",Dq); // 16.03.03 - tmp=arg; // 16.03.03 - tmp=replace(tmp,"`","'");// 2016.02.23 - tmp3=tmp3+tmp+","; - , - add=add+arg; - ); - , - if(!islist(arg), - tmp3=tmp3+textformat(arg,dig)+","; - , - tmp3=tmp3+"["; - tmp4="]"; - forall(arg, - if(isstring(#), -// tmp3=tmp3+Dq+#+Dq+","; - tmp=replace(#,"'",Dq); - tmp3=tmp3+tmp+","; - , - if(!islist(#), - tmp3=tmp3+textformat(#,dig)+","; - , - tmp=textformat(#,dig); - tmp=replace(tmp,"],[","];["); - tmp3=tmp3+tmp+","; - ); - ); - ); - tmp3=substring(tmp3,0,length(tmp3)-1)+tmp4+","; - ); - ); - ); - if(length(tmp3)>0, - tmp3=substring(tmp3,0,length(tmp3)-1); - tmp1=tmp1+"("+tmp3+")"+add; - ); - cmdlist=append(cmdlist,tmp1); - ); - ); - cmdlist=append(cmdlist,"closefile()"); - cmdlist=append(cmdlist,"quit()"); - if(wflg==0, - tmp1=load(file+".max"); - if(length(tmp1)==0, - wflg=1; - , - if(indexof(tmp1,"/*##*/")==0, // 15.11.26 - wflg=1; - , - tmp1=tokenize(tmp1,"/*##*/"); - tmp1=tmp1_(1..(length(tmp1)-1)); - tmp=select(tmp1,indexof(#,"writefile")>0); - tmp1=remove(tmp1,tmp); - tmp1=apply(tmp1,substring(#,0,length(#)-1)); - if(length(tmp1)!=length(cmdlist), // 15.12.07 - wflg=1; - , - tmp=select(1..length(tmp1),tmp1_#!=cmdlist_#); - if(length(tmp)>0, wflg=1); - ); - ); - ); - ); - if(wflg==0,wflg=-1); // 15.10.16 - if(wflg==1, - if(length(wfile)>0, // 15.10.05 - SCEOUTPUT=openfile(wfile); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - ); - WritetoM(file+".max",cmdlist,allflg); // 2016.02.23 - kcM(file,concat(options,["m"])); - ); - flg=0; - tmp1=floor(waiting*1000/WaitUnit); - repeat(tmp1, - if(flg==0, - tmp1=load(wfile); - if(wflg==1,wait(WaitUnit)); // 2016.02.23 - if(length(tmp1)>0, - tmp=indexof(tmp1,"error")+indexof(tmp1,"syntax"); //2016.02.23 - if(tmp>0, - println("Some error(s) occurred"); //2016.02.24 from - tmp2=tokenize(tmp1,"(%"); - forall(4..length(tmp2),println(tmp2_#)); //2016.02.24 until - flg=2; //2016.02.23 - , - if(indexof(tmp1,"closefile()")>0, // 15.11.24 - tmp=tokenize(tmp1,"disp("); - tmp1=tmp_(2..length(tmp)); - tmp4=[]; - forall(tmp1,tmp2, - tmp=indexof(tmp2,")"); - tmp3=substring(tmp2,tmp,length(tmp2)); - indL=Indexall(tmp3,"(%i"); // 16.04.26from - tmp0=0; - forall(indL, - if(tmp0==0, - tmp=substring(tmp3,#+2,#+3); - if(indexof("0123456789",tmp)>0,//16.04.25? - tmp3=removespace(substring(tmp3,0,#-1)); - tmp4=append(tmp4,tmp3); - tmp0=1; - ); - );// 16.04.26until - ); - ); - num="1234567890+-."; - tmp1="["; - forall(tmp4,st, - tmp=select(1..length(st),indexof(num,substring(st,#-1,#))==0); - if((length(tmp)==0) & (length(st)<4), // 16.05.10 16=>4 - tmp1=tmp1+st+","; - , - tmp1=tmp1+Dq+st+Dq+","; - ); - ); - tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; - tmp1=replace(tmp1,".d+0",""); // 15.11.23 - parse(name+"="+tmp1); - tmp=parse(name); - if(length(tmp)==1, - tmp1=substring(tmp1,1,length(tmp1)-1); - parse(name+"="+tmp1); - ); - flg=1; - tmp2=#*WaitUnit/1000; - ); - ); - , - if(wflg==-1, - flg=-1; - , - wait(WaitUnit); - ); - ); - ); - ); - if(flg<=0, - ErrFlag=1; - if(flg==-1, - println(wfile+" does not exist"); - , - tmp="("+text(waiting)+" s )"; - tmp1=load(wfile); - if(length(tmp1)>0, - println(wfile+" incomplete"+tmp); // 2016.02.24 - , - println(wfile+" not generated "+tmp); - ); - ); - , - if(flg==1, // 2016.02.23 - println(" CalcbyM succeeded "+name+" ("+text(tmp2)+" sec)"); - ); - ); -); - -Mxfun(name,fun,argL):=Mxfun(name,fun,argL,[]); -Mxfun(name,fun,argL,optionorg):=( -//help:Mxfun("ca1","diff",["sin(x)^3","x"],[""]); -//help:Mxfun(options=["Pre=6","Disp=y","Load= :: ","Set=::","Add="]); - regional(nm,options,eqL,precise,disp,pack,set,add,cmdL,tmp,tmp1,tmp2); - nm="mx"+name; - options=optionorg; - tmp=divoptions(options); - precise=6; - disp=1; - pack=[]; - set=[]; - add=""; - eqL=tmp_5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,3)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="PRE", - precise=parse(tmp2); - options=remove(options,[#]); - ); - if((tmp1=="DIS") % (tmp1=="DSP") , - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="F") % (tmp=="N"), - disp=0; - ); - options=remove(options,[#]); - ); - if((tmp1=="PAC") % (tmp1=="LOA"), // 16.02.08 - pack=tokenize(tmp2,"::"); - options=remove(options,[#]); - ); - if(tmp1=="SET", - set=tokenize(tmp2,"::"); - options=remove(options,[#]); - ); - if(tmp1=="ADD", - add=","+tmp2; - options=remove(options,[#]); - ); - ); - cmdL=[]; - forall(pack, - cmdL=concat(cmdL,["load",[#]]); - ); - forall(set, - cmdL=concat(cmdL,[#,[]]); - ); - if(length(add)>0, - tmp=append(argL,add); - , - tmp=argL; - ); - cmdL=concat(cmdL,[ - "ans"+":"+fun,tmp, - "ans",[] - ]); - CalcbyM(nm,cmdL,options); - if(ErrFlag==0, - if(disp==1, // 15.11.24 - println(nm+" is : "); - println(parse(nm)); - ); - ); - parse(nm); -); - -Mxtex(nm,ex):=Mxtex(nm,ex,[]); -Mxtex(nm,ex,optionorg):=( -//help:Mxtex("1","sin(x)/x"); -//help:Mxtex(options=["Disp=y"]); - regional(name,cmdL,eqL,options,tx,disp,out,set, - tmp,tmp1,tmp2); // 16.01.25 - name="tx"+nm; - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - disp=1; - set=[]; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,3)); - tmp2=substring(#,tmp,length(#)); - if((tmp1=="DIS") % (tmp1=="DSP") , - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="F") % (tmp=="N"), - disp=0; - ); - options=remove(options,[#]); - ); - if(tmp1=="SET", // 16.03.01 - set=tokenize(tmp2,"::"); - options=remove(options,[#]); - ); - if(tmp1=="ORD", // 16.03.01 - tmp="ordergreat("+tmp2+")"; - set=append(set,tmp); - options=remove(options,[#]); - ); - ); - cmdL=[ - "load",[Dq+"mactex-utilities.lisp"+Dq]]; // 16.03.03 - forall(set, // 16.03.01 - cmdL=concat(cmdL,[#,[]]); - ); - cmdL=concat(cmdL,[ - name+":disp(tex("+ex+"))",[], // 16.01.18 - name,[] // 16.01.18 - ]); - CalcbyM(name,cmdL,options); // 16.02.19 - tx=parse(name); - if(islist(tx), // 16.01.10 - out=tx_1; - , - out=tx; - ); - tmp=indexof(out,"$$")+1; - out=substring(out,tmp,length(out)); - tmp=indexof(out,"$$")-1; - out=substring(out,0,tmp); - if(disp==1, // 16.01.10 - println(name+" is:"); - println(out); - ); - tmp=name+"="+Dq+out+Dq; //16.01.10 - parse(tmp); - out; -); - -MxtexL(nm,exlist):=MxtexL(nm,exlist,[]); // 16.05.27 -MxtexL(nm,exlist,options):=( - regional(out,tmp,tmp1); - out=[]; - forall(1..length(exlist), - tmp=Mxtex(nm+"n"+text(#),exlist_#,["Disp=n"]); - out=append(out,Dq+tmp+Dq); - ); - tmp="tx"+nm+"="+out; - parse(tmp); - println("tx"+nm+"is:"); - apply(out,println(#)); - out; -); - -Mxbatch(file):=( -//help:Mxbatch(["matoperation.max"]); - regional(figL,out,path,tmp,tmp1,tmp2); - if(!islist(file),figL=[file],figL=file); - path=replace(Dirlib+"/maximaL/","\","/"); - out=[]; - forall(figL, - if(indexof(#,".")==0,tmp1=#+".max",tmp1=#); - tmp1=Dq+path+tmp1+Dq; - tmp2=["batch",[tmp1]]; - out=concat(out,tmp2); - ); - out; -); - -Mxload(file):=( //17.06.16 -//help:Mxload(["rkfun.lispp"]); - regional(figL,out,path,tmp,tmp1,tmp2); - if(!islist(file),figL=[file],figL=file); - path=replace(Dirlib+"/maximaL/","\","/"); - out=[]; - forall(figL, - if(indexof(#,".")==0,tmp1=#+".lisp",tmp1=#); - tmp1=Dq+path+tmp1+Dq; - tmp2=["load",[tmp1]]; - out=concat(out,tmp2); - ); - out; -); - -Maxima2Cindydata(str):=( //17.10.24 - regional(out,numstr,eL,nn,ne,flg,tmp); - numstr="-0123456789"; - eL=Indexall(str,"e"); - if(length(eL)==0, - out=str; - , - out=substring(str,0,eL_1-1); - forall(1..(length(eL)),nn, - ne=eL_nn; - flg=0; - forall(1..5, - if(flg==0, - tmp=substring(str,ne+#-1,ne+#); - if(indexof(numstr,tmp)==0, - flg=#; - tmp=substring(str,ne,ne+flg-1); - out=out+"*10^("+tmp+")"; - ); - ); - ); - if(nn<length(eL), - out=out+substring(str,ne+flg-1,eL_(nn+1)-1); - , - out=out+substring(str,ne+flg-1,length(str)); - ); - ); - ); - parse(out); -); - -kcV3(fname):=kcV3(Dirwork,fname); -kcV3(path,fname):=( -//help:kcV3(path,"ex.obj"); - regional(tmp,tmp1,tmp2,eqL,strL,filename,flg); - if(indexof(fname,".")==0, - filename=fname+".obj"; - , - filename=fname; - ); - flg=1; - if(flg==1, - tmp1=""; // 15.10.08 from - if(iswindows(), - tmp2=Batparent; - , - tmp2=Shellparent; - ); - tmp=replace(path,"\","/"); - tmp=substring(tmp,length(tmp)-1,length(tmp)); - if(tmp=="/" % tmp=="\", tmp1=path, tmp1=path+"/"); - if(iswindows(), - SCEOUTPUT = openfile("kc.bat"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp=Dq+PathV3+Dq+" "+tmp1+filename; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit"); - closefile(SCEOUTPUT); - println(kc(Dirwork+Batparent,Dirlib,Fnametex));// 16.05.29,06.05 - , - SCEOUTPUT = openfile("kc.sh"); - println(SCEOUTPUT,"#!/bin/sh"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp=Dq+PathV3+Dq+" "+tmp1+filename; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - println(kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex));// 16.05.29,06.05 - ); - wait(WaitUnit); - ); - if(fig==2, - println("Obj file not exist / imperfect"); - ); -); - -Changeobjscale(fname):=( - regional(fout); - fout=replace(fname,".obj",""); - fout=fout+"out.obj"; - Changeobjscale(ULEN,fname,fout,[]); -); -Changeobjscale(fname,Arg):=( - regional(fout); - if(islist(Arg), - fout=replace(fname,".obj",""); - fout=fout+"out.obj"; - Changeobjscale(ULEN,fname,fout,Arg); - , - Changeobjscale(ULEN,fname,Arg,[]); - ); -); -Changeobjscale(Arg1,Arg2,Arg3):=( - if(islist(Arg3), - Changeobjscale(ULEN,Arg1,Arg2,Arg3); - , - Changeobjscale(Arg1,Arg2,Arg3,[]); - ); -); -Changeobjscale(unitlen,fnameorg,foutorg,optionorg):=( -//help:Changeobjscale("20mm",fname,fnameout); -//help:Changeobjscale(options=["Unit=mm",[0,0,0]]); - regional(fname,fout,fmd,unit,val,options,eqL,reL, - origin,outunit,sc,stL,nn,tmp,tmp1,tmp2); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - outunit="IN"; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=Toupper(substring(#,tmp,length(#))); - if(tmp1=="O" % tmp1=="U", - outunit=tmp2; - options=remove(options,[#]); - ); - ); - options=remove(options,reL); - origin=[0,0,0]; - forall(reL, - if(islist(#),origin=#); - ); - options=remove(options,reL); - tmp1=".0123456789+-*/"; - unit=""; - val=1; - tmp2=0; - forall(reverse(1..length(unitlen)), - tmp=substring(unitlen,#-1,#); - if(tmp2==0, - if(indexof(tmp1,tmp)>0, - tmp2=#; - ); - ); - unit=substring(unitlen,tmp2,length(unitlen)); - unit=removespace(unit); - val=parse(substring(unitlen,0,tmp2)); - ); - sc=1; - if(unit=="cm",sc=1); - if(unit=="mm",sc=0.1); - if(unit=="in",sc=2.54); - sc=sc*val; - if(outunit=="IN",sc=sc/2.54); - if(outunit=="MM",sc=sc*10); - fname=fnameorg; - if(indexof(fname,".")==0,fname=fname+".obj"); - fmd=replace(fname,".obj",".txt"); - fout=foutorg; - if(indexof(fout,".")==0,fout=fout+".obj"); - tmp1=Textformat(origin,4); - tmp1=RSform(tmp1); - cmdL=[ - "Origin="+tmp1,[], - "Sc="+format(sc,6),[], - "Stv=readLines",[Dq+fname+Dq], - "cat('',file="+Dq+fout+Dq+")",[], - "for(nn in Looprange(1,length(Stv))){",[], - " if(substring(Stv[nn],1,2)=='v '){",[], - " Tmp1=paste('c(',substring(Stv[nn],3),')',sep='')",[], - " Tmp1=gsub(' ',',',Tmp1,fixed=TRUE)",[], - " Tmp1=gsub(',,',',',Tmp1,fixed=TRUE)",[], - " Tmp1=gsub('(,','(',Tmp1,fixed=TRUE)",[], - " Tmp=eval(parse(text=Tmp1))",[], - " Tmp=Origin+Sc*(Tmp-Origin)",[], - " Stv[nn]=paste('v ',sprintf('%8.5f %8.5f %8.5f',Tmp[1],Tmp[2],Tmp[3]),sep='')",[], - " }",[], - " cat(Stv[nn],'\n',sep='',file="+Dq+fout+Dq+",append=TRUE)",[], - "}",[] - ]; - options=concat(["Wait=3","Cat=n","File="+fmd],options); // 16.06.26 - CalcbyR("cs",cmdL,options); - println("Scale of "+fname+" changed"); -); - -Mkviewobj(fname,cmdL):=Mkviewobj(Dirwork,fname,cmdL,[]); -Mkviewobj(Arg1,Arg2,Arg3):=( - if(!isstring(OCNAME), //17.04.13from - drawtext(mouse().xy,"Mkobjcmd not defined", - size->24,color->[1,0,0]); - , //17.04.13until - if(islist(Arg2), - Mkviewobj(Dirwork,Arg1,Arg2,Arg3); - , - Mkviewobj(Arg1,Arg2,Arg3,[]); - ); - ); -); -Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=( -//help:Mkviewobj(fname,cmdlist); -//help:Mkviewobj(fname,[]); -//help:Mkviewobj(path,fname,cmdlist); -//help:Mkviewobj(options=["M/R","V","Unit=in","Wait=5"]); - regional(path,cmdL,eqL,strL,flg,fname,options,make,view,cmdlist, - vtx,face,unit,tmp,tmp1,tmp2); - path=replace(pathorg,"\","/"); - if(substring(path,length(path)-1,length(path))!="/",path=path+"/"); - fname=fnameorg; - if(indexof(fname,".")==0,fname=fname+".obj"); - cmdL=cmdLorg; - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - strL=tmp_7; - make=-1; - view=0; - unit=""; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="M", - tmp2=Toupper(substring(tmp2,0,1)); - if(tmp2=="N" % tmp2=="F", - make=0; - ); - options=remove(options,[#]); - ); - if(tmp1=="V", - tmp2=Toupper(substring(tmp2,0,1)); - if(tmp2=="N" % tmp2=="F", - view=0; - ); - options=remove(options,[#]); - ); - if(tmp1=="U", // 16.06.30from - unit=tmp2; - options=remove(options,[#]); - ); // 16.06.30until - ); - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - make=1; - options=remove(options,[#]); - ); - if(tmp=="R", - make=0; - options=remove(options,[#]); - ); - if(tmp=="V", - view=1; - options=remove(options,[#]); - ); - ); - if(islist(cmdL), - if(length(cmdL)==0, - make=0; - println("Command sequence not defnamed"); - ); - , - make=0; - println("Command sequence not defined"); - ); - if(make==-1, - setdirectory(pathorg); - tmp1=load(fname); - if(length(tmp1)==0,make=1,make=0); - setdirectory(Dirwork); - ); - if(make==1, - if(isstring(cmdL_1), - cmdlist=MkprecommandR(); - cmdlist=concat(cmdlist,["Openobj",[Dq+path+fname+Dq]]); - cmdlist=concat(cmdlist,cmdL); - tmp=["Closeobj()",[],"ans="+Dq+"||||"+Dq,[]];//16.12.26 - cmdlist=concat(cmdlist,tmp); - tmp=append(options,"Cat=y"); - tmp1=apply(tmp,Toupper(substring(#,0,1))); // 16.04.23from - tmp1=select(tmp1,#=="W"); - if(length(tmp1)==0, - tmp=append(tmp,"Wait=5"); - );// 16.04.23until - CalcbyR("ans",cmdlist,tmp); - wait(WaitUnit*100); // 16.03.18 - , - vtx=cmdL_1; - face=cmdL_2; - setdirectory(pathorg); - SCEOUTPUT = openfile(fname); - forall(vtx,tmp1, - tmp2=tmp1; - if(ispoint(tmp1), - tmp2=parse(text(tmp1)+"3d"); - ); - tmp2=apply(tmp2,format(#,5)); - tmp="v "+tmp2_1+" "+tmp2_2+" "+tmp2_3; - println(SCEOUTPUT,tmp); - ); - forall(face,tmp1, - tmp="f"; - forall(tmp1, - tmp=tmp+" "+text(#); - ); - println(SCEOUTPUT,tmp); - ); - closefile(SCEOUTPUT); - setdirectory(Dirwork); - ); - ); - if(length(unit)>0, // 16.06.30from - Changeobjscale(fname,["Unit="+unit]);//16.10.04 - ); // 16.06.30until - if(view==1, - flg=0; // 16.03.14 from - if(isstring(ViewFile), - if(ViewFile==fname,flg=1); - ); - if(flg==0, - kcV3(path,fname); - ViewFile=fname; - ); // 16.03.14 until - ); -); - -SetObj(str):=Objname(str,["m","v"]); //17.01.12 -SetObj(str,options):=Objname(str,options); //17.01.12 -Objnameoptions(str,options):=Objname(str,options);// 16.11.29 -Objname(str):=Objname(str,["m","v"]); // 16.11.29 -Objname(str,optionsorg):=( -//help:Objname("sample"); -//help:Objname(options=["m","v"]); -//help:Setobj("sample"); -//help:Setobj(options=["m","v"]); - regional(options); - if(length(str)>0, - OCNAME=str; - ); - options=select(optionsorg,length(#)>0); //17.12.23from - if(length(options)>0, - OCOPTION=options; - , - OCOPTION=["m","v"]; - ); //17.12.23until - println([OCNAME,OCOPTION]); -); - -Mkobjcmd(nm,fd):=Mkobjcmd(nm,fd,[40,40,"+"]); -Mkobjcmd(nm,fd,options):=( -//help:Mkobjcmd("1",fd,[40,40,"+"]); - regional(ffd,cmd,out,div1,div2,side, - reL,stL,tmp,tmp1,tmp2,tmp3,tmp4); - div1=40; - div2=40; - side="+"; - tmp=Divoptions(options); - reL=tmp_6; - stL=select(tmp_7,length(#)>0); - forall(1..length(reL), - if(#==1, - div1=reL_1; - div2=div1; - , - div2=reL_2; - ); - ); - forall(stL, - side=#; - ); - side="'"+side+"'"; - ffd=Fullformfunc(fd); - tmp=indexof(ffd_5,"="); - tmp1=RSform(substring(ffd_5,0,tmp-1)); - tmp2=RSform(substring(ffd_5,tmp,length(ffd_5))); - tmp=indexof(ffd_6,"="); - tmp3=RSform(substring(ffd_6,0,tmp-1)); - tmp4=RSform(substring(ffd_6,tmp,length(ffd_6))); - out=["Fun"+nm+"<- function("+tmp1+","+tmp3+"){",[]]; - tmp=" Out=c("+ffd_2+","+ffd_3+","+ffd_4+")"; - out=concat(out,[tmp,[]]); - out=concat(out,["}",[]]); - tmp1=["Objsurf", - ["Fun"+nm,tmp2,tmp4,div1,div2,side]]; - out=concat(out,tmp1); - tmp2=[]; // 16.06.10from - forall(out,tmp1, - if(islist(tmp1), - tmp=apply(tmp1,if(isstring(#),Dq+#+Dq,Textformat(#,5))); - , - if(isstring(tmp1),tmp=Dq+tmp1+Dq,tmp=Textformat(#,5)); - ); - tmp2=append(tmp2,tmp); - ); - parse("oc"+nm+"="+tmp2); - println("cmd seq oc"+nm+" generated"); // 16.06.10until - OBJCMD=concat(OBJCMD,out);//16.11.29 - out; -); - -Mkobjnrm(nm,fd):=Mkobjnrm(nm,fd,[]); -Mkobjnrm(nm,fd,optionorg):=( -//help:Mkobjnrm("1",fd1,["Disp=y"]); -//help:Mkobjnrm("1","[x,y,x*y/(x^2+y^2)],x,y"); - regional(name,options,stL,eqL,disp,ffd,fst,xst,yst,cmdL, - precmd,out,tmp,tmp1,tmp2,tmp3); - name="nrm"+nm; - options=select(optionorg,length(#)>0); - tmp=Divoptions(options); - eqL=tmp_5; - stL=tmp_7; - precmd=[]; - disp="N"; - forall(eqL, // 16.05.02 - tmp1=Toupper(substring(#,0,1)); - tmp=indexof(#,"="); - tmp2=Toupper(substring(#,tmp,tmp+1)); - if(tmp1=="D", - if(tmp2=="Y" % tmp2=="T", - disp="Y"; - options=remove(options,[#]); - ); - ); - ); - forall(stL, - if(indexof(#,"+")+indexof(#,"-")==0, - precmd=concat(precmd,[#,[]]); - options=remove(options,[#]); - ); - ); - if(isstring(fd), - tmp=Indexall(fd,","); - fst=[ - substring(fd,1,tmp_1-1), - substring(fd,tmp_1,tmp_2-1), - substring(fd,tmp_2,tmp_3-2) - ]; - xst=substring(fd,tmp_3,tmp_4-1); - yst=substring(fd,tmp_4,length(fd)); - , - ffd=Fullformfunc(fd); - fst=text(ffd_(2..4)); - tmp=indexof(ffd_5,"="); - xst=substring(ffd_5,0,tmp-1); - tmp=indexof(ffd_6,"="); - yst=substring(ffd_6,0,tmp-1); - ); - cmdL=precmd; - cmdL=concat(cmdL,[ - "fx:diff",[fst,xst], - "fy:diff",[fst,yst], - "nx:fx[2]*fy[3]-fx[3]*fy[2]",[], - "ny:fx[3]*fy[1]-fx[1]*fy[3]",[], - "nz:fx[1]*fy[2]-fx[2]*fy[1]",[], - "nn:factor(nx^2+ny^2+nz^2)",[], // 16.04.21 - "nn:sqrt(nn)",[], // 16.04.20 - "nx:nx/nn",[], - "ny:ny/nn",[], - "nz:nz/nn",[], - "n:[nx,ny,nz]",[], // 16.04.21from - "n:ratsimp(n)",[], - "n:trigsimp(n)",[], - "n:factor(n)",[], // 16.04.21until - "n",[] - ]); - CalcbyM(name,cmdL,options); // 16.05.12 - tmp1=parse(name); // 16.05.12 - out=[tmp1]; // 15.04.21b from - tmp2=[]; - forall(1..3, - tmp=indexof(tmp1,","); - if(tmp==0, - tmp=indexof(tmp1,"]"); - ); - tmp3=substring(tmp1,0,tmp-1); - tmp1=substring(tmp1,tmp,length(tmp1)); - tmp=indexof(tmp3,"/"); - if(tmp>0, - tmp3=substring(tmp3,tmp,length(tmp3)); - tmp2=append(tmp2,tmp3); - , - tmp2=append(tmp2,"1"); - ); - ); -// out=append(out,tmp2); - out=out_1; // 16.05.02from - println("calculate "+name+":"); // 16.05.12 - if(disp=="Y", // 16.05.02 - println(out); - // println(out_2); - ); // 16.05.02until - out; -); - -Mkobjthickcmd(nm,fd):=Mkobjthickcmd(nm,fd,"",[40,40,"+"]); -Mkobjthickcmd(nm,fd,Arg):=( - if(islist(Arg), - Mkobjthickcmd(nm,fd,"",Arg); - , - Mkobjthickcmd(nm,fd,Arg,[]); - ); -); -Mkobjthickcmd(nm,fd,fnrm,optionorg):=( -//help:Mkobjthickcmd("1",fd,["assume(R>0)"]); -//help:Mkobjthickcmd("1",fd,fnorm); -//help:Mkobjthickcmd(options1=[40,40,0.05,-0.05,"+n+s+e+w+"]); -//help:Mkobjthickcmd(options2=["ratsimp","trigsimp"]); - regional(options,ffd,cmd,out,div1,div2,thick1,thick2,side, - reL,stL,addcmd,fst,xst,yst,tmp,tmp1,tmp2,tmp3,tmp4); - div1=40; - div2=40; - thick1=0.05; - thick2=-0.05; - side="+n+s+e+w+"; - options=select(optionorg,length(#)>0); - tmp=Divoptions(options); - reL=tmp_6; - stL=tmp_7; - tmp1=1; // 16.04.21from - tmp2=1; - forall(1..length(reL), - tmp=reL_#; - if(tmp>1, - if(tmp1==1, - div1=tmp; - div2=tmp; - , - div2=tmp; - ); - tmp1=tmp1+1; - , - if(tmp2==1, - thick1=tmp; - thick2=-tmp; - , - thick2=tmp; - ); - tmp2=tmp2+1; - ); - ); // 16.04.21until - options=remove(options,reL); - forall(stL, - if(length(#)>0, - tmp=indexof(#,"+")+indexof(#,"-"); - if(tmp>0, - side=#; - options=remove(options,[#]); - ); - ); - ); - side="'"+side+"'"; - ffd=Fullformfunc(fd); - tmp=indexof(ffd_5,"="); - tmp1=substring(ffd_5,0,tmp-1); - tmp2=RSform(substring(ffd_5,tmp,length(ffd_5))); - tmp=indexof(ffd_6,"="); - tmp3=substring(ffd_6,0,tmp-1); - tmp4=RSform(substring(ffd_6,tmp,length(ffd_6))); - fst=text(ffd_(2..4)); - tmp=indexof(ffd_5,"="); - xst=substring(ffd_5,0,tmp-1); - tmp=indexof(ffd_6,"="); - yst=substring(ffd_6,0,tmp-1); - out=["Fun"+nm+"<- function("+tmp1+","+tmp3+"){",[]]; - tmp=" c("+ffd_2+","+ffd_3+","+ffd_4+")"; - out=concat(out,[tmp,[]]); - out=concat(out,["}",[]]); - tmp=["Fnrm"+nm+"<- function("+xst+","+yst+"){",[]]; - out=concat(out,tmp); - if(fnrm=="", - tmp=Mkobjnrm(nm,fd,options); - tmp1=RSform(tmp); - tmp="Fnrmden"+nm+"("+xst+","+yst+"):="+tmp_2; - parse(tmp); - , - tmp1=RSform(fnrm); -// if(indexof(tmp1,"Out=")==0, // 16.05.09from -// tmp1="Out="+tmp1; -// ); // 16.05.09until - ); - out=concat(out,[tmp1,[]]); - out=concat(out,["}",[]]); - tmp1=["Objthicksurf", - ["Fun"+nm,tmp2,tmp4,div1,div2,"Fnrm"+nm,thick1,thick2,side]]; - out=concat(out,tmp1); - tmp2=[]; // 16.06.10from - forall(out,tmp1, - if(islist(tmp1), - tmp=apply(tmp1,if(isstring(#),Dq+#+Dq,Textformat(#,5))); - , - if(isstring(tmp1),tmp=Dq+tmp1+Dq,tmp=Textformat(#,5)); - ); - tmp2=append(tmp2,tmp); - ); - parse("oc"+nm+"="+tmp2); - println("cmd seq oc"+nm+" generated"); // 16.06.10until - OBJCMD=concat(OBJCMD,out);//16.11.29 - out; -); - -Mkobjpolycmd(nm,pd):=Mkobjpolycmd(nm,pd,[]); -Mkobjpolycmd(nm,pd,optionorg):=( -//help:Mkobjpolycmd("1",pd); -//help:Mkobjpolycmd(options1=[internal([0,0,0])]); - regional(options,cmd,out,thick1,thick2,origin, - reL,stL,vtx,face,pt1,pt2,pt3,tmp,tmp1,tmp2); - thick1=0; - thick2=-0; - origin=[0,0,0]; - options=select(optionorg,length(#)>0); - tmp=Divoptions(options); - reL=tmp_6; - stL=tmp_7; - tmp1=1; - forall(1..length(reL), - tmp=reL_#; - if(islist(tmp), - origin=tmp; - , - if(tmp1==1, - thick1=tmp; - thick2=-tmp; - , - thick2=tmp; - ); - tmp1=tmp1+1; // 16.07.08 - ); - ); - options=remove(options,reL); - forall(stL, - tmp=indexof(#,"+")+indexof(#,"-"); - if(tmp>0, - side=#; - options=remove(options,[#]); - ); - ); - vtx=pd_1; //16.04.23from - if(length(pd)==2,face=pd_2,face=pd_3); - if(isstring(vtx),vtx=parse(vtx)); - vtx=apply(vtx,if(isstring(#),parse(#),#)); // 16.06.18 - if(isstring(face),face=parse(face)); - forall(1..length(face), - tmp=face_#; - pt1=vtx_(tmp_1);// 16.06.18 - pt2=vtx_(tmp_2);// 16.06.18 - pt3=vtx_(tmp_(length(tmp)));// 16.06.18 - tmp1=Crossprod(pt2-pt1,pt3-pt1); - tmp2=Dotprod(tmp1,pt1-origin); - if(tmp2<0, - face_#=reverse(face_#); - ); - ); - tmp1=RSform(textformat(vtx,5),2);//17.12.24from - tmp2=RSform(textformat(face,5),2); - out=["Objpolyhedron",[tmp1,tmp2]];//17.12.24until - tmp2=[]; // 16.06.10from - forall(out,tmp1, - if(islist(tmp1), - tmp=apply(tmp1,if(isstring(#),Dq+#+Dq,Textformat(#,5))); - , - if(isstring(tmp1),tmp=Dq+tmp1+Dq,tmp=Textformat(#,5)); - ); - tmp2=append(tmp2,tmp); - ); - parse("oc"+nm+"="+tmp2); - println("cmd seq oc"+nm+" generated"); // 16.06.10until - OBJCMD=concat(OBJCMD,out);//16.11.29 - out; -); - -Mkobjplatecmd(nm,pd):=Mkobjplatecmd(nm,pd,[]); -Mkobjplatecmd(nm,pdorg,optionorg):=( // 16.06.18 -//help:Mkobjplatecmd("1",pd); -//help:Mkobjplatecmd("1",vtxlist); -//help:Mkobjplatecmd(options1=[0.05,-0.05]); - regional(pd,options,cmd,out,thick1,thick2,nn,pdn, - reL,vtx,face,nv,npttmp,tmp1,tmp2,tmp3,tmp4); - pd=pdorg; - if(MeasureDepth(pd)==1,pd=[pd]); - if(MeasureDepth(pd)==2,pd=[pd]);//16.10.04from - forall(1..length(pd),nn, // 16.06.19from - pdn=pd_nn; - vtx=pdn_1; - if(length(pdn)==1,face=[1..(length(vtx))],face=pdn_2); - vtx=apply(vtx,if(isstring(#),parse(#),#)); - vtx=apply(vtx,if(ispoint(#),parse(text(#)+"3d"),#)); - pd_nn=[vtx,face];//16.10.04until - ); // 16.06.19until - thick1=0.05; - thick2=-0.05; - options=select(optionorg,length(#)>0); - tmp=Divoptions(options); - reL=tmp_6; - tmp1=1; - forall(1..length(reL), - tmp=reL_#; - if(tmp1==1, - thick1=tmp; - thick2=-tmp; - , - thick2=tmp; - ); - tmp1=tmp1+1;// 16.07.08 - ); - options=remove(options,reL); - out=[]; - forall(1..length(pd),npd, - forall(pd_npd_2,face, - vtx=apply(face,pd_npd_1_#); - npt=length(vtx); - tmp1=vtx_1; - tmp2=vtx_2; - tmp3=vtx_npt; - tmp=Crossprod(tmp2-tmp1,tmp3-tmp1); - nv=tmp/Dist3d(tmp); - tmp1=apply(vtx,#+thick1*nv); - tmp2=apply(vtx,#+thick2*nv); - vtx=concat(tmp1,tmp2); - tmp=apply(1..npt,#+npt); - tmp2=[1..npt,reverse(tmp)]; - tmp=apply(1..(npt-1),[#,#+npt,#+npt+1,#+1]); - tmp2=concat(tmp2,tmp); - tmp=[npt,npt+npt,1+npt,1]; - tmp2=append(tmp2,tmp); - tmp3=RSform(textformat(vtx,5),2);//17.12.24from - tmp4=RSform(textformat(tmp2,5),2); - out=concat(out,["Objpolyhedron",[tmp3,tmp4]]);//17.12.24until - ); - ); - tmp3="["; // 16.06.10from - forall(out,tmp1, - tmp2=""; - if(isstring(tmp1), - tmp2=tmp2+Dq+tmp1+Dq+",["; - , - tmp2=tmp2+Textformat(tmp1_1,5)+","; - tmp2=tmp2+Textformat(tmp1_2,5)+"],"; - ); - tmp3=tmp3+tmp2; - ); - tmp3=substring(tmp3,0,length(tmp3)-1)+"]"; - parse("oc"+nm+"="+tmp3); - println("cmd seq oc"+nm+" generated"); - OBJCMD=concat(OBJCMD,out);//16.11.29 - out; -); - -Mkobjcrvcmd(nm,pst):=Mkobjcrvcmd(nm,pst,[]); -Mkobjcrvcmd(nm,pstorg,options):=( -//help:Mkobjcrvcmd("1","sc3d1",[0.02,6,"xy"]); - regional(cmd,out,thick,poly,dir,phead,pst, - reL,stL,tmp,tmp1,tmp2,tmp3,tmp4,flg); - thick=0.02; - poly=6; - dir="xy"; - tmp=Divoptions(options); - reL=tmp_6; - stL=select(tmp_7,length(#)>0); - forall(1..length(reL), - if(#==1, - thick=reL_1; - , - poly=reL_2; - ); - ); - forall(stL, - dir=#; - ); - dir="'"+dir+"'"; - tmp=indexof(pstorg,"_"); - if(tmp==0, - phead=pstorg; - , - phead=substring(pstorg,0,tmp-1); - ); - pst=pstorg; - out=[]; - tmp1=select(GLIST,indexof(#,phead+"=")>0); - if(length(tmp1)==0, println(phead+" incorrect")); -// out=[tmp1_1,[]]; - out=[]; - tmp1=parse(pst); - flg=0; // 16.04.23from - if(MeasureDepth(tmp1)==2,flg=1); - if(MeasureDepth(tmp1)==0, - if(islist(tmp1),flg=1); - ); - if(flg==1, // 16.04.23until - if(!isstring(tmp1_1), - forall(1..length(tmp1), - tmp=["Objcurve",[pst+"[["+text(#)+"]]",thick,poly,dir]];//17.12.22 - out=concat(out,tmp); - ); - , - forall(1..length(tmp1), // 16.11.14from - tmp=["Objcurve",[tmp1_#,thick,poly,dir]]; - out=concat(out,tmp); - );// 16.11.14until - ); - , - tmp1=Chunderscore(pst); - tmp=["Objcurve",[tmp1,thick,poly,dir]]; - out=concat(out,tmp); - ); - tmp2=[]; // 16.06.10from - forall(out,tmp1, - if(islist(tmp1), - tmp=apply(tmp1,if(isstring(#),Dq+#+Dq,Textformat(#,5))); - , - if(isstring(tmp1),tmp=Dq+tmp1+Dq,tmp=Textformat(#,5)); - ); - tmp2=append(tmp2,tmp); - ); - parse("oc"+nm+"="+tmp2); - println("cmd seq oc"+nm+" generated"); // 16.06.10until - OBJCMD=concat(OBJCMD,out);//16.11.29 - out; -); - -Mkobjsymbcmd(symb,size,rot,dir,pos):= - Mkobjsymbcmd("",symb,size,rot,dir,pos,[]); -Mkobjsymbcmd(Ar1,Ar2,Ar3,Ar4,Ar5,Ar6):=( - if(isstring(Ar2), - Mkobjsymbcmd(Ar1,Ar2,Ar3,Ar4,Ar5,Ar6,[]); - , - Mkobjsymbcmd("",Ar1,Ar2,Ar3,Ar4,Ar5,Ar6); - ); -); -Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=( -//help:Mkobjsymbcmd("x",0.5,0,V3d,A3d); -//help:Mkobjsymbcmd("P",0.5,0,V3d,A3d); -//help:Mkobjsymbcmd(options=[0.05,4,"'yz'"]); - regional(symb,options,opbez,eqL,reL,stL,dtLstr,dtL,dt, - alpha,Alpha,out,mx,Mx,my,My,center,tmp,tmp1,tmp2); - alpha="abcdefghijklmnopqrstuvwxyz"; - Alpha=Toupper(alpha); - symb=symborg; - options=optionorg; - opbez=["nodisp"]; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - stL=tmp_7; - opbez=concat(opbez,eqL); - options=remove(options,eqL); - tmp1=[0.05,4,"'yz'"]; - if(length(reL)==0, - options=concat(options,tmp1_(1..2)); - ); - if(length(reL)==1, // debugged 16.06.18 - options=concat(options,[tmp1_2]); - ); - if(length(stL)==0, - options=concat(options,[tmp1_3]); - ); - out=[]; - tmp=parse(symb); - if((islist(symb)) % (islist(tmp)), //17.12.24from - if(islist(tmp), - dtL=[symb]; - , - dtL=symb; - ); //17.12.24until - , - tmp=substring(symb,0,1); - if(tmp>="a" & tmp<="z",tmp1=tmp+"s"); - if(tmp>="A" & tmp<="Z", - tmp=indexof(Alpha,tmp); - tmp=substring(alpha,tmp-1,tmp); - tmp1=tmp+"c"; - ); - if(length(symb)==1, - if(symb>"Z", - symb=tmp1+"i"; - , - symb=tmp1+"r"; - ); - ); - if(length(symb)==2,symb=tmp1+substring(symb,1,2)); - if(length(path)>0, // 16.04.23from - setdirectory(path); - , - tmp=Dirhead+"/data/fontF"; // 16.05.10 - setdirectory(tmp); - ); // 16.04.23until - dtL=Readbezier(symb,opbez); - dtLstr=dtL; //17.12.23 - setdirectory(Dirwork); - forall(dtL,dt, - tmp=dt+"="; - tmp1=select(GLIST,indexof(#,tmp)>0); - if(length(tmp1)>0,//17.12.23from - tmp1=tmp1_1; - out=concat(out,[tmp1,[]]); - ); //17.12.23until - ); - mx=100;Mx=-100;my=100;My=-100; - forall(dtL,dt, - tmp=apply(parse(dt),#_1); - mx=min(append(tmp,mx)); - Mx=max(append(tmp,Mx)); - tmp=apply(parse(dt),#_2); - my=min(append(tmp,my)); - My=max(append(tmp,My)); - ); - center=[(mx+Mx)/2,(my+My)/2]; - tmp1=[]; - forall(dtL,dt, - Rotatedata(dt,dt,rot,[center,"nodisp"]); - Translatedata(dt,"rt"+dt,-center,["nodisp"]); - tmp1=append(tmp1,"tr"+dt); - ); - dtL=tmp1; - forall(dtL,dt, - tmp=dt+"="; - tmp1=select(GLIST,indexof(#,tmp)>0); - if(length(tmp1)>0, //17.12.23from - tmp1=tmp1_1; - out=concat(out,[tmp1,[]]); - ); //17.12.23until - ); - ); - tmp1=text(options); - tmp1=substring(tmp1,1,length(tmp1)-1); - tmp2=""; //17.12.23from - forall(dtL, - tmp2=tmp2+","+#; - ); - tmp2="list("+substring(tmp2,1,length(tmp2))+")"; //17.12.23until - out=concat(out,[ - "Sd=Symb3data",[tmp2,size,0,dir,pos], //17.12.23 - "Objsymb(Sd,"+tmp1+")",[] - ]); - tmp2=[]; // 16.06.10from - forall(out,tmp1, - if(islist(tmp1), - tmp=apply(tmp1,if(isstring(#),Dq+#+Dq,Textformat(#,5))); - , - if(isstring(tmp1),tmp=Dq+tmp1+Dq,tmp=Textformat(#,5)); - ); - tmp2=append(tmp2,tmp); - ); - parse("oc"+symborg+"="+tmp2); - println("cmd seq oc"+symborg+" generated"); // 16.06.10until - OBJCMD=concat(OBJCMD,out);//16.11.29 - out; -); - -Concatcmd(cmdlist):=( -//help:Concatcmd([cmdL1,cmdL2]); - regional(out); - out=[]; - forall(cmdlist, - out=concat(out,#); - ); - out; -); - -WritetoF(fname,cmdL):=( -// help:WritetoF("outdata",cmdL); - regional(tmp,tmp1,tmp2,filename,wfilename); - if(indexof(fname,".")==0, - filename=fname+".input"; - , - filename=fname; - ); - wfilename=replace(filename,".input",".txt"); - SCEOUTPUT = openfile(filename); - forall(1..(length(cmdL)), - tmp1=cmdL_#; - if(substring(tmp1,0,1)=="[", - tmp1=tmp1+" --##"; - println(SCEOUTPUT,tmp1); - , - println(SCEOUTPUT,tmp1); - println(SCEOUTPUT," --##"); - ); - ); - closefile(SCEOUTPUT); -); - -kcF(fname):=kcF(fname,[]); -kcF(fname,optionorg):=( - regional(options,tmp,tmp1,tmp2,eqL,strL, - filename,wfile,flg); - if(indexof(fname,".")==0, - filename=fname+".input"; - , - filename=fname; - ); - wfile=replace(filename,".input",".sfort"); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - strL=tmp_7; - forall(eqL, - tmp=indexof(#,"="); - tmp1=substring(#,0,tmp-1); - tmp2=substring(#,tmp,length(#)); - ); - flg=0; - forall(strL, - if(Toupper(substring(#,0,1))=="R", - flg=0; - options=remove(options,[#]); - ); - if(Toupper(substring(#,0,1))=="M", - flg=1; - ); - ); - if(flg==0, - tmp2=replace(filename,".input",".sfort"); - tmp1=load(tmp2); - if(length(tmp1)==0, - flg=1; - ); - ); - if(flg==1, - tmp1=""; - if(iswindows(), - tmp2=Batparent; - , - tmp2=Shellparent; - ); - flg=0; - forall(reverse(1..length(tmp2)), - if(flg==0, - tmp=substring(tmp2,#-1,#); - if(tmp=="/" % tmp=="\", // 14.01.15 - tmp1=substring(tmp2,0,#-1); - tmp2=substring(tmp2,#,length(tmp2)); - flg=1; - ); - ); - ); - if(length(tmp1)>0, - setdirectory(tmp1); - ); - if(iswindows(), -// SCEOUTPUT=openfile(wfile); -// println(SCEOUTPUT,""); -// closefile(SCEOUTPUT); - SCEOUTPUT = openfile("kc.bat"); - tmp=Dq+PathF+"\bash"+Dq+" --login -i -c "+Dq+"/cygdrive/"; - tmp1=replace(Dirwork,"\","/"); - if(indexof(tmp1,":")==0, - tmp=tmp+"c/"+tmp1+"/kc.sh"+Dq; - , - tmp1=replace(tmp1,":",""); - tmp=tmp+tmp1+"/kc.sh"+Dq; - ); - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - SCEOUTPUT = openfile("kc.sh"); - Lf=unicode("10",base->10); - print(SCEOUTPUT,"#!/bin/sh"+Lf); - tmp1=replace(Dirwork,"\","/"); - if(indexof(tmp1,":")==0, - tmp="cd "+Dq+"/cygdrive/c/"+tmp1+Dq; - , - tmp1=replace(tmp1,":",""); - tmp="cd "+Dq+"/cygdrive/"+tmp1+Dq; - ); - print(SCEOUTPUT,tmp+Lf); - tmp=Dq+"/opt/fricas/bin/fricas"; - tmp=tmp+Dq+" -nox -eval "; - tmp=tmp+Dq+")read "+filename+Dq; -// tmp=tmp+" > "+Dq+wfile+Dq; - print(SCEOUTPUT,tmp+Lf); - print(SCEOUTPUT,"exit 0"+Lf); - closefile(SCEOUTPUT); - println(kc(Dirwork+Batparent,Dirlib,Fnametex));// 16.05.29,06.05 - , - SCEOUTPUT = openfile("kc.sh"); - println(SCEOUTPUT,"#!/bin/sh"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp=Dq+PathF+Dq+" -nox -eval "+Dq+")read "+filename+Dq; -// tmp=tmp+" > "+wfile; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - println(kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex));// 16.05.29,06.05 - ); - setdirectory(Dirwork); - ); -); - -CalcbyF(name,cmd):=CalcbyM(name,cmd,[]); -CalcbyF(name,cmd,optionorg):=( -//help:CalcbyF("a",cmdL); -//help:CalcbyF(options= ["m/r","Wait=5"]]); - regional(options,tmp,tmp1,tmp2,tmp3,tmp4,strL,eqL, - flg,wflg,file,nc,arg,cmdF,cmdlist,wfile,Alpha, - waiting,num,dig,varlist); - options=optionorg; - tmp=divoptions(options); - eqL=tmp_5; - strL=tmp_7; - waiting=5; - dig=5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - ); - file=Fhead+name+".input"; - wfile=Fhead+name+".sfort"; - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - cmdF=cmd; - tmp1=")set breakmode quit"; - tmp2=")set output fortran on"; - tmp3=")set fortran precision single"; - cmdlist=[tmp1,tmp2,tmp3]; - tmp=")set output fortran "+wfile; - cmdlist=append(cmdlist,tmp); - forall(1..floor(length(cmdF)/2),nc, //17.5.18 - tmp1=cmdF_(2*nc-1); - tmp1=replace(tmp1,LFmark,""); // 16.06.12 - tmp2=cmdF_(2*nc); // list of argments - if(nc<length(cmdF)/2, - tmp3=""; - forall(tmp2,arg, - if(isstring(arg), - tmp3=tmp3+arg+","; - , - tmp3=tmp3+textformat(arg,dig)+","; - ); - ); - if(length(tmp3)>0, - tmp3=tmp1+ - "("+substring(tmp3,0,length(tmp3)-1)+")"; - , - tmp3=tmp1; - ); - cmdlist=append(cmdlist,tmp3); - , - if(indexof(tmp1,"::")==0, - varlist=[tmp1]; - , - varlist=tokenize(tmp1,"::"); - ); - forall(varlist, - cmdlist=append(cmdlist,"["+#+"]"); - ); - ); - ); - cmdlist=concat(cmdlist,["111111*1",")quit"]); - if(wflg==0, - tmp1=load(file); - if(length(tmp1)==0, - wflg=1; - , - if(indexof(tmp1," --##")==0, // 15.11.26 - wflg=1; - , - tmp1=tokenize(tmp1," --##"); - tmp1=tmp1_(1..(length(tmp1)-1)); - if(length(tmp1)!=length(cmdlist), - wflg=1; - , - tmp=select(1..length(tmp1),tmp1_#!=cmdlist_#); - if(length(tmp)>0, wflg=1); - ); - ); - ); - ); - if(wflg==0,wflg=-1); - if(wflg==1, - if(length(wfile)>0, - SCEOUTPUT=openfile(wfile); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - ); - WritetoF(file,cmdlist); - kcF(file,concat(options,["m"])); - ); - Alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZ"; - flg=0; - tmp1=floor(waiting*1000/WaitUnit); - repeat(tmp1, - if(flg==0, - tmp1=load(wfile); - if(wflg==1,wait(WaitUnit)); - tmp=indexof(tmp1,"Error")+indexof(tmp1,"find"); - if(tmp>0, - println("Some error(s) occurred"); - tmp=tokenize(tmp1," --##"); - forall(tmp, - if(indexof(#,"Error")+indexof(#,"find")>0, - println(tmp_(length(tmp))); - ); - ); - flg=2; - ); - if(indexof(tmp1,"111111")>0, - tmp1=replace(tmp1," &",""); - tmp3="["; - forall(1..length(varlist), - tmp=indexof(tmp1,"["+varlist_#+"]"); - tmp1=substring(tmp1,tmp,length(tmp1)); - tmp=indexof(tmp1,"(1)="); - tmp1=substring(tmp1,tmp+3,length(tmp1)); - tmp=indexof(tmp1," "); - tmp3=tmp3+Dq+substring(tmp1,0,tmp-1)+Dq+","; - ); - tmp3=replace(tmp3,"**","^"); - tmp3=replace(tmp3,".0",""); - tmp4=""; - forall(1..length(tmp3), - tmp=substring(tmp3,#-1,#); - tmp1=indexof(Alpha,tmp); - if(tmp1>0, - tmp4=tmp4+unicode(text(tmp1+96),base->10); - , - if(tmp==" " % tmp=="&", - , - tmp4=tmp4+tmp; - ); - ); - ); - tmp=name+"="+substring(tmp4,0,length(tmp4)-1)+"]"; - parse(tmp); - tmp=parse(name); - if(length(tmp)==1, - tmp1=substring(tmp4,1,length(tmp3)-1); - parse(name+"="+tmp1); - ); - flg=1; - tmp2=#*WaitUnit/1000; - , - if(wflg==-1, - flg=-1; - , - wait(WaitUnit); - ); - ); - ); - ); - if(flg<=0, - if(flg==-1, - println(wfile+" does not exist"); - , - tmp="("+text(waiting)+" s )"; - tmp1=load(wfile); - if(length(tmp1)>0, - println(wfile+" incomplete"+tmp); // 2016.02.24 - , - println(wfile+" not generated "+tmp); - ); - ); - , - if(flg==1, - println(" Succeeded "+name+" ("+text(tmp2)+" sec)"); - ); - ); -); - -Frfun(name,fun,argL):=Frifun(name,fun,argL,[]); -Frfun(name,fun,argL,optionorg):=Frifun(name,fun,argL,optionorg); -Frifun(name,fun,argL):=Frifun(name,fun,argL,[]); -Frifun(name,fun,argL,optionorg):=( -//help:Frfun("1","integrate",["sin(x)^3","x"],[""]); -//help:Mxfun(options=["Disp=y"]); - regional(nm,options,eqL,disp,cmdL,tmp,tmp1,tmp2); - nm="fri"+name; - options=optionorg; - tmp=divoptions(options); - disp=1; - eqL=tmp_5; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,3)); - tmp2=substring(#,tmp,length(#)); - if((tmp1=="DIS") % (tmp1=="DSP") , - tmp=Toupper(substring(tmp2,0,1)); - if((tmp=="F") % (tmp=="N"), - disp=0; - ); - options=remove(options,[#]); - ); - ); - cmdL=[]; - cmdL=concat(cmdL,[ - "ans"+":="+fun,argL, - "ans",[] - ]); - CalcbyF(nm,cmdL,options); - if(disp==1, // 15.11.24 - println(nm+" is : "); - println(parse(nm)); - ); - parse(nm); -); - -Mkketcindyjs():=Mkketcindyjs("ketcindylib"); -Mkketcindyjs(Arg):=( - if(isstring(Arg), - Mkketcindyjs(Arg,[]) - , - Mkketcindyjs("ketcindylib",Arg) - ); -); -Mkketcindyjs(libname,options):=( //17.11.18 -//help:Mkketcindyjs(); -//help:Mkketcindyjs(options="Tex=y","Net=y"]); - regional(texflg,netflg,tmp,tmp1,tmp2); - texflg="Y"; - netflg="Y"; - forall(options, - tmp1=Toupper(#); - if(indexof(tmp1,"TEX")>0, - tmp=indexof(tmp1,"="); - texflg=Toupper(substring(tmp1,tmp,tmp+1)); - ); - if(indexof(tmp1,"NET")>0, - tmp=indexof(tmp1,"="); - netflg=Toupper(substring(tmp1,tmp,tmp+1)); - ); - ); - if(isexists(Dirwork,Fhead+".html"), - SCEOUTPUT = openfile(Fhead+".r"); - println(SCEOUTPUT,"Looprange<- function(a,b){"); - println(SCEOUTPUT," if (a<=b) return(a:b)"); - println(SCEOUTPUT," return(c())"); - println(SCEOUTPUT,"}"); - println(SCEOUTPUT,"setwd('"+Dirfile+"/CindyJS')"); - println(SCEOUTPUT,"Dtket=readLines('"+libname+".txt')"); - println(SCEOUTPUT,"setwd('"+Dirwork+"')"); - println(SCEOUTPUT,"Dtjs=readLines('"+Fhead+".html')"); - println(SCEOUTPUT,"Qt=rawToChar(as.raw(34))"); - println(SCEOUTPUT, - "Dtinit=c(paste('<script id=',Qt,'csinit',Qt,' type=',Qt,'text/x-cindyscript',Qt,'>',sep=''))"); - println(SCEOUTPUT,"Dtinit=c(Dtinit,Dtket,'</script>')"); - println(SCEOUTPUT,"Dthead=c()"); - println(SCEOUTPUT,"for(I in Looprange(1,length(Dtjs))){"); - println(SCEOUTPUT," if(length(grep('<script id=',Dtjs[I],fixed=TRUE))==0){"); - println(SCEOUTPUT," Tmp=Dtjs[I]"); - if(netflg=="N", - println(SCEOUTPUT, - " if(length(grep('link rel=',Tmp,fixed=TRUE))>0){"); - println(SCEOUTPUT, - " Tmp1='file:///"+Dirfile+"/CindyJS/CindyJS.css'"); - println(SCEOUTPUT, - " Tmp=paste(' <link rel=',Qt,'stylesheet',Qt,' href=',Qt,Tmp1,Qt,'>',sep='')"); - println(SCEOUTPUT, - " }"); - println(SCEOUTPUT, - " Tmp1=length(grep('script type=',Tmp,fixed=TRUE))"); - println(SCEOUTPUT, - " Tmp1=Tmp1*length(grep('Cindy.js',Tmp,fixed=TRUE))"); - println(SCEOUTPUT, - " if(Tmp1>0){"); - println(SCEOUTPUT, - " Tmp1='file:///"+Dirfile+"/CindyJS/Cindy.js'"); - println(SCEOUTPUT, - " Tmp=paste(' <script type=',Qt,'text/javascript',Qt,' src=',Qt,Tmp1,Qt,'>',sep='')"); - println(SCEOUTPUT, - " Tmp=paste(Tmp,'</script>',sep='')"); - println(SCEOUTPUT, - " }"); - ); - println(SCEOUTPUT, - " Dthead=c(Dthead,Tmp)"); - println(SCEOUTPUT, - " }else{"); - println(SCEOUTPUT, - " Is=I; break"); - println(SCEOUTPUT, - " }"); - println(SCEOUTPUT, - "}"); - println(SCEOUTPUT,"Dt=c()"); - println(SCEOUTPUT,"for(I in Looprange(Is,length(Dtjs))){"); - println(SCEOUTPUT," Dt=c(Dt,Dtjs[I])"); - println(SCEOUTPUT," if(length(grep('</script>',Dtjs[I],fixed=TRUE))>0){"); - println(SCEOUTPUT," if(length(grep('draw',Dt[1],fixed=TRUE))>0){Dtdraw=Dt}"); - println(SCEOUTPUT," if(length(grep('keytyped',Dt[1],fixed=TRUE))>0){Dtkey=Dt}"); - println(SCEOUTPUT," Dt=c()"); - println(SCEOUTPUT," if(length(grep('<script id=',Dtjs[I+1],fixed=TRUE))==0){"); - println(SCEOUTPUT," Ie=I+1;break"); - println(SCEOUTPUT," }"); - println(SCEOUTPUT," }"); - println(SCEOUTPUT,"}"); - println(SCEOUTPUT,"Dt=c(Dthead,Dtdraw,Dtkey,Dtinit)"); - println(SCEOUTPUT,"for(I in Looprange(Ie,length(Dtjs))){"); - println(SCEOUTPUT, - " if(length(grep('Button',Dtjs[I],fixed=TRUE))>0){"); - println(SCEOUTPUT, - " if(length(grep(paste(Qt,'Figure',sep=''),Dtjs[I],fixed=TRUE))>0){next}"); - println(SCEOUTPUT, - " if(length(grep(paste(Qt,'Exekc',sep=''),Dtjs[I],fixed=TRUE))>0){next}"); - println(SCEOUTPUT, - " if(length(grep(paste(Qt,'Parent',sep=''),Dtjs[I],fixed=TRUE))>0){next}"); - println(SCEOUTPUT, - " if(length(grep(paste(Qt,'KeTJS',sep=''),Dtjs[I],fixed=TRUE))>0){next}"); - println(SCEOUTPUT, - " }"); - println(SCEOUTPUT," Dt=c(Dt,Dtjs[I])"); - if(texflg=="Y", - println(SCEOUTPUT, - " if(length(grep(paste(Qt,'cs*',Qt,sep=''),Dtjs[I],fixed=TRUE))>0){"); - println(SCEOUTPUT, - " Dt=c(Dt,paste(' use: [',Qt,'katex',Qt,'],',sep=''))"); - println(SCEOUTPUT, - " }"); - ); - println(SCEOUTPUT,"}"); - println(SCEOUTPUT,"writeLines(Dt,'"+Fhead+"ketcindy.html',sep='\n')"); - println(SCEOUTPUT,"quit()"); - closefile(SCEOUTPUT); - kcR(PathR,Fhead+".r",["m"]); - , - drawtext(mouse().xy-[0,1],"First export to CindyJS",size->24,color->[1,0,0]); - wait(3000); - ); -); - -///////////////// C function ////////////////// - -Cform(strorg):=( -//help:Cform(str) - regional(str,ter,out,hat,ns,ne,nn,jj,flg, - lv,str1,str2,tmp,tmp1,tmp2); - ter=["+","-","*","/","(",")"]; - str=replace(strorg,"pi","M_PI"); - hat=Indexall(str,"^"); - out=""; - ns=0; - forall(hat,nn, - tmp=substring(str,nn-2,nn-1); - if(tmp==")", - tmp1=substring(str,ns,nn-1); - tmp2=Parlevel(tmp1); - tmp=tmp2_(length(tmp2))_2; - lv=select(tmp2,#_2==-tmp); - tmp=lv_1_1; - out=out+substring(str,ns,ns+tmp-1); - str1=substring(str,ns+tmp,nn-2); - , - flg=0; - tmp2=reverse(ns..(nn-1)); - forall(tmp2,jj, - if(flg==0, - tmp1=substring(str,jj-1,jj); - if(contains(ter,tmp1), - tmp=jj; - flg=1; - ); - ); - ); - tmp1=substring(str,ns,tmp); - out=out+tmp1; - str1=substring(str,tmp,nn-1); - ); - tmp=substring(str,nn,nn+1); - if(tmp=="(", - tmp1=substring(str,nn,length(str)); - tmp2=Parlevel(tmp1); - lv=select(tmp2,#_2==-1); - tmp=lv_1_1; - str2=substring(tmp1,1,tmp-1); - ns=nn+tmp; - , - flg=0;tmp=0; - forall(nn..(length(str)),jj, - if(flg==0, - tmp1=substring(str,jj,jj+1); - if((length(tmp1)==0)%(contains(ter,tmp1)), - tmp=jj; - flg=1; - ); - ); - ); - str2=substring(str,nn,tmp); - ns=nn+1; - ); - out=out+"pow("+str1+","+str2+")"; - ); - str=out+substring(str,ns,length(str)); - str=str+"#"; - ter=apply(0..9,text(#)); - ter=append(ter,"."); - out=""; - tmp=substring(str,0,1); - if(contains(ter,tmp), - flg=1;out="";tmp1=tmp; - , - flg=0;out=tmp;tmp1=""; - ); - forall(2..(length(str)), - tmp=substring(str,#-1,#); - if(contains(ter,tmp), - if(flg==1, - tmp1=tmp1+tmp; - , - tmp1=tmp; - ); - flg=1; - , - if(flg==1, - if(indexof(tmp1,".")==0, - tmp1=tmp1+".0"; - ); - out=out+tmp1+tmp; - , - out=out+tmp; - ); - tmp1="";flg=0; - ); - ); - out=substring(out,0,length(out)-1); - out; -); - -ConvertFdtoC(Fd):=ConvertFdtoC(Fd,["x","y","z"]); -ConvertFdtoC(Fd,name):=( -//help:ConvertFd(Fd); - regional(FdL,FdC,uvar,vvar,tmp,tmp1); - FdL=Fullformfunc(Fd); - tmp=indexof(FdL_5,"="); //180303from - uvar=substring(FdL_5,0,tmp-1); - tmp=indexof(FdL_6,"="); - vvar=substring(FdL_6,0,tmp-1); - tmp1=apply(2..6,Assign(FdL_#,uvar,"u")); - tmp1=apply(tmp1,Assign(#,vvar,"v")); - tmp1=concat(tmp1,FdL_(7..8)); - FdC=apply(1..3,name_#+"="+Cform(tmp1_#)); - FdC=concat(FdC,[Cform(tmp1_4),Cform(tmp1_5)]); - FdC=concat(FdC,[tmp1_6]); -); - -ConstC(setlist):=( //180323 - regional(divL,sizeL,epsL); - //Mdv=50; Ndv=50; - //DsizeLL=5000; DsizeL=1500; DsizeM=500; DsizeS=200; - //Eps=0.00001; Eps1=0.01; Eps2=0.1; - forall(setlist, - if((#_1>1)&(#_1<=200), - divL=#; - if(length(divL)==0,divL=[50]); - if(length(divL)==1,divL=append(divL,divL_1)); - , - if(#_1>=100, - sizeL=#; - if(length(sizeL)==0,sizeL=[5000]); - if(length(sizeL)==1,sizeL=append(sizeL,1500)); - if(length(sizeL)==2,sizeL=append(sizeL,500)); - if(length(sizeL)==3,sizeL=append(sizeL,200)); - , - epsL=#; - if(length(epsL)==0,epsL=[0.01]); - if(length(epsL)==1,epsL=append(epsL,0.1)); - epsL=prepend(0.00001,epsL); - ); - ); - ); - ConstantListC=[divL,sizeL,epsL]; -); - -Cheader():=Cheader(FdC,FheadC+"header.h"); -Cheader(fdc,fname):=( - regional(tmp,tmp1,tmp2,j, dW,dE,dS,dN,dstr, - DsizeLL,DsizeL,DsizeM,DsizeS,Eps,Eps1,Eps2,Eps3); - Mdv=50; Ndv=50; - DsizeLL=15000; DsizeL=1500; DsizeM=500; DsizeS=200; - Eps=0.00001; Eps1=0.05; Eps2=0.2; Eps3=1; - SCEOUTPUT = openfile(fname); - tmp=indexof(fdc_2,"="); - tmp1=substring(fdc_2,tmp,length(fdc_2)); - tmp1=replace(tmp1,"[","{"); - tmp1=replace(tmp1,"]","}"); - tmp=indexof(fdc_3,"="); - tmp2=substring(fdc_3,tmp,length(fdc_3)); - tmp2=replace(tmp2,"[","{"); - tmp2=replace(tmp2,"]","}"); - tmp="const double Urng[2]="+tmp1+", Vrng[2]="+tmp2; - println(SCEOUTPUT,tmp+";"); - tmp="const double XMIN="+Sprintf(XMIN,6); - tmp=tmp+",XMAX="+Sprintf(XMAX,6); - println(SCEOUTPUT,tmp+";"); - tmp="const double THETA="+Sprintf(THETA,6); - tmp=tmp+",PHI="+Sprintf(PHI,6); - println(SCEOUTPUT,tmp+";"); - tmp=" //THETA:"+Sprintf(THETA*180/pi,2); - tmp=tmp+", PHI:"+Sprintf(PHI*180/pi,2); - println(SCEOUTPUT,tmp+";"); - dstr=fdc_4; - if(indexof(dstr,"w")>0,dW=1,dW=0); - if(indexof(dstr,"e")>0,dE=1,dE=0); - if(indexof(dstr,"s")>0,dS=1,dS=0); - if(indexof(dstr,"n")>0,dN=1,dN=0); - tmp="const int DrawW="+text(dW)+", DrawE="+text(dE); - tmp=tmp+", DrawS="+text(dS)+", DrawN="+text(dN); - println(SCEOUTPUT,tmp+";"); - forall(j=5..(length(fdc)), - tmp=fdc_#; //17.05.21from - if(length(tmp)==2, - if(tmp_1>1, //17.05.24from - Mdv=tmp_1; Ndv=tmp_2; - , - if(length(tmp_1)>0, Eps1=tmp_1); - if(length(tmp_1)>0, Eps2=tmp_2); - ); //17.05.24until - ); - if(length(tmp)==3, - if(length(tmp_1)>0, DsizeLL=tmp_1);//17.06.09(3lines) - if(length(tmp_2)>0, DsizeL=tmp_2); - if(length(tmp_3)>0, DsizeM=tmp_3); - ); - if(length(tmp)==4, - if(min(tmp)<1, - if(length(tmp_1)>0, Eps=tmp_1); - if(length(tmp_2)>0, Eps1=tmp_2); - if(length(tmp_3)>0, Eps2=tmp_3); - if(length(tmp_4)>0, Eps3=tmp_4); - , - if(length(tmp_1)>0, DsizeLL=tmp_1); - if(length(tmp_2)>0, DsizeL=tmp_2); - if(length(tmp_3)>0, DsizeM=tmp_3); - if(length(tmp_4)>0, DsizeS=tmp_4); - ) - );//17.05.21until - ); - tmp1=text(fdc_5_1); - tmp2=text(fdc_5_2); - tmp="const int Mdv="+text(Mdv)+", Ndv="+text(Ndv); - println(SCEOUTPUT,tmp+";"); - tmp="#define DsizeLL "+text(DsizeLL);//17.05.21 - println(SCEOUTPUT,tmp); - tmp="#define DsizeL "+text(DsizeL); - println(SCEOUTPUT,tmp); - tmp="#define DsizeM "+text(DsizeM); - println(SCEOUTPUT,tmp); - tmp="#define DsizeS "+text(DsizeS); - println(SCEOUTPUT,tmp); - tmp="const double Eps="+format(Eps,7); - tmp=tmp+", Eps1="+format(Eps1,7); - tmp=tmp+", Eps2="+format(Eps2,7); - tmp=tmp+", Eps3= "+format(Eps3,7); - println(SCEOUTPUT,tmp+";"); - tmp="void surffun(double u, double v, double pt[3]){"; - println(SCEOUTPUT,tmp); - forall(fdc_1, - tmp1=replace(#,"x=","pt[0]="); - tmp1=replace(tmp1,"y=","pt[1]="); - tmp1=replace(tmp1,"z=","pt[2]="); - println(SCEOUTPUT," "+tmp1+";"); - ); - println(SCEOUTPUT,"}"); - closefile(SCEOUTPUT); -); - -Cmain():=Cmain(FheadC+".c",MainC); -Cmain(fname,cmdLorg):=( -//help:MainC(writesfbd("sfbd");) -//help:MainC(writeax("ax");) -//help:MainC(writewire("wire" (,2), [10,10]);) -//help:MainC(writewire("wire", [[0.5,1],[0,1,2]]]);) -//help:MainC(writecut("sfcut","x+y+2*z-4");) -//help:MainC(writesc("sl3d1");) -//help:MainC(skeleton("sk",[objlist],[pltlist] (,width));) -//help:MainC(writewire ptincrease (=2) are optional);) - regional(cmdL, tmp,tmp1,tmp2,tmp3,tmp4,nL, nn,kk,jj, num, en,cmd, - ax1,ax2,ax3,path, var,varh,file,fileh, flg, cutctr); - path=Dirwork+"/"; //17.05.29from - path=replace(path,"\","/"); - cmdL=cmdLorg;// 17.05.26from - nL=select(1..(length(cmdL)),cmdL_#=="writeax"); - cmd=[]; - if(length(nL)>0,tmp3=cmdL_(1..(nL_1-1)),tmp3=[]); - forall(1..(length(nL)), - tmp2=cmdL_(nL_#+1); - if(length(tmp2)==1,tmp2=append(tmp2,"Surf")); - tmp=tmp2_1; // 17.06.08(5lines) - if(substring(tmp,length(tmp)-2,length(tmp))!="3d", - tmp=tmp+"3d"; - ); - tmp1=parse(tmp); - tmp="axx="+textformat(tmp1_1,5); - parse(tmp); - tmp="axy="+textformat(tmp1_2,5); - parse(tmp); - tmp="axz="+textformat(tmp1_3,5); - parse(tmp); - tmp3=concat(tmp3,[ - "double "+tmp2_1+"[DsizeL][3];",[], //17.06.07(2lines) - "double axx[3][3], axy[3][3], axz[3][3];",[], - "spaceline",["axx"], - "spaceline",["axy"], - "spaceline",["axz"], - tmp2_1+"[0][0]=0;",[], - "appendd3(2,1,2,axx,"+tmp2_1+");",[], - "appendd3(2,1,2,axy,"+tmp2_1+");",[], - "appendd3(2,1,2,axz,"+tmp2_1+");",[], - "writecrv",[tmp2_1,tmp2_2] //17.06.07 - ]); - cmd=concat(cmd,tmp3); - if(#<length(nL), - tmp3=cmdL_((nL_#+2)..(nL_(#+1)-1)); - , - tmp3=cmdL_((nL_#+2)..(length(cmdL))); - cmdL=concat(cmd,tmp3); - ); - ); - nL=select(1..(length(cmdL)),cmdL_#=="writesc"); - cmd=[]; - if(length(nL)>0,tmp3=cmdL_(1..(nL_1-1)),tmp3=[]); - forall(1..(length(nL)), - tmp2=cmdL_(nL_#+1); - if(length(tmp2)==1, - tmp2=[tmp2_1,"Surf"]; - ); - tmp3=concat(tmp3,[ - "double "+tmp2_1+"[DsizeL][3];",[], //17.06.07(2lines) - "double "+tmp2_1+"h[DsizeL][3];",[], - "spaceline",[tmp2_1], - "writecrv",[tmp2_1,tmp2_2] //17.06.07 - ]); - cmd=concat(cmd,tmp3); - if(#<length(nL), - tmp3=cmdL_((nL_#+2)..(nL_(#+1)-1)); - , - tmp3=cmdL_((nL_#+2)..(length(cmdL))); - cmdL=concat(cmd,tmp3); - ); - ); - nL=select(1..(length(cmdL)),cmdL_#=="writesfbd"); - cmd=[]; - if(length(nL)>0,tmp3=cmdL_(1..(nL_1-1)),tmp3=[]); - forall(1..(length(nL)), - tmp2=cmdL_(nL_#+1); - if(length(tmp2)==1,tmp2=append(tmp2,"Surf")); - var=Dq+tmp2_1+"3d"+Dq; - varh=Dq+tmp2_1+"h3d"+Dq; - file=Dq+path+FheadC+tmp2_1+".txt"+Dq; - fileh=Dq+path+FheadC+tmp2_1+"h.txt"+Dq; - tmp="Borderhiddendata"; - tmp3=concat(tmp3,[ - "double "+tmp2_1+"[DsizeL][3];",[], //17.06.09(6lines) - "sfbdparadata",[tmp2_1], - "output3h",[var, varh,file,tmp2_1], - "dataindexd3",[3,tmp2_1,"din"], - tmp2_2+"[0][0]=0;",[], - "appendd3",[2,"din[1][0]","din[1][1]",tmp2_1,tmp2_2] - ]); - cmd=concat(cmd,tmp3); - if(#<length(nL), - tmp3=cmdL_((nL_#+2)..(nL_(#+1)-1)); - , - tmp3=cmdL_((nL_#+2)..(length(cmdL))); - cmdL=concat(cmd,tmp3); - ); - ); - nL=select(1..(length(cmdL)),cmdL_#=="writecrv"); - cmd=[]; - if(length(nL)>0,tmp3=cmdL_(1..(nL_1-1)),tmp3=[]); - forall(1..(length(nL)), - tmp2=cmdL_(nL_#+1); - if(length(tmp2)==1,tmp2=append(tmp2,"Surf")); - var=Dq+tmp2_1+"3d"+Dq; - varh=Dq+tmp2_1+"h3d"+Dq; - file=Dq+path+FheadC+tmp2_1+".txt"+Dq; - tmp3=concat(tmp3,[ - "crvsfparadata",[tmp2_1,tmp2_2,1,"Crvdata"], - tmp2_1+"[0][0]=0;",[], //17.06.09(3lines) - "appendd3",[0,1,"length3(Crvdata)","Crvdata",tmp2_1], - "output3h",[var, varh, file,tmp2_1] - ]); - cmd=concat(cmd,tmp3); - if(#<length(nL), - tmp3=cmdL_((nL_#+2)..(nL_(#+1)-1)); - , - tmp3=cmdL_((nL_#+2)..(length(cmdL))); - cmdL=concat(cmd,tmp3); - ); - ); - nL=select(1..(length(cmdL)),cmdL_#=="writescrvonsf"); - cmd=[]; - if(length(nL)>0,tmp3=cmdL_(1..(nL_1-1)),tmp3=[]); - forall(1..(length(nL)), - tmp2=cmdL_(nL_#+1); - if(length(tmp2)==1,tmp2=append(tmp2,"Surf")); - var=Dq+tmp2_1+"3d"+Dq; - varh=Dq+tmp2_1+"h3d"+Dq; //17.06.09(8lines) - file=Dq+path+FheadC+tmp2_1+".txt"+Dq; - tmp3=concat(tmp3,[ - "double "+tmp2_1+"[DsizeL][3];",[], - " crv3onsfparadata",[tmp2_1,tmp2_2,1,"Crvdata"], - tmp2_1+"[0][0]=0;",[], - "appendd3",[0,1,"length3(Crvdata)","Crvdata",tmp2_1], - "output3h",[var,varh, file ,tmp2_1] - ]); - cmd=concat(cmd,tmp3); - if(#<length(nL), - tmp3=cmdL_((nL_#+2)..(nL_(#+1)-1)); - , - tmp3=cmdL_((nL_#+2)..(length(cmdL))); - cmdL=concat(cmd,tmp3); - ); - ); - nL=select(1..(length(cmdL)),cmdL_#=="writecut"); - cmd=[]; - if(length(nL)>0,tmp3=cmdL_(1..(nL_1-1)),tmp3=[]); - cutctr=0; - forall(1..(length(nL)), - cutctr=#; - tmp2=cmdL_(nL_#+1); - if(length(tmp2)==2, - tmp2=[tmp2_1,"Surf",tmp2_2]; - ); - var=Dq+tmp2_1+"3d"+Dq; - varh=Dq+tmp2_1+"h3d"+Dq; //17.06.09(10lines) - file=Dq+path+FheadC+tmp2_1+".txt"+Dq; - tmp3=concat(tmp3,[ - "cutfun",[tmp2_3], - "double "+tmp2_1+"[DsizeL][3];",[], - "sfcutdata",[text(cutctr),"out"], //17.06.02 - "crv3onsfparadata",["out",tmp2_2,"Crvdata"], - tmp2_1+"[0][0]=0;",[], - "appendd3",[0,1,"length3(Crvdata)","Crvdata",tmp2_1], - "output3h",[var, varh, file, tmp2_1] - ]); - cmd=concat(cmd,tmp3); - if(#<length(nL), - tmp3=cmdL_((nL_#+2)..(nL_(#+1)-1)); - , - tmp3=cmdL_((nL_#+2)..(length(cmdL))); - cmdL=concat(cmd,tmp3); - ); - ); - nL=select(1..(length(cmdL)),cmdL_#=="writewire"); - cmd=[]; - if(length(nL)>0,tmp3=cmdL_(1..(nL_1-1)),tmp3=[]); - forall(1..(length(nL)), - tmp2=cmdL_(nL_#+1); - if(!isstring(tmp2_2), - tmp2=[tmp2_1,"Surf",tmp2_2,tmp2_3]; - ); - var=Dq+tmp2_1+"3d"+Dq; - varh=Dq+tmp2_1+"h3d"+Dq; //17.06.09 - file=Dq+path+FheadC+tmp2_1+".txt"+Dq; - tmp4=tmp2_(length(tmp2)); num=2; - if(!islist(tmp4), - num=tmp4; tmp4=tmp2_(length(tmp2)-1); - ); - if(!islist(tmp4_1), - tmp3=concat(tmp3,[ - "double udv[2]={-1,"+text(tmp4_1)+"};",[] - ]); - , - len=length(tmp4_1); - tmp="double udv["+text(len+1)+"]={"+text(len)+","; - forall(tmp4_1, - tmp=tmp+format(#,5)+","; - ); - tmp=substring(tmp,0,length(tmp)-1)+"};"; - tmp3=concat(tmp3,[tmp,[]]); - ); - if(!islist(tmp4_2), - tmp3=concat(tmp3,[ - "double vdv[2]={-1,"+text(tmp4_2)+"};",[] - ]); - , - len=length(tmp4_2); - tmp="double vdv["+text(len+1)+"]={"+text(len)+","; - forall(tmp4_2, - tmp=tmp+format(#,5)+","; - ); - tmp=substring(tmp,0,length(tmp)-1)+"};"; - tmp3=concat(tmp3,[tmp,[]]); - ); - tmp3=concat(tmp3,[ - "double "+tmp2_1+"[DsizeLL][3];",[], //17.06.09(5lines) - "wireparadata",["Surf", "udv","vdv", num, "Wiredata"], - tmp2_1+"[0][0]=0;",[], - "appendd3",[0,1,"length3(Wiredata)","Wiredata",tmp2_1], - "output3h",[var, varh, file, tmp2_1] - ]); - cmd=concat(cmd,tmp3); - if(#<length(nL), - tmp3=cmdL_((nL_#+2)..(tmp_(#+1)-1)); - , - tmp3=cmdL_((nL_#+2)..(length(cmdL))); - cmdL=concat(cmd,tmp3); - ); - );// 17.05.29until - nL=select(1..(length(cmdL)),cmdL_#=="skeleton");// 17.06.05from - cmd=[]; - if(length(nL)>0, - tmp3=cmdL_(1..(nL_1-1)); - tmp3=concat(tmp3,["double sk[DsizeLL][3];",[]]);//17.06.13 - , - tmp3=[]; - ); - forall(1..(length(nL)),nn, - tmp2=cmdL_(nL_nn+1); - var=Dq+tmp2_1+"3d"+Dq; - file=Dq+path+FheadC+tmp2_1+".txt"+Dq; - tmp3=concat(tmp3,[ //17.06.08from - "data[0][0]=0;",[] - ]); - forall(tmp2_2, - if(substring(#,length(#)-1,length(#))!="h", - tmp1=#; - tmp=[0,"din[1][0]","din[1][1]",tmp1,"data"]; - , - tmp1=substring(#,0,length(#)-1); - tmp=[0,"din[2][0]","din[2][1]",tmp1,"data"]; - ); - tmp3=concat(tmp3,[ - "dataindexd3",[3,tmp1,"din"], - "appendd3",tmp - ]); - ); - forall(1..(length(tmp2_3)), - if(substring(tmp2_3_#,length(tmp2_3_#)-1,length(tmp2_3_#))!="h", - tmp1=tmp2_3_#; - tmp=[0,"din[1][0]","din[1][1]",tmp1,"data"]; - , - tmp1=substring(tmp2_3_#,0,length(tmp2_3_#)-1); - tmp=[0,"din[2][0]","din[2][1]",tmp1,"data"]; - ); - tmp3=concat(tmp3,[ - "push3",["Inf",3,0,"data"], - "dataindexd3",[3,tmp1,"din"], - "appendd3",tmp - ]); - ); - if(length(tmp2)<=3,tmp=1,tmp=tmp2_4); - tmp3=concat(tmp3,[ - "skeletondata3",["data", tmp, "Eps1","Eps2","sk"],//17.06.13 - "output3",[var, file, 2, "sk"] - ]); - cmd=concat(cmd,tmp3); - if(nn<length(nL), - tmp3=cmdL_((nL_nn+2)..(nL_(nn+1)-1)); - , - tmp3=cmdL_((nL_nn+2)..(length(cmdL))); - cmdL=concat(cmd,tmp3); - );//17.06.08until - );// 17.06.05until - path=DirlibC+"/"; - path=replace(path,"\","/"); - cmd=[ - "#include <stdio.h>", "#include <math.h>", - "#include "+Dq+FheadC+"header.h"+Dq, - "#include "+Dq+path+"ketcommon.h"+Dq, - "#include "+Dq+path+"surflibhead.h"+Dq, - "#include "+Dq+path+"surflib.h"+Dq, - "int main(void){", - " double out[DsizeL][3], data[DsizeLL][3];", //17.06.10 - " int i, j, nall, din[DsizeS][2];" //17.06.09 - ]; -// tmp=select(cmdL,#=="cutfun"); -// if(length(tmp)==0, - if(cutctr==0, //17.06.02 - cmdL=prepend(["1"],cmdL); - cmdL=prepend("cutfun",cmdL); - );// 17.05.26until - cutctr=0; - forall(1..(floor(length(cmdL))/2),nn, - tmp1=cmdL_(2*nn-1); tmp2=cmdL_(2*nn); - flg=0; // 17.05.26from - if(tmp1=="cutfun", - cutctr=cutctr+1; - tmp=select(1..(length(cmd)), indexof(cmd_#,"main")>0); - tmp3=cmd_((tmp_1)..(length(cmd))); - cmd=cmd_(1..(tmp_1-1)); - cmd=append(cmd,"double cutfun"+text(cutctr)+"(double u, double v){"); - cmd=append(cmd," double p[3],val;"); - cmd=append(cmd," surffun(u,v,p);"); - tmp=" val="+assign(tmp2_1,["x","p[0]","y","p[1]","z","p[2]"])+";"; - cmd=concat(cmd, [tmp," return val;", "}"]); - cmd=concat(cmd, tmp3); - flg=1; - ); - if(tmp1=="xyzax3data", - tmp=" "+tmp1+"("; - tmp=tmp+textformat(tmp2_1_1_1_1,5)+","; - tmp=tmp+textformat(tmp2_1_1_2_1,5)+","; - tmp=tmp+textformat(tmp2_1_2_1_2,5)+","; - tmp=tmp+textformat(tmp2_1_2_2_2,5)+","; - tmp=tmp+textformat(tmp2_1_3_1_3,5)+","; - tmp=tmp+textformat(tmp2_1_3_2_3,5)+","; - tmp=tmp+tmp2_2+");"; - cmd=append(cmd,tmp); - flg=1; - ); - if(tmp1=="spaceline", - if(!isstring(tmp2_1), - println(tmp2_1+" should be assgined as a string"); - , - tmp3=parse(tmp2_1); - tmp=text(length(tmp3)+1); -// cmd=append(cmd, " double "+tmp2_1+"["+tmp+"][3];"); - tmp=text(length(tmp3)); - cmd=append(cmd, " "+tmp2_1+"[0][0]="+tmp+";"); - forall(1..(length(tmp3)), - tmp=" "+tmp2_1+"["+text(#)+"][0]="+textformat(tmp3_#_1,5)+","; - tmp=tmp+tmp2_1+"["+text(#)+"][1]="+textformat(tmp3_#_2,5)+","; - tmp=tmp+tmp2_1+"["+text(#)+"][2]="+textformat(tmp3_#_3,5)+";"; - cmd=append(cmd,tmp); - ); - ); - flg=1; - ); - if(flg==0, - tmp=" "+tmp1; - if(length(tmp2)>0, - tmp=tmp+"("; - forall(1..length(tmp2),kk, - if(isstring(tmp2_kk), - if((kk==1)&(substring(tmp1,0,5)=="write"), - file=path+FheadC+tmp2_kk+".txt"; - fileh=path+FheadC+tmp2_kk+"h.txt"; - tmp=tmp+Dq+tmp2_kk+Dq+","+Dq+file+Dq+","+Dq+fileh+Dq; - , - tmp=tmp+tmp2_kk; - ); - , - if(!islist(tmp2_kk), - tmp=tmp+textformat(tmp2_kk,5); - , - ); - ); - if(kk<length(tmp2), - tmp=tmp+","; - , - tmp=tmp+");"; - ); - ); - ); - cmd=append(cmd, tmp);// 17.05.26until - ); - ); - tmp=select(1..(length(cmd)), indexof(cmd_#,"main")>0);//17.06.02from - tmp3=cmd_((tmp_1)..(length(cmd))); - cmd=cmd_(1..(tmp_1-1)); - cmd=append(cmd,"double cutfun(int ch, double u, double v){"); - cmd=append(cmd," double val;"); - forall(1..cutctr, - tmp=text(#); - cmd=append(cmd," if(ch=="+tmp+"){val=cutfun"+tmp+"(u,v);}"); - ); - cmd=concat(cmd,[" return val;", "}"]); - cmd=concat(cmd, tmp3);//17.06.02until - cmd=concat(cmd, [" return 0;", "}"]); - SCEOUTPUT = openfile(fname); - forall(cmd, - println(SCEOUTPUT,#); - ); - closefile(SCEOUTPUT); - tmp=fileslist(Dirwork); // 17.05.20from - tmp=tokenize(tmp,","); - tmp=select(tmp,indexof(#,".txt")>0); - tmp=select(tmp,indexof(#,FheadC)>0); - forall(tmp, - SCEOUTPUT = openfile(#); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - ); // 17.05.20until -); - -kcC():=kcC(FheadC); -kcC(cname):=( - regional(tmp, tmp1,flg,rfile); - rfile="resultC"+cname+".txt"; - if(iswindows(), - SCEOUTPUT = openfile("kc.bat"); - println(SCEOUTPUT,"set path="+Dirwork); - tmp=Indexall(PathC,"\"); - if(length(tmp)==0, tmp=ndexall(PathC,"/")); - tmp1=substring(PathC,0,tmp_(length(tmp))-1); - println(SCEOUTPUT,"cd "+tmp1); - tmp=PathC+" %path%\"+cname+".c"; - tmp=tmp+" -o %path%\main.exe"; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"%path%\main.exe"); - println(SCEOUTPUT,"echo //// > %path%\"+rfile); - println(SCEOUTPUT,"exit"); - closefile(SCEOUTPUT); - tmp=cname+".txt"; - println(kc(Dirwork+Batparent,Mackc+Dirlib,tmp)); - , - SCEOUTPUT = openfile("kc.sh"); - println(SCEOUTPUT,"#!/bin/sh"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); - tmp=PathC+" "+cname+".c -o main.out"; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"./main.out"); - println(SCEOUTPUT,"echo //// >"+rfile); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - tmp=cname+".txt"; - println(kc(Dirwork+Shellparent,Mackc+Dirlib,tmp)); - ); - SCEOUTPUT=openfile(wfile); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - flg=0; - repeat(floor(10*1000/WaitUnit), - if(flg==0, - tmp1=load(wfile); - if(substring(tmp1,0,4)=="////", - flg=1; - ); - wait(WaitUnit); - ); - ); - if(flg==0, - println("Ckc not completed"); - , - println("Ckc succeeded"); - ); -); - -ReadCdataold(var, fname):=ReadCdata(var, fname,[]); -ReadCdata(var, fname,options):=( - regional(file,dt,name,str,tmp,tmp1,opstr,gout, out3,out2); - if(indexof(fname,".")==0, - file=fname+".txt"; - name=fname; - , - file=fname; - tmp=indexof(fname,"."); - name=substring(fname,0,tmp-1); - ); - tmp=Divoptions(options); - opstr=tmp_8; - gout=ReadOutData(file); - GLIST=Append(GLIST,"Tmpstr=ReadOutData("+Dq+file+Dq+")"); - if(substring(var,length(var)-1,length(var))!="h", - if(length(parse(gout_1))>0, - Projpara(var+"3d",options); - ); - , - if(length(parse(gout_2))>0, - Projpara(var+"3d",options); - ); - );//17.06.16until -); - -ReadCdata(fnameorg):=( - regional(tmp,tmp1,fname,data,out); - fname=fnameorg; - if(indexof(fname,".")==0, fname=fname+".txt"); - data=load(fname); - data=tokenize(data," -99999"); - out=[]; - tmp1=[]; - forall(1..(length(data)-1), - tmp=replace(data_#," ",","); - if(indexof(tmp,"99999.")==0, - tmp="["+replace(data_#," ",",")+"]"; - tmp=parse(tmp); - tmp1=append(tmp1,tmp); - , - out=append(out,tmp1); - tmp1=[]; - ); - ); - if(length(tmp1)>0,out=append(out,tmp1)); - out; -); - -WriteCdata(fnameorg,dataorg):=( -//help:WriteCdata(filename, 3ddata); - regional(tmp,fname,data,kk,nn,pt); - data=dataorg; - if(isstring(data),data=parse(data)); - if(MeasureDepth(data)==1,data=[data]); - fname=fnameorg; - if(indexof(fname,".")==0, fname=fname+".txt"); - SCEOUTPUT=openfile(fname); - forall(1..(length(data)),kk, - forall(1..(length(data_kk)),nn, - pt=apply(1..3,Sprintf(data_kk_nn_#,5)); - tmp=pt_1+" "+pt_2+" "+pt_3+" -99999"; - println(SCEOUTPUT,tmp); - ); - if(kk<length(data), - println(SCEOUTPUT,"99999.00000 2.00000 0.00000 -99999"); - ); - ); - closefile(SCEOUTPUT); -); - -DisplayC():=DisplayC(DispC); -DisplayC(name,options):=DisplayC([name,options]); -DisplayC(dispc):=( -//help:DisplayC("out",["Color=[1,0,0]"); -//help:DispC(options=["dr", "Color=[0,0,0]"]) - regional(tmp,tmp1,cflg,var, file,options,eqL,opcindy,color); - forall(1..(floor(length(dispc)/2)), //17.05.18 - var=dispc_(2*#-1); // 17.05.24 - if(substring(var,length(var)-1,length(var))!="h",//17.06.09(5lines) - file=FheadC+var+".txt"; - , - file=FheadC+substring(var,0,length(var)-1)+".txt"; - ); - options=dispc_(2*#); - cflg=0; - tmp=Divoptions(options);//17.06.18from - eqL=tmp_5; - opcindy=tmp_9; - forall(eqL, - if(Toupper(substring(#,0,2))=="CO", - tmp=indexof(#,"="); - color=substring(#,tmp,length(#)); - if(substring(color,0,1)=="[", - color=parse(color); - if(length(color)==3, - tmp1="color->"+text(color); - , - tmp=Colorcode("rgb","cmyk",color); - tmp1="color->"+text(tmp); - ); - options=append(options,tmp1); - ); - options=remove(options,[#]); - cflg=1; - ); - ); - if(cflg==1, - Texcom("{"); - Setcolor(color); - ); - ReadCdata(var,file,options);// 17.05.24 - if(cflg==1, - Texcom("}"); - ); - ); -); - -Cheadsurf():=( - regional(cmd,jj,divL,sizeL,epsL,nf,var1,var2,tmp,tmp1,tmp2); - divL=ConstantListC_1; - sizeL=ConstantListC_2; - epsL=ConstantListC_3; - cmd=[]; - tmp="const double XMIN="+Sprintf(XMIN,6); - tmp=tmp+",XMAX="+Sprintf(XMAX,6)+";"; - cmd=append(cmd,tmp); - tmp="const double THETA="+Sprintf(THETA,6); - tmp=tmp+",PHI="+Sprintf(PHI,6)+";"; - cmd=append(cmd,tmp); - tmp=" //THETA:"+Sprintf(THETA*180/pi,2); - tmp=tmp+", PHI:"+Sprintf(PHI*180/pi,2)+";"; - cmd=append(cmd,tmp); - tmp1=apply(divL,text(#)); - tmp="const int Mdv="+tmp1_1+",Ndv="+tmp1_2+";"; - cmd=append(cmd,tmp); - tmp1=apply(sizeL,text(#)); - tmp="#define DsizeLL "+tmp1_1; - cmd=append(cmd,tmp); - tmp="#define DsizeL "+tmp1_2; - cmd=append(cmd,tmp); - tmp="#define DsizeM "+tmp1_3; - cmd=append(cmd,tmp); - tmp="#define DsizeS "+tmp1_4; - cmd=append(cmd,tmp); - tmp1=apply(epsL,format(#,7)); - tmp="const double Eps="+tmp1_1; - tmp=tmp+", Eps1="+tmp1_2; - tmp=tmp+", Eps2="+tmp1_3+";"; - cmd=append(cmd,tmp); - tmp="const char dirname[]="+Dq+Dirwork+"/"+Dq+";"; - cmd=append(cmd,tmp); - cmd=append(cmd,"double Urng[2],Vrng[2];"); - cmd=append(cmd, "int DrawE,DrawW,DrawS,DrawN;"); - cmd=append(cmd,"void rangeUV(short ch){"); - cmd=append(cmd," switch(ch){"); - forall(1..(length(FuncListC)),nf, - tmp2=" case "+text(nf)+" : "; - forall(4..5, - tmp1=FuncListC_nf_#; tmp=indexof(tmp1,"="); - tmp1=substring(tmp1,tmp+1,length(tmp1)-1); - tmp1=tokenize(tmp1,","); - if(#==4,tmp="Urng",tmp="Vrng"); - tmp2=tmp2+tmp+"[0]="+tmp1_1+";"+tmp+"[1]="+tmp1_2+";"; - ); - cmd=append(cmd,tmp2); - ); - cmd=append(cmd," }"); - cmd=append(cmd, "}"); - cmd=append(cmd,"void boundary(short ch){"); - cmd=append(cmd," switch(ch){"); - forall(1..(length(FuncListC)),nf, - tmp2=" case "+text(nf)+" : "; - tmp=FuncListC_nf_6; - tmp2=tmp2+"DrawE="; - if(indexof(tmp,"e")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;"); - tmp2=tmp2+"DrawW="; - if(indexof(tmp,"w")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;"); - tmp2=tmp2+"DrawS="; - if(indexof(tmp,"s")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;"); - tmp2=tmp2+"DrawN="; - if(indexof(tmp,"n")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;"); - cmd=append(cmd,tmp2); - ); - cmd=append(cmd," }"); - cmd=append(cmd,"}"); - tmp="void surffun(short ch,double u, double v, double p[3]){"; - cmd=append(cmd,tmp); - cmd=append(cmd," switch(ch){"); - forall(1..(length(FuncListC)),nf, - tmp2=" case "+text(nf)+" : "; - forall(1..3, - tmp1=FuncListC_nf_#; tmp=indexof(tmp1,"="); - tmp1=substring(tmp1,tmp,length(tmp1)); - tmp2=tmp2+"p["+text(#-1)+"]="+tmp1+";"; - ); - cmd=append(cmd,tmp2); - ); - cmd=append(cmd," }"); - cmd=append(cmd,"}"); - cmd; -); - -Ctopsurf(name):=Ctopsurf(name,[]); -Ctopsurf(name,cmdadd):=( - regional(path,cmd); - path=DirlibC+"/"; - path=replace(path,"\","/"); - cmd=[ - "#include <stdio.h>", "#include <math.h>", - "#include "+Dqq(Fhead+name+"header.h"), - "#include "+Dqq(path+"ketcommonhead.h"), - "#include "+Dqq(path+"ketcommon.h"), - "#include "+Dq+path+"surflibhead.h"+Dq, - "#include "+Dq+path+"surflib.h"+Dq, - "double cutfun1(short ch,double u, double v){", - " double p[3],val;", - " surffun(ch,u,v,p);", - " val=1;", - " return val;", - "}", - "double cutfun(short ch, int chcut, double u, double v){", - " double p[3],val;", - " switch(chcut){", - " case 1: val=cutfun1(ch,u,v);", - " }", - " return val;", - "}", - "int main(void){", - " double out[DsizeL][3], data[DsizeLL][3];", - " int i, j, nall, din[DsizeS][2];", - " char dirfname[256] = {'\0'};" - ]; - cmd; -); - -WritetoC(nm,header,main):=( - regional(hfile,mfile,top,body,tmp,tmp1,tmp2); - hfile=Fhead+nm+"header.h"; - mfile=Fhead+nm+".c"; - top=main_1; - body=main_2; - SCEOUTPUT=openfile(hfile); - forall(header, - println(SCEOUTPUT,#+"/**/"); - ); - closefile(SCEOUTPUT); - SCEOUTPUT=openfile(mfile); - forall(top, - println(SCEOUTPUT,#); - ); - println(SCEOUTPUT,"/**/"); - forall(body, - println(SCEOUTPUT,#+"/**/"); - ); - println(SCEOUTPUT," return 0;"); - println(SCEOUTPUT,"}"); - closefile(SCEOUTPUT); -); - -CalcbyC(name,cmd):=CalcbyC(name,PathC,cmd,[]); -CalcbyC(name,Arg1,Arg2):=( - if(isstring(Arg1), - CalcbyC(name,Arg1,Arg2,[]); - , - CalcbyC(name,PathC,Arg1,Arg2); - ); -); -CalcbyC(name,path,cmd,optionorg):=( - regional(options,eqL,strL,waiting,wflg,header,top,body, - wfile,hfile,mfile,flg,tmp,tmp1,tmp2,tmp3); - header=cmd_1; - top=cmd_2; - body=cmd_3; - options=optionorg; - tmp=divoptions(options); -// eqL=tmp_5; - strL=tmp_7; - waiting=30; - wfile="resultC"+Fhead+name+".txt"; - hfile=Fhead+name+"header.h"; - println(Dirwork); - println(hfile); - mfile=Fhead+name+".c"; - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - if(wflg==0, - tmp1=header; - if(!isexists(Dirwork,hfile),wflg=1); - if(wflg==0, - tmp2=load(hfile); - tmp2=tokenize(tmp2,"/**/"); - tmp2=tmp2_(1..(length(tmp2)-1)); - if(length(tmp1)!=length(tmp2),wflg=1); - ); - if(wflg==0, - forall(1..(length(tmp1)), - if(tmp1_#!=tmp2_#,wflg=1); - ); - ); - if(wflg==0, - tmp1=body; - if(!isexists(Dirwork+"/",mfile),wflg=1); - if(wflg==0, - tmp2=load(mfile); - tmp2=tokenize(tmp2,"/**/"); - tmp2=tmp2_(2..(length(tmp2)-1)); - if(length(tmp1)!=length(tmp2),wflg=1); - ); - if(wflg==0, - forall(1..(length(tmp1)), - if(tmp1_#!=tmp2_#,wflg=1); - ); - ); - ); - if(wflg==0,wflg=-1); - ); - if(wflg==1, - WritetoC(name,header,[top,body]); - SCEOUTPUT=openfile(wfile); - println(SCEOUTPUT,""); - closefile(SCEOUTPUT); - kcC(Fhead+name); - ); - flg=0; - tmp1=floor(waiting*1000/WaitUnit); - repeat(tmp1, - if(flg==0, - tmp=load(wfile); - if(length(tmp)>=4, - tmp2=substring(tmp,length(tmp)-4,length(tmp)); - if(tmp2=="////", - tmp=substring(tmp,0,length(tmp)-4); - flg=1; - tmp2=#*WaitUnit/1000; - ); - , - if(wflg==-1, - flg=-1; - , - wait(WaitUnit); - ); - ); - ); - if(flg<=0, - ErrFlag=1; - if(flg==-1, - println(wfile+" does not exist"); - , - if(flg==0, - tmp="("+text(waiting)+" s )"; - println(wfile+" not generated "+tmp); - ); - ); - ); - ); -); - -SfbdparadataC(nm,fd):= - SfbdparadataC(nm,fd,[],["nodisp"]); -SfbdparadataC(nm,fd,options):= - SfbdparadataC(nm,fd,options,["nodisp"]); -SfbdparadataC(nm,fdorg,optionorg,optionsh):=( -//help:SfbdparadataC("1",Fd); -//help:SfbdparadataC(options2=["r/m"]); - regional(funnm,fd,options,name2,name3,name2h,name3h,waiting, - eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg); - if(ChNumber==0,ChNumber=Ch); - fd=ConvertFdtoC(fdorg); - FuncListC=append(FuncListC,fd); - funnm=text(length(FuncListC)); - name2="sfbd2d"+nm; - name3="sfbd3d"+nm; - name2h="sfbdh2d"+nm; - name3h="sfbdh3d"+nm; - fname=Fhead+"sfbd"+nm+".txt"; - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=120; - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - options=remove(options,eqL); - options=remove(options,reL); - options=select(options,length(#)>0); - cmdL=[ - " double sfbd"+funnm+"[DsizeL][3];", - " char fname"+funnm+"[]="+Dqq(fname)+";", - " rangeUV("+funnm+");", - " boundary("+funnm+");", - " sfbdparadata("+funnm+",sfbd"+funnm+");", - " sprintf(dirfname,"+Dqq("%s%s")+",dirname,fname"+funnm+");", - " output3h("+Dqq("sfbd3d"+nm)+","+Dqq("sfbdh3d"+nm)+",dirfname,sfbd"+funnm+");"; - ]; - if(wflg==1,tmp1=append(options,"m")); - if(wflg==-1,tmp1=append(options,"r")); - if(ErrFlag==0, - tmp="sfbd"+nm; - CalcbyC(tmp,[Cheadsurf(),Ctopsurf(tmp),cmdL],tmp1); - ); - if(ErrFlag==1, - err("Sfbdparadata not completed"); - , - ReadOutData(fname); - GLIST=append(GLIST,"ReadOutData("+Dqq(fname)+")"); - if(islist(parse(name3)), - tmp1=name2+"=Projpara("+Dqq(name3)+",["; - tmp2=""; - if(length(options)>0, - forall(options, - tmp2=tmp2+Dqq(#)+","; - ); - tmp2=substring(tmp2,0,length(tmp2)-1); - ); - tmp1=tmp1+tmp2+"]);"; - parse(tmp1); - if(length(optionsh)==0,tmp2=["nodisp"],tmp2=optionsh); - tmp1=name2h+"=Projpara("+Dqq(name3h)+",["; - forall(tmp2, - tmp1=tmp1+Dqq(#)+","; - ); - tmp1=substring(tmp1,0,length(tmp1)-1)+"]);"; - parse(tmp1); - , - ErrFlag=1; - ); - ); -); - -CrvsfparadataC(nm,fk,fbdy,fd):= - CrvsfparadataC(nm,fk,fbdy,fd,[],["nodisp"]); -CrvsfparadataC(nm,fk,fbdy,fd,options):= - SfbdparadataC(nm,fk,fbdy,fd,options,["nodisp"]); -CrvsfparadataC(nm,Fk,Fbdy,fdorg,optionorg,optionsh):=( -//help:CrvsfparadataC("1","ax3d","sfbd3d1",Fd); -//help:CrvsfparadataC(options2=["r/m"]); -//help:CrvsfparadataC(optionsh=["nodisp"]); - regional(funnm,fd,options,name2,name3,name2h,name3h,waiting, - eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg,flg,ii,jj,eps); - eps=10^(-5); - fd=ConvertFdtoC(fdorg); - tmp=select(1..(length(FuncListC)),FuncListC_#==fd); - funcnum=tmp_1; - name2="crvsf2d"+nm; - name3="crvsf3d"+nm; - name2h="crvsfh2d"+nm; - name3h="crvsfh3d"+nm; - fname=Fhead+"crvsf"+nm+".txt"; - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=120; - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - options=remove(options,eqL); - options=remove(options,reL); - options=select(options,length(#)>0); -// tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2]; -// tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]); - tmp2=parse(Fbdy); - flg=0; - tmp=Fhead+Fbdy+".dat"; - if(!isexists(Dirwork,tmp),flg=1); - if(flg==0, - tmp1=ReadCdata(tmp); - if(length(tmp1)!=length(tmp2),flg=1); - if(flg==0, - forall(1..(length(tmp1)),ii, - if(length(tmp1_ii)!=length(tmp2_ii),flg=1); - forall(1..(length(tmp1_ii)),jj, - if(flg==0, - if(Norm(tmp1_ii_jj-tmp2_ii_jj)>eps,flg=1); - ); - ); - ); - ); - ); - if(flg==1,WriteCdata(tmp,Fbdy)); - tmp2=parse(Fk); - flg=0; - tmp=Fhead+Fk+".dat"; - if(!isexists(Dirwork,tmp),flg=1); - if(flg==0, - tmp1=ReadCdata(tmp); - if(length(tmp1)!=length(tmp2),flg=1); - if(flg==0, - forall(1..(length(tmp1)),ii, - if(length(tmp1_ii)!=length(tmp2_ii),flg=1); - forall(1..(length(tmp1_ii)),jj, - if(flg==0, - if(Norm(tmp1_ii_jj-tmp2_ii_jj)>eps,flg=1); - ); - ); - ); - ); - ); - if(flg==1,WriteCdata(tmp,Fk)); - cmdL=[ - " double fbdy[DsizeL][3],fk[DsizeL][3];", - " char fname"+nm+"[]="+Dqq(fname)+";", - " rangeUV("+funnm+");", - " boundary("+funnm+");", - " readdata3("+Dqq(Fhead+Fbdy+".dat")+",fbdy);", - " readdata3("+Dqq(Fhead+Fk+".dat")+",fk);", - " crvsfparadata(fk,fbdy, 0, out);", - " sprintf(dirfname,"+Dqq("%s%s")+",dirname,fname"+nm+");", - " output3h("+Dqq("crvsf3d"+nm)+","+Dqq("crvsfh3d"+nm)+",dirfname,out);" - ]; - if(wflg==1,tmp1=append(options,"m")); - if(wflg==-1,tmp1=append(options,"r")); - if(ErrFlag==0, - tmp="crvsf"+nm; - CalcbyC(tmp,[Cheadsurf(),Ctopsurf(tmp),cmdL],tmp1); - ); - if(ErrFlag==1, - err("Crvsfparadata not completed"); - , - ReadOutData(fname); - GLIST=append(GLIST,"ReadOutData("+Dqq(fname)+")"); - if(islist(parse(name3)), - tmp1=name2+"=Projpara("+Dqq(name3)+",["; - tmp2=""; - if(length(options)>0, - forall(options, - tmp2=tmp2+Dqq(#)+","; - ); - tmp2=substring(tmp2,0,length(tmp2)-1); - ); - tmp1=tmp1+tmp2+"]);"; - parse(tmp1); - if(length(optionsh)==0,tmp2=["nodisp"],tmp2=optionsh); - tmp1=name2h+"=Projpara("+Dqq(name3h)+",["; - forall(tmp2, - tmp1=tmp1+Dqq(#)+","; - ); - tmp1=substring(tmp1,0,length(tmp1)-1)+"]);"; - parse(tmp1); - , - ErrFlag=1; - ); - ); -); - -//help:end(); - diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r b/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r deleted file mode 100644 index a53dd021..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r +++ /dev/null @@ -1,14413 +0,0 @@ -# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -# -#This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/> - - -######################################### - -ThisVersion<- "KeTpic for R v5_2_4(18.02.26)" - -print(ThisVersion) - -# 2018.02.26 -# Sfcutparadata changed -# Partcrv3 debugged -# Projcurve rewritten -# Nohiddenparadata debugged -# PthiddenQ debugged -# 2018.02.24 -# Sfcutdata added ( for functions ) -# Meetpoints debugged (case Norm(PtB-PtA)<Eps0) -# 2018.02.23 -# Makevaltable2 added ( for functions ) -# 2018.02.23 -# Crvonsfparadata,Crv3onsfparadata added -# Wireparadata added -# 2018.02.22 -# PthiddenQ,Nohiddenpara2 changed (Eps2) -# 2018.02.21 -# PthiddenQ,Meetpoints debugged -# Crvsfparadata debugged (OTHERPARTITION) -# Partitionseg debugged (for non-list) and changed (Ns=0) -# Intersectcrvsf added -# 2018.02.19 -# Groupnearpt added -# Collectnear debugged -# Meetpoints,PthiddenQ debugged and changed (Groupnearpt used ) -# Parapt changed (for point list ) -# Partitionseg changed (remove close value ) -# Fullformfunc changed (Initialization of ADDPOINT) -# Addpoints added -# 2018.02.18 -# Projpara debugged ( for empty data, Mix replace ) -# WriteOutData debugged (for emply data ) -# Sfbdparadata,Cuspparadata debugged -# Meetpoints replaced -# 2018.02.17 -# PthiddenQ replaced -# 2018.02.15 -# Cancoordpara debugged (X=-... ) -# 2018.02.14 -# Paramoncrv,Pointoncrv renamed to ...curve -# 2018.02.12 -# Nohiddenpara2 debugged ( CUSPPT should be a list ) -# Dropnumlistcrv changed (Eps) -# 2018.02.11 -# Paramocrv debugged ( case N=Length(PtL) ) -# Sfbdparadata, Borderparadata, Makexybdy, Partitionseg, -# Evlptablepara, Fullformfunc, Dropnumlistcrv, Cuspsplitpara, -# PthiddenQ, Nohiddenpara2 added -# Crvsfparadata, Meetpoints, Clipdomain added -# 2018.02.10 -# Partcrv3 debugged -# 2018.02.09 -# Ptstart,Ptend changed ( for the case fig is empty) -# Norm changed (Dotprod used ) -# 2018.02.07 -# Collectnear debugged (Looprange ) -# Intersectcurves debugged (sum) -# 2018.02.06 -# Kukeiiwake debugged ( ParamonCurve -> Paramoncrv ) -# 2018.02.05 -# Dotprod changed ( crossprod not used ) -# Intersectpartseg changed ( case of length of result =1) -# 2018.02.04 -# Diff added ( func, withvar, (varnamevalue1,... )) -# Funvalue added ( for an expression ) -# 2018.02.02 -# Enclosing2 changed ( for distant curves, startpt option removed ) -# 2018.02.01 -# Intersectline,Intersectseg,...,Intersectcuves added -# Quicksort added -# Enclosing2 added (incomplete) -# 2018.01.29 -# Length added -# 2017.12.24 -# Objpolyhedron added -# 2017.12.23 -# Objsymb, symb3data added -# Objrecs, Objpolygon debugged -# Objthicksurf added -# 2017.12.22 -# Openobj,Closeobj,Writeobjpoint,Printobjstr,Objname,Objsurf added -# Crossprod added -# Objjoin, Objcurve, Objrecs, Objpolygon, Objsymb added -# Spacecurve debugged -# 2017.12.17 -# Setunitlen debugged ( MEMORI ) -# 2017.12.13 -# ReadOutData debugged -# 2017.12.11 -# Enclosing debugged ( appendrow -> Appendrow ) -# 2017.11.29 -# Anglemark, Arrowhead, Ovaldata debugged ( Circldeta included ) -# 2017.11.27 -# Anglemark changed ( Scilab 16.12.29) -# Plotdata,Paramplot,Spacecurve changed ( Scilab 16.12.13) -# Enclosing changed ( Scilab 16.10.09) -# Arrowhead,Arrowline changed ( Scilab 15.06.11) -# Definecolor added ( Scilab 15.05.04) -# 2017.11.26 -# Exprrot, Letterrot debugged ( `) -# 2017.11.24 -# Deqplot debugged (Looprange) -# 2017.11.20 -# InWindow debugged (for length=1) -# 2017.10.28 -# Openfile changed (Creator) -# 2017.10.23 -# ReadOutData greatly changed -# 2017.10.11 -# Drwpt debugged (Flattenlist ) -# 2017.10.08 -# Bezier debugged ( Num ) -# 2017.10.07 -# ReadOutData debugged ( for null data ) -# 2017.10.06 -# Deqdata, Deqplot added -# Connectseg remade(bug) -# 2017.09.30 -# Bezierpt, Bezier added -# 2017.09.29 -# Ptcrv debugged -# 2017.09.28 -# Openfile changed -# 2017.09.24 -# Circledata debugged -# Kyoukai changed (Eps) -# Shade updated -# 2017.09.22 -# Setcolor changed -# Plotdata,Paramplot,Spacecurve changed (N-1 -> N) -# 2017.09.21 -# Shade changed (Sci 17.01.09) -# 2017.09.17 -# Ovaldata,Assignadd changed -# Dist added -# Cicledata changed -# Bowdata debugged (Circledata,etc) - -# 2015.11.05 -# WriteOutData changed - -# 2015.10.29 -# WriteOutData changed ( endmark //// ) - -# 2015.10.24 -# ReadOutData changed ( in case of listlength=1 ) - -# 2014.12.23 -# ReadOutData added - -# 2014.12.17 -# WriteOutData added - -# 2014.0905 -# Unscaling debugged MARKLENI => MARKLEN -# 2014.03.31 -# PhHiddenData added -# 2014.03.30 -# Facesdata changed ( for Hiddendata ) -# 2014.03.23 -# MARKLEN separated, Rotate3data debugged - -# 2013.12.19 -# Openfile, Closefile, Bowname, Bownamerot - -# 2013.11.13 -# Arrowhead, Arrowheaddata - -# 2013.08.07 -# Cancoordpara added - -# 2013.08.07 -# Integrate added - -# 2013.05.20 -# Openfile changed - -# 2013.05.03 -# Tabledata, Pointdata changed -# Dividetable, Partframe added - -# 2013.02.10 -# Ketinit added - -# 2012.01.07 -# Arrowline, Arrowhead ( Cut implemented ) - -# 2011.12.18 -# Framedata ( compliant for list ) - -# 2011.12.12 -# Skeletonparadata... ( Flattellist used) - -# 2011.11.27 -# drwboxframe - -# 2011.11.07 -# metacommands added - -# 2011.11.02 -# Joingraphics ( for list structure ) - -# 2011.08.24 -# Setcolor ( c(1,0,0,0.5) etc ) -# Rotate3data ( Point is available ) - -# 2011.07.19 -# Drwline, Letter, Expr -# Drwboxplot( etc ) min,max => outliners -# Drwline ( unfinished in the case of "integer" ) - -# 2011.06.25 -# joincrvs debugged - -# synchro with ketpict2e - -# 2011.06.01 -# Bowdata debugged - -#2011.05.28 -# Ratiocmyk, Setcolor ( new ) - -#2011.04.28 -# Htickmark, Vtickmark debugged - -#2011.03.08 -# Drwboxframe debugged -# Putrow, Putrowexpr debugged (Dpos ) - -#2011.03.02 -# Tabledata ( index of hline ), PutcoL, PutcoLexpr ( "r",...) debugged -# Texcom changed ( // => backslash ) - -#2011.01.07 -# Dividegraphics, Splinedat are changed significantly -# Readtextdata is changed - -#2011.01.04 -# Derivative, Integrate are added - -#2010.12.07 -# Translatedata, Scaledata, Reflectdata changed ( efficient for vector ) -# Rotatedata changed ( deg : logical ) -# HIstplotdata, Drwhistplot ( type => freq , fpplot (added) ) - -# 2010.12.04 -# WindispT changed ( tickmark ) -# Lineplot changed ( mag=> length ) -# Plotdata debugged ( 'E=fun', 'D=') -# Enclosing changed (return PD) - -# 2010.12.02 -# WindispT changed -# Makecurves debugged - -# 2010.11.27 -# Pointdata changed ( efficient for matrix and data.frame ) -# WindispT -# Setwindow ( decide from data ) -# Assign debugged ( strsplit => gsub(fixed=T)) - -# 2010.11.20 -# Flattenlist, WindispT -# Splinedata changed( efficient for data.frame ) - -#2010.08.19 ( Maybe not finished ) -# Stripblanks -# Fullformfunc, Sf3data - -#2010.08.17 -# Phparadata, Phpersdata, Phspersdata, Phsparadata -# Facesdata, MakeveLfaceL, Menkakusi2 -# Rotate3data -# Skeletonpersdata, Skeletonpers3data, Makeskeletonpersdata -# Embed - -#2010.08.16 -# Spacecurve changed -# CameracoordCurve, Partcrv3, Projpers, CameraCurve, -# Perspt, Xyzaxpersname, Invperspt, Zparapt, Zperspt - -# 2010.08.15 -# Phcutoffdata added - -# 2010.08.13 -# Phcutdata, Spacecurve debugged -# Setangle changed - -# 2010.08.09 -# Spacecurve -# Rotate3data, Rotate3pt -# Phcutdata - -# 2010.08.08 -# Implementing 3d -# Initangle, Setangle, Setpers, SetstereoL, SetstereoR -# Mixlength -# Spaceline, Projpara, ProjCurve, Parapt -# Xyzax3data, Xyzaxparaname -# Cancoordpers, Invparapt, ProjcoordCurve -# Skeletonparadata, Skeletonpara3data, Makeskeletondata, Kukannozoki - -# 2010.07.25 -# Rotatedata changed -# Drwline changed (list of list) - -# 2010.04.09 -# Stat package added - -# 2010.04.02 -# Putcolexpr, Putrowexpr - -# 2010.04.02 - -# Windisp, Op changed -# Execmd added -# Texnewcmd, Texrenewcmd, Texend, -# Texctr, Texnewctr, Texsetctr -# Kyoukai debugged - -# 2010.01.20 -# Partcrv, Makeshasen : debugged - -# 2010.01.23 -# Ovaldata, Ovalbox added - -# 2010.01.27 -# Readtextdata changed -# Putrow, PutcoL debugged ( Putcol is OK) - -# 2010.01.31 -# Writetextdata added - -# 2010.02.12 -# Texvalctr, Texthectr added - -# 2010.02.22 -# Execmd changed - -# 2010.02.23 -# Op, Windisp changed - -# 2010.02.24 -# Execmd changed - -# 2010.03.07 -# Dotfilldata (Kosa>1) - -# 2010.03.21 -# Mixjoin -# Koutenlist (bug) - - -# 2010.03.24 -# Arrowhead ( bug in the case of "l" ) - -# 2010.03.28 -# Tabledata -# Diagcelldata ( New ) - -# 2010.03.30 -# Tabledata - -########################################### - -XMIN<- -5 -XMAX<- 5 -YMIN<- -5 ; YMAX<- 5 -ZIKU<- "line" -ARROWSIZE<- 1 -XNAME<- "$x$" -XPOS<- "e" -YNAME<- "$y$" -YPOS<- "n" -ONAME<- "O" -OPOS<- "sw" -ULEN<- "1cm" -MilliIn<- 1/2.54*1000 -PenThick<- round(MilliIn*0.02) -PenThickInit<- PenThick -TenSizeInit<<- 0.02*2 #17.10.07 -TenSize<- TenSizeInit -Wfile<-"" -MEMORI<- 0.05 -MEMORIInit<- MEMORI -MEMORINow<- MEMORI -MARKLEN<- 0.05 -MARKLENInit<- MARKLEN -MARKLENNow<- MARKLEN -GENTEN<- c(0,0) -YaSize<- 1 -YaAngle<- 18 -YaPosition<- 1 -YaThick<- 1 -YaStyle<- "tf" -PHI<- 30*pi/180 -THETA<- 60*pi/180 -FocusPoint<- c(0,0,0) -EyePoint<- c(5,5,5) -ASSIGNLIST<- list("`","'") - -SCALEX<- 1 -SCALEY<- 1 -LOGX<- 0 -LOGY<- 0 - -TEXFORLEVEL<- 0 -TEXFORLAST<- list() - -####################### - -Ketinit<- function(){ -XMIN<<- -5 -XMAX<<- 5 -YMIN<<- -5 ; YMAX<<- 5 -ZIKU<<- "line" -ARROWSIZE<<- 1 -XNAME<<- "$x$" -XPOS<<- "e" -YNAME<<- "$y$" -YPOS<<- "n" -ONAME<<- "O" -OPOS<<- "sw" -ULEN<<- "1cm" -MilliIn<<- 1/2.54*1000 -PenThick<<- round(MilliIn*0.02) -PenThickInit<<- PenThick -TenSizeInit<<- 0.02*2 #17.10.07 -TenSize<<- TenSizeInit -Wfile<<-"" -MEMORI<<- 0.05 -MEMORIInit<<- MEMORI -MEMORINow<<- MEMORI -MARKLEN<<- 0.05 -MARKLENInit<<- MARKLEN -MARKLENNow<<- MARKLEN -GENTEN<<- c(0,0) -YaSize<<- 1 -YaAngle<<- 18 -YaPosition<<- 1 -YaThick<<- 1 -YaStyle<<- "tf" -PHI<<- 30*pi/180 -THETA<<- 60*pi/180 -FocusPoint<<- c(0,0,0) -EyePoint<<- c(5,5,5) -ASSIGNLIST<<- list("`","'") - -SCALEX<<- 1 -SCALEY<<- 1 -LOGX<<- 0 -LOGY<<- 0 - -TEXFORLEVEL<<- 0 -TEXFORLAST<<- list() -} - -#------------------------------------------------------- - -Appendrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Out<-c() - Nc<- 0 - for (I in 1:Nargs) - { - Dt<- varargin[[I]] - Nc<- max(Nc,Ncol(Dt)) - if(class(Dt)=="matrix") Dt<-as.numeric(t(Dt)) - Out<- c(Out,Dt) - } - if(Nc>0) - { - Out<-matrix(Out, nrow=Nc) - Out<-t(Out) - } - else - { - Out<-c() - } - return(Out) -} - -Crossprod<-function(a,b) -{ - if(length(a)==3) - { - Tmp1<-a[2]*b[3]-a[3]*b[2] - Tmp2=a[3]*b[1]-a[1]*b[3] - Tmp3=a[1]*b[2]-a[2]*b[1] - Out=c(Tmp1,Tmp2,Tmp3) - } - else - { - Out=a[1]*b[2]-a[2]*b[1] - } - return(Out) -} - -Datalength<-function(Data) -{ - if(length(Data)==0) return(0) - if(mode(Data)=="numeric") return(Nrow(Data)) - if(mode(Data)=="character") return(nchar(Data)) - if(mode(Data)=="list") return(length(Data)) -} - -Crossprod<- function (a,b){ # 17.12.22 - if(length(a)==3){ - Tmp1=a[2]*b[3]-a[3]*b[2] - Tmp2=a[3]*b[1]-a[1]*b[3] - Tmp3=a[1]*b[2]-a[2]*b[1] - Out=c(Tmp1,Tmp2,Tmp3) - }else{ - Out=a[1]*b[2]-a[2]*b[1] - } -} - -Dotprod<-function(a,b){ # 18.02.05 - nn=min(length(a),length(b)) - out=0 - for(jj in Looprange(1,nn)){ - out=out+a[jj]*b[jj] - } - return(out) -} - -Dist<- function(...) # 17.09.17 -{ - varargin<- list(...) - a=varargin[[1]] - if(length(varargin)==1){ - tmp=sqrt(Dotprod(a,a)) - return(as.vector(tmp)) - } - else{ - b=varargin[[2]] - tmp=sqrt(Dotprod(b-a,b-a)) - retun(as.vector(tmp)) - } -} - -Member<-function(A,L) -{ - N<-length(L); - if(length(N)==0) return(FALSE) - for (I in 1:N) - { - if(class(L)=="list") - { - Tmp<-L[[I]] - } - else - { - Tmp<-L[I] - } - if(mode(A)=="numeric") - { - if(Norm(A-Tmp)==0) return(TRUE) - } - else - { - if(A==Tmp) return(TRUE) - } - } - return(FALSE) -} - -Norm<-function(V) -{ - Tmp=Dotprod(V,V) #18.02.09 -# Tmp<-as.vector(V); -# Tmp<-crossprod(Tmp,Tmp) - Tmp<-sqrt(Tmp) -# as.numeric(Tmp) -} - -Ncol<-function(P) -{ - if(class(P)=="matrix") return(ncol(P)) - else return(length(P)) -} - -Nrow<-function(P) -{ - if(length(P)==0) return(0) - if(class(P)=="matrix") return(nrow(P)) - else return(1) -} - -Looprange<- function(a,b) -{ -if(a<=b) return(a:b) -return(c()) -} - -Stripblanks<- function(Ch){ - Tmp<- gsub(" ","",Ch,fixed=TRUE) - return(Tmp) -} - -Quicksort<- function(seqL,key){ #18.02.01 - if(length(seqL)<2){ - out=seqL - }else{ - tmp1=Op(1,seqL) - tmp2=Op(2,seqL) - if(Op(key,tmp1)>=Op(key,tmp2)){ - pivot = tmp1 - }else{ - pivot=tmp2 - } - left = list() - right = list() - for(ii in 1:length(seqL)){ - tmp=Op(ii,seqL) - if(Op(key,tmp)< Op(key,pivot)){ - left=c(left,list(tmp)) - }else{ - right=c(right,list(tmp)) - } - } - left = Quicksort(left,key) - right = Quicksort(right,key) - out=c(left,right) - } - return(out) -} - -Derivative<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Fstr<- varargin[[1]] - Vstr<- varargin[[2]] - NvaL<- length(Vstr) - Flg<- 0 - if(Nargs>=3){ - VaL<- varargin[[3]] - Flg<- 1 - } - Str<- paste("deriv(~",Fstr,",c('",Vstr[1],"'",sep="") - for(J in Looprange(2,NvaL)){ - Str<- paste(Str,",'",Vstr[J],"'",sep="") - } - Str<- paste(Str,")",sep="") - if(NvaL<=3){ - Str<- paste(Str,",func=TRUE)",sep="") - } - else{ - Str<- paste(Str,")",sep="") - } - f<- eval(parse(text=Str)) - if(Flg==1){ - if(NvaL<=3){ - if(NvaL==1){V<- f(VaL[1])} - if(NvaL==2){V<- f(VaL[1],VaL[2])} - if(NvaL==3){V<- f(VaL[1],VaL[2],VaL[3])} - } - else{ - for(J in 1:NvaL){ - Tmp<- paste(Vstr[J],'<-',as.character(VaL[J])) - eval(parse(text=Tmp)) - } - V<- eval(f) - } - Out<- attr(V,'gradient') - Out<- Out[1,] - } - else{ - Out<- f - } - return(Out) -} - -Diff<- function(...){ #18.02.04 - varargin=list(...) - Nargs=length(varargin) - fun=varargin[[1]] - withvar=varargin[[2]] - tmp=paste("f<- expression(",fun,")",sep="") - eval(parse(text=tmp)) - nn=nchar(withvar) - for(jj in Looprange(1,nn)){ - tmp=substring(withvar,jj,jj) - f=D(f,tmp) - } - var=c() - val="" - for(jj in Looprange(3,Nargs)){ - tmp=strsplit(varargin[[jj]],"=") - var=c(var,tmp[[1]][1]) - val=paste(val,tmp[[1]][2],",",sep="") - } - if(Length(val)>1){ - val=substring(val,1,Length(val)-1) - f=deriv(f,var,func=TRUE) - tmp=paste("out=f(",val,")",sep="") - out=eval(parse(text=tmp)) - return(out[1]) - }else{ - return(f) - } -} - -Funvalue<- function(...){ - varargin=list(...) - Nargs=length(varargin) - df=varargin[[1]] - var=c() - val="" - for(jj in Looprange(2,Nargs)){ - tmp=strsplit(varargin[[jj]],"=") - var=c(var,tmp[[1]][1]) - val=paste(val,tmp[[1]][2],",",sep="") - } - val=substring(val,1,Length(val)-1) - dfun=deriv(df,var,func=TRUE) - tmp=paste("out=dfun(",val,")",sep="") - eval(parse(text=tmp)) - return(out[1]) -} - -Integrate<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Fstr<- varargin[[1]] - Vstr<- varargin[[2]] - IntvL<- varargin[[3]] - Str<- 'Tmpfun<- function(' - Str<- paste(Str,Vstr,'){',sep='') - Str<- paste(Str,Fstr,'}',sep='') - eval(parse(text=Str)) - Tmpfunv<- function(x){sapply(x,Tmpfun)} - Out<- 0 - for (J in 1:(length(IntvL)-1)){ - Tmp<- integrate(Tmpfunv,IntvL[J],IntvL[J+1]) - Out<- Out+Tmp[[1]] - } - return(Out) -} - -#-------------------------------------- - -######################### - -Anglemark<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-3) - PA<- varargin[[1]] - PB<- varargin[[2]] - PC=varargin[[3]] - r <- 0.5 - if(Nargs>=4){ - r<- varargin[[4]]*r - } - Out=c() - if(r>min(Norm(PA-PB),Norm(PC-PB))){ - return(Out) - } - Cir<- Circledata(c(PB,r)) #17.11.29 - Tmp<- IntersectcrvsPp(Cir,Listplot(PA,PB)) - P1<- Op(2,Op(1,Tmp)) - Tmp<- IntersectcrvsPp(Cir,Listplot(PC,PB)) - P2<- Op(2,Op(1,Tmp)) - if(abs(P1-P2)<Eps){ - Out<-c() - return(Out) - } - if(P1<P2-Eps){ - Out<- Partcrv(P1,P2,Cir) - } - else{ - Tmp<- Numptcrv(Cir) - Tmp1<- Partcrv(P1,Tmp,Cir) - Tmp2<- Partcrv(1,P2,Cir) - Out<- Joincrvs(Tmp1,Tmp2) - } -} - -############################################## - -Arrowdata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - Q<- varargin[[2]] - R<- Q - Futosa<- YaThick - Ookisa<- YaSize - Thickness<- 1 - Hiraki<- YaAngle - Yapos<- YaPosition - Position<- 1 - Str<- YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - if(length(Tmp)>1){ - R<- Tmp - } - else{ - if(Flg==0){ - Ookisa<- Ookisa*Tmp - } - if(Flg==1){ - if(Tmp<5){ - Hiraki<- Tmp*Hiraki - } - else{ - Hiraki<- Tmp - } - } - if(Flg==2){ - R<- P+Tmp*(Q-P) - } - else{ - R<- P+Yapos*(Q-P) - } - if(Flg==3){ - Futosa<- Tmp - } - Flg<- Flg+1 - } - } - if(mode(Tmp)=="character"){ - Tmp<- grep("=", Tmp) - if(length(Tmp)>0){ - eval(parse(text=Tmp)) - Futosa<- Futosa*Thickness - R<- P+Position*(Q-P) - } - else{ - Str<- Tmp - } - } - } - Tmp1<- Listplot(c(P,Q)) - Tmp2<- Arrowheaddata(R,Q-P,Ookisa,Hiraki,Futosa,Str) - Out<- Joingraphics(Tmp1,Tmp2) -} - -###################################### - -# 2013.11.13 No Intersect debugged - -Arrowhead<-function(...) -{ ## Scaling is implemented - ## 12.01.08 Kirikomi - varargin<-list(...) - Nargs<-length(varargin) - P<-varargin[[1]] - Houkou<-varargin[[2]] - Ookisa<-0.2*YaSize - Hiraki<-YaAngle - Futosa<-0.5*YaThick - Cut<- 0 - Str<-YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<-varargin[[I]] - if(is.character(Tmp)){ - Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from - if(length(Equal)>0){ - Tmp1<- strsplit(Tmp,"=",fixed=TRUE) - Tmp2<- Tmp1[[1]] - if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ - Tmp<- paste("Cut=",Tmp2[2],sep="") - eval(parse(text=Tmp)) - } - }else{ - Str<- Tmp - } # 12.01.07 upto - } - if(is.numeric(Tmp) && length(Tmp)==1){ - if(Flg==0) Ookisa<-Ookisa*Tmp - if(Flg==1){ - if(Tmp<5) Hiraki<-Tmp*Hiraki - else Hiraki<-Tmp - } - if(Flg==2) Futosa<-Tmp - Flg<-Flg+1 - } - } - Ookisa<-1000/2.54/MilliIn*Ookisa - Theta<-Hiraki*pi/180 - if(Nrow(Houkou)>1){ - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Tmp<-Nearestpt(P,Houkou) - A<-Tmp[[1]] - I<-floor(Tmp[[2]]) - G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 - Flg<- 0 # 13.11.13 - JL<-seq(I,1,by=-1) - for (J in JL){ - B<-Ptcrv(J,Houkou) - Tmp<-IntersectcrvsPp(Listplot(list(A,B)),G) - if(length(Tmp)>0){ - Flg<- 1 - break - } - A<-B - } - if(Flg==0){ # 13.11.13 - print("Arrowhead may be too large (no intersect)") - return(P) - } - Houkou<-P-Op(1,Tmp[[1]]) - Houkou<- Unscaling(Houkou) - P<- Unscaling(P) - } - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Ev<--1/Norm(Houkou)*Houkou - Nv<-c(-Ev[2],Ev[1]) - if(length(grep("c",Str))>0){ - P<-P-0.5*Ookisa*cos(Theta)*Ev - } - if(length(grep("b",Str))>0){ - P<-P-Ookisa*cos(Theta)*Ev - } - A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv - B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv - if(length(grep("l",Str))>0){ - Tmp<-Listplot(list(A,P,B)) - Tmp1<- Unscaling(Tmp) - Drwline(Tmp1,Futosa) - } - else{ - C<- P+(1-Cut)*((A+B)/2-P) # 12.01.07 - Tmp<- Listplot(list(A,P,B,C,A)) # 12.01.07 - Tmp1<- Unscaling(Tmp) - Shade(Tmp1) - Tmp=Listplot(c(A,P,B,C,A,P)) # 15.6.20 - Tmp1=Unscaling(Tmp) - Drwline(Tmp1,0.1) # 15.06.11, 15.06.14 - } -} - -############################################ - -# 2013.11.13 No intersect debugged - -Arrowheaddata<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - Houkou<- varargin[[2]] - Ookisa<- 0.2*YaSize - Hiraki<- YaAngle - Futosa<- 0 - Thickness<- 1 - Str<- YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<-varargin[[I]] - if(mode(Tmp)=="character"){ - Tmp1<-grep("=",Tmp) - if(length(Tmp1)>0){ - eval(parse(text=Tmp)) - Futosa<- Thickness - } - else{ - Str<- Tmp - } - } - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - if(Flg==0) Ookisa<-Ookisa*Tmp - if(Flg==1){ - if(Tmp<5) Hiraki<-Tmp*Hiraki - else Hiraki<-Tmp - } - if(Flg==2) Futosa<-Tmp - Flg<-Flg+1 - } - } - Theta<- Hiraki*pi/180 - if(Nrow(Houkou)>1){ - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Tmp<-Nearestpt(P,Houkou) - A<-Tmp[[1]] - I<-floor(Tmp[[2]]) - G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 - Flg<- 0 # 13.11.13 - JL<-seq(I,1,by=-1) - for (J in JL){ - B<- Ptcrv(J,Houkou) - Tmp<- IntersectcrvsPp(Listplot(list(A,B)),G) - if(length(Tmp)>0){ - Flg<- 1 - break - } - A<-B - } - if(Flg==0){ # 13.11.13 - print("Arrowhead may be too large (no intersect)") - return(P) - } - Houkou<-P-Op(1,Tmp[[1]]) - Houkou<- Unscaling(Houkou) - P<- Unscaling(P) - } - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Ev<- -1/Norm(Houkou)*Houkou - Nv<- c(-Ev[2],Ev[1]) - if(length(grep("c",Str))>0){ - P<-P-0.5*Ookisa*cos(Theta)*Ev - } - if(length(grep("b",Str))>0){ - P<-P-Ookisa*cos(Theta)*Ev - } - A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv - B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv - Tmp<- Listplot(A,P,B) - Out<- Unscaling(Tmp) - return(Out) -} - -########################################## - -Arrowline<- function(...) -{ # 12.01.07 kirikomi - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - Q<- varargin[[2]] - Futosa<- YaThick - Ookisa<- YaSize - Hiraki<- YaAngle - Yapos<- YaPosition - Cutstr<- "Cut=0" - Str<- YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - if(is.character(Tmp)){ - Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from - if(length(Equal)>0){ - Tmp1<- strsplit(Tmp,"=") - Tmp2<- Tmp1[[1]] - if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ - Tmp<- paste("Cut=", Tmp2[2],sep="") - Cutstr<- Tmp - } - } - else{ - Str<- Tmp - } # 12.01.07 upto - } - if(is.numeric(Tmp) && length(Tmp)==1){ - if(Flg==0) Ookisa<- Ookisa*Tmp - if(Flg==1){ - if(Tmp<5) Hiraki<- Tmp*Hiraki - else Hiraki<- Tmp - } - if(Flg==2) Yapos<- Tmp - if(Flg==3) Futosa<- Tmp - Flg<- Flg+1 - } - } - R<- P+Yapos*(Q-P) - Tmp=Q-Unscaling(0.2*Ookisa/2*(Q-P)/Norm(Q-P)) # 15.10.24 - Drwline(Listplot(c(P,Tmp)),Futosa) - Arrowhead(R,Q-P,Ookisa,Hiraki,Futosa,Cutstr,Str) -} - -######################################### - -Assign<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - ASSIGNLIST<<- list("`",Prime()) - Out<- ASSIGNLIST - return() -# return("Assign reset done"); - } - L<- list("`","'") - if(Nargs%%2==0){ - L<- Mixjoin(L,varargin) - ASSIGNLIST<<- L - Out<- L - return() -# return("Assign set done"); - } - if(Nargs==1){ - Fnstr<- varargin[[1]] - if(nchar(Fnstr)==0){ # case of "" - L<- ASSIGNLIST - Out<- c() - for (I in seq(1,length(L),by=2)){ - Tmp1<- L[[I]] - Tmp2<- L[[I+1]] - if(length(Tmp2)==1){ - Tmp3<- as.character(Tmp2) - } - else{ - if(mode(Tmp2)=="character"){ - Tmp3<- Tmp2 - } - else if(mode(Tmp2)=="list"){ - Tmp3<- makeliststr(Tmp2) - } - else if(mode(Tmp2)=="numeric"){ - Tmp3<- "c(" - for (J in Looprange(1,length(Tmp2))){ - Tmp3<- paste(Tmp3,as.character(Tmp2[J]),sep="") - if(J<length(Tmp2)){ - Tmp3<- paste(Tmp3,",",sep="") - } - } - Tmp3<- paste(Tmp3,")",sep="") - if(class(Tmp2)=="matrix"){ - Nr<- as.character(nrow(Tmp2)) - Tmp3<- paste("matrix(",Tmp3,"nrow=",Nr,")",sep="") - } - } - } - Tmp<- paste(Tmp1,"=",Tmp3,sep="") - Out<- c(Out,Tmp) - } - return(Out); - } - if(substr(Fnstr,1,1)=="?"){ - Fnstr<- substr(Fnstr,2,nchar(Fnstr)) - for (I in seq(1,length(ASSIGNLIST),by=2)){ - Tmp<- ASSIGNLIST[[I]] - if(Tmp==Fnstr){ - Out<- Mixjoin(list(I),ASSIGNLIST[I+1]) - return(Out) - } - } - Out<- "Not found" - return(Out); - } - L<- ASSIGNLIST - } - else{ - if(mode(varargin[[2]])=="numeric"){ - Fnstr<- varargin[[Nargs]] - for (I in Looprange(1,Nargs-1)){ - L[[I]]=varargin[[I]] - } - } - else{ - Fnstr<- varargin[[1]] - for (I in Looprange(2,Nargs)){ - L[[I-1]]<- varargin[[I]] - } - } - } - for (I in seq(1,length(L),by=2)){ - Vname<- L[[I]] - Val<- L[[I+1]] - if(mode(Val)=="numeric"){ - if(Nrow(Val)==1){ - for (K in Looprange(1,length(Val))){ - Tmp<- paste(Vname,"[", as.character(K),"]",sep="") - if(mode(Val[K])=="numeric"){ - Tmp1<- paste("(",as.character(Val[K]),")",sep="") - } - else{ - Tmp1<- Val[K] - } - Fnstr<- gsub(Tmp,Tmp1,Fnstr,fixed=TRUE) - } - } - else{ - for (J in Looprange(1,Nrow(Val))){ - for (K in Looprange(1,Ncol(Val))){ - Tmp<- paste(Vname,"(",as.character(J),",",as.character(K),")",sep="") - if(mode(Val[J,K])=="numeric"){ - Tmp1<- paste("(",as.character(Val[J,K]),")",sep="") - } - else{ - Tmp1<- Val[J,K] - } - Fnstr<- gsub(Tmp,Tmp1,Fnstr,fixed=TRUE) - } - } - } - if(length(Val)==1){ - Rep<- as.character(Val) - } - else{ - Rep<-"" - if(class(Val)=="matrix"){ - Rep<- "matrix(" - } - Rep<- paste(Rep,"c(",sep="") - for (J in Looprange(1,length(Val))){ - Rep<- paste(Rep,as.character(Val[J]),sep="") - if(J<length(Val)){ - Rep<- paste(Rep,",",sep="") - } - else{ - Rep<- paste(Rep,")",sep="") - } - } - if(class(Val)=="matrix"){ - Rep<- paste(Rep,",nrow=",as.character(nrow(Val)),")",sep="") - } - } - Tmp1<- paste("(",Rep,")",sep="") - } - if(mode(Val)=="character"){ - Tmp1<- Val - } - if(mode(Val)=="list"){ - Tmp1<- Makeliststr(Val) - } - Fnstr<- gsub(Vname,Tmp1,Fnstr,fixed=TRUE) # 10.11.20 - } - return(Fnstr) -} - -######################################### - -Assignadd<- function(...) -{ - varargin<- list(...) - L<- ASSIGNLIST - L<- Mixjoin(L,varargin) - ASSIGNLIST<<- L -# return("assign add done"); #17.09.17 -} - -######################################### - -Assignrep<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - L<- ASSIGNLIST - for (I in seq(1,Nargs,by=2)){ - Vname<- varargin[[I]] - Val<- varargin[[I+1]] - Tmp1<- paste("?",Vname,sep="") - Tmp<- Assign(Tmp) - if(mode(Tmp)=="character"){ - next - } - I<- Tmp[[1]] - L<- Mixjoin(L,list(Val)) - } - ASSIGNLIST<<- L -} - -######################################### - - Assignset<- function(...) -{ - Assign(...) -} - -######################################### - -Beginpicture<-function(ul) -{ ## Scaling is implemented - Tmp<- Doscaling(c(XMIN,YMIN)) - Xm<- Tmp[1] - Ym<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - XM<- Tmp[1] - YM<- Tmp[2] - Dx<- XM-Xm - Dy<- YM-Ym - Sym<-".0123456789 +-*/" - SL<-Sym - OL<-"+-*/" - if(ul!=""){ - ULEN<<-ul; - } - Is<-1; - VL<-""; - Ucode<-ULEN - for (I in Looprange(1,nchar(Ucode))){ - C<-substring(Ucode,I,I); - if(length(grep(C,SL))>0){ - if(length(grep(C,OL))>0){ - Tmp<-substring(Ucode,Is,I-1); - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1; - } - } - else{ - Unit<-substring(Ucode,I,I+1) - Str<-substring(Ucode,Is,I-1) - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)) - Str<-as.character(Valu); - ULEN<<- paste(Str,Unit,sep="") - if(Unit=="cm") MilliIn<<-1000/2.54*Valu - if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if(Unit=="in") MilliIn<<-1000*Valu - if(Unit=="pt") MilliIn<<-1000/72.27*Valu - if(Unit=="pc") MilliIn<<-1000/6.022*Valu - if(Unit=="bp") MilliIn<<-1000/72*Valu - if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; - if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; - Str<-paste("{\\unitlength=",ULEN,"%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("\\begin{picture}%\n",file=Wfile,append=TRUE) - Str<-"(" - Tmp<-as.character(round(Dx,digits=6)) - Str<-paste(Str,Tmp,",",sep="") - Tmp<-as.character(round(Dy,digits=6)) - Str<-paste(Str,Tmp,")(",sep="") - Tmp<-as.character(round(Xm,digits=6)) - Str<-paste(Str,Tmp,",",sep="") - Tmp<-as.character(round(Ym,digits=6)) - Str<-paste(Str,Tmp,")%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - Str<-paste("\\special{pn ",as.character(PenThickInit),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -################################################# - -Bowdata<- function(...) #17.09.17 -{ - varargin <- list(...) - Nargs <- length(varargin) - PA <- varargin[[1]] - PB <- varargin[[2]] - Cut <- 0 - D <- 1/2*Norm(PB-PA) - if(Nargs>=3) { - H <- varargin[[3]]*D*0.2 - } - else { - H <- D*0.2 - } - H <- min(H,D) - if(Nargs>=4){ - Cut <- varargin[[4]] - } - Ydata <- MakeBowdata(PA,PB,H) - C <- Op(1,Ydata) - r <- Op(2,Ydata) - R1 <- Op(3,Ydata) - R2 <- Op(4,Ydata) - Rng <- paste("R=c(",as.character(R1),",",as.character(R2),")",sep="") - Theta <- (R1+R2)*0.5 - BOWMIDDLE <<- list(c(C[1]+r*cos(Theta),C[2]+r*sin(Theta)),Theta) - M <- Op(1,BOWMIDDLE) - ThetaM <- Op(2,BOWMIDDLE) - BOWSTART <<- PA - BOWEND <<- PB - if(Cut==0){ - Pd<- Circledata(c(C,r),Rng) - } - else{ - Alpha <- R1; Beta <- ThetaM-Cut/(2*r) - Rng <- paste("Rng=c(",as.character(Alpha),",",as.character(Beta),")",sep="") - Pd <- Circledata(c(C,r),Rng) - Alpha <- ThetaM+Cut/(2*r); Beta <- R2 - Rng <- paste("R=c(",as.character(Alpha),",",as.character(Beta),")",sep="") - Tmp <- Circledata(c(C,r),Rng) - Pd <- Appendrow(Pd,c(Inf,Inf),Tmp) - } -} - -Bowmiddle <- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - if( Nargs==0) { - M <- BOWMIDDLE - return(M) - } - if(Nargs==1) { - Bdata <- varargin[[1]] - A <- Bdata[1,] - Dind <- Dataindex(Bdata) - Dc <- Nrow(Dind) - Tmp <- Dind[Dc,2] - B <- Bdata[Tmp,] - if(Dc==1) { - Tmp1 <- round(Tmp/2) - } - else { - Tmp1 <- Dind[1,2] - } - D <- Bdata[Tmp1,] - B <- B-A - D <- D-A - Tmp1 <- B[1]*D[2]-D[1]*B[2] - Tmp2 <- (Norm(B)^2*D[2]-B[2]*Norm(D)^2)/2 - Tmp3 <- -(Norm(B)^2*D[1]-B[1]*Norm(D)^2)/2 - C <- c(Tmp2,Tmp3)/Tmp1+A - R <- Norm(C-A) - B <- B+A - V <- (A+B)/2-C - V <- V/Norm(V) - M <- C+R*V - } - else { - A <- varargin[[1]]; B <- varargin[[2]] - D <- 1/2*Norm(B-A) - H <- 0.2*D; - if(length(varargin)>=3) { - Tmp <- varargin[[3]] - H <- Tmp*D*0.2 - } - H <- min(H,D) - Ydata <- MakeBowdata(A,B,H) - C <- Op(1,Ydata) - R <- Op(2,Ydata) - T <- (Op(3,Ydata)+Op(4,Ydata))/2 - P <- C+R*c(cos(T),sin(T)) - #M <- list(P,T) - M <- P - } - return(M) -} - -########################## -# 13.12.19 small movement supported - -Bowname<- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - Siki <- varargin[[Nargs]] - Nargs<- Nargs-1 - Dr<- "c" - if(Nargs>=1){ - Tmp<- varargin[[Nargs]] - if(is.character(Tmp)){ - Dr<- Tmp - Nargs<- Nargs-1 - } - } - if(Nargs==0){ - Siki <- varargin[[1]] - P <- Op(1,BOWMIDDLE) - } - else if(Nargs==1){ - Bdata <- varargin[[1]] - P <- Bowmiddle(Bdata) - } - else{ - A <- varargin[[1]]; B <- varargin[[2]] - D <- 1/2*Norm(B-A) - Tmp <- varargin[[3]] - if(is.character(Tmp)){ - H <- D*0.2 - } - else { - H <- Tmp*D*0.2 - } - H <- min(H,D) - Ydata <- MakeBowdata(A,B,H) - Tmp <- Bowmiddle(Ydata) - P <- Op(1,Tmp) - } - Expr(P,Dr,Siki) -} - -########################## -# 13.12.19 small movement supported -# A,B, ... no longer supported - -Bownamerot <- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - Eps <- 10^(-6) - Flg <- 1 - Tmp <- varargin[[Nargs]] - if(is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){ - Flg <- Tmp - Nargs <- Nargs-1 - } - Siki <- varargin[[Nargs]] - Nargs<- Nargs-1 - Dr<- "c" - if(Nargs>=1){ - Tmp<- varargin[[Nargs]] - if(is.character(Tmp)){ - Dr<- Tmp - Nargs<- Nargs-1 - } - } - if(Nargs==0) { - P <- Op(1,BOWMIDDLE) - A <- BOWSTART - B <- BOWEND - } - else{ - Bdata<- varargin[[1]] - P<- Bowmiddle(Bdata) - A=Bdata[1,] - B=Bdata[nrow(Bdata),] - Tm<- 0; Tv<- 0 - if(Nargs>1){ - Tm<- varargin[[2]] - if(Nargs>2){ - Tv<- varargin[[3]] - } - } - } -# else if(Nargs==2) { -# Bdata <- varargin[[1]] -# P <- Bowmiddle(Bdata) -# A <- Bdata[1,] -# B <- Bdata[Nrow(Bdata),] -# Siki <- varargin[[2]] -# } -# else { -# A <- varargin[[1]]; B <- varargin[[2]] -# D <- 1/2*Norm(B-A) -# Tmp <- varargin[[3]] -# if(mode(Tmp)=="character") { -# H <- 0.2*D; Siki <- Tmp -# } -# else { -# H <- Tmp*D*0.2; Siki <- varargin[[4]] -# } -# H <- min(H,D) -# Ydata <- MakeBowdata(A,B,H) -# C <- Op(1,Ydata) -# R <- Op(2,Ydata) -# T <- (Op(3,Ydata)+Op(4,Ydata))/2 -# P <- C+R*c(cos(T),sin(T)) -# } - if(A[1]>B[1]+Eps){ - Tmp <- A - A <- B - B <- Tmp - } - if(Flg>0) { - Tmp <- B-A - } - else{ - Tmp <- A-B - } - Exprrot(P,Tmp,Tm,Tv,Siki) -} - -CalcHeight<-function(Hoko,Moji) -{ - D<-0 - H<-substring(Hoko,1,1) - Tmp<-paste("\\settoheight{\\Height}{",Moji,"}",sep="") - Str<-c(Tmp) - Tmp=paste("\\settodepth{\\Depth}{",Moji,"}",sep="") - Str<-c(Str,Tmp) - if(H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}") - if(H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}") - if(H=="c") - { - Str<-c(Str,"\\setlength{\\Height}{-0.5\\Height}") - Str<-c(Str,"\\setlength{\\Depth}{0.5\\Depth}") - Str<-c(Str,"\\addtolength{\\Height}{\\Depth}") - } - for (I in 1:length(Str)) cat(Str[I],file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################### - -CalcWidth<-function(Hoko,Moji) -{ - D<-0; - H<-substring(Hoko,2,2) - if(H=="e") D<-0 - if(H=="w") D<--1.0 - if(H=="c") D<--0.5 - Str1<-paste("\\settowidth{\\Width}{",Moji,"}",sep="") - Tmp<-as.character(D) - Str2<-paste("\\setlength{\\Width}{",Tmp,"\\Width}",sep="") - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################### -# 17.09.17 -# 17.09.24 - -Circledata<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Cr<- varargin[[1]] - C=Cr[1:2] - if(length(Cr)==4){ - ra=Norm(C-Cr[3:4]) - Nop=2 - } - else{ - ra=Cr[3] - Nop=2 - } - R=c(0,2*pi) - N=50 - for (I in Looprange(Nop,Nargs)){ - Tmp<- varargin[[I]] - if(is.character(Tmp)){ - Tmp1=regexpr("=",Tmp) #17.09.24from - Tmp2=substring(Tmp,Tmp1+1,nchar(Tmp)) - Tmp1=substring(Tmp,1,Tmp1) - Tmp1=gsub("NUM", "N", toupper(Tmp1)) - Tmp1=gsub("RNG", "R", Tmp1) - Tmp=paste(Tmp1,Tmp2,sep="") #17.09.24upto - eval(parse(text=Tmp)) - } - } - Dt<- (R[2]-R[1])/N - T <- seq(R[1],R[2],by=Dt) - X <- C[1]+ra*cos(T) - Y <- C[2]+ra*sin(T) - XY<- c(X,Y) - P<- matrix(XY,ncol=2) - return(P) -} - -######################### -# 13.12.19 - -Closefile<-function(...) -{ - varargin<- list(...) - if(length(varargin)>=1){ - Pa<- varargin[[1]] - if(is.character(Pa)){ - if(Pa=="1") Endpicture(1) - if(Pa=="0") Endpicture(0) - } - } - Wfile<<-"" -} - -######################### - -Closepar<- function() -{ - S<- "%\n\\end{minipage}" - cat(S,file=Wfile,append=TRUE) - Closephr() -} - - -#################################### - -Closephr<- function() -{ - cat("%\n}%\n",file=Wfile,append=TRUE) -} - -##################################### - -Dataindex<-function(P) -{ - # Inf;Inf : Terminator - Ndm<-c() - if(length(P)==0) return(Ndm) - N1<-1 - Flg<-0 - for (J in 1:Nrow(P)) - { - if(P[J,1]==Inf) - { - Ndm<-Appendrow(Ndm,c(N1,J-1)) - N1<-J+1; - if(P[N1,1]==Inf) - { - Flg<-1; - break; - } - } - } - if(Flg==0) - { - Ndm<-Appendrow(Ndm,c(N1,Nrow(P))) - } - if(class(Ndm)=="numeric") - { - Tmp<-matrix(Ndm,nrow=1) - Ndm<- Tmp - } - return(Ndm) -} - -################################ - -Dashline<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Nall<- Nargs; Sen<- 1 ; Gap<- 1 - Tmp<- varargin[[Nall]] - if(mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){ - Tmp1<- varargin[[Nall-1]] - if(mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){ - Sen<- Tmp1; Gap<- Tmp - Nall<- Nall-2 - } - else{ - Sen<- Tmp; Gap<- Sen - Nall<- Nall-1 - } - } - Sen<- 1000/2.54/MilliIn*Sen - Gap<- 1000/2.54/MilliIn*Gap - for (N in Looprange(1,Nall)){ - Pdata<- varargin[[N]] - if(is.numeric(Pdata)==1){ - Pdata<- list(Pdata) - } - for (II in 1:length(Pdata)){ - Figdata<- Op(II,Pdata) - Makehasen(Figdata,Sen,Gap,0) - } - } -} - -############################################## -# 17.11.27 - -Definecolor<- function(Name,Data){ - Tmp1=length(Data) - if((Tmp1<3) || (Tmp1>4)){ - cat("Size of data should be 3 or 4.") - return() - } - if(Tmp1==4){ - Tp="cmyk" - }else{ - Tp="rgb" - } - Tmp="" - for(J in 1:Tmp1){ - Tmp=paste(Tmp, as.character(Data[J]),sep="") - if(J<Tmp1){ - Tmp=paste(Tmp,",",sep="") - } - } - Tmp=paste("\\definecolor{",Name,"}{",Tp,"}{",Tmp,"}",sep="") - Texcom(Tmp) -} - -############################################## - -Diagcelldata<- function(Tb,Nc,Nr) -{ - Tmp<- Findcell(Tb,Nc,Nr) - C<- Tmp[[1]] - Dx<- Tmp[[2]] - Dy<- Tmp[[3]] - Pne<- C+c(Dx,Dy) - Pnw<- C+c(-Dx,Dy) - Psw<- C+c(-Dx,-Dy) - Pse<- C+c(Dx,-Dy) - Tmp1<- Listplot(Pnw,Pse) - Tmp2<- Listplot(Pne,Psw) - list(Tmp1,Tmp2) -} - -############################################## -# 11.01.07 - -Dividegraphics<- function(Pd) -{ - if(length(Pd)==0){ - return(Pd) - } - DtL<- Flattenlist(Pd) - OutL<- list() - for (J in 1:length(DtL)){ - Dt<- as.matrix(DtL[[J]]) - Ndm<- Dataindex(Dt) - for (I in Looprange(1,Nrow(Ndm))){ - Fd<- Dt[Ndm[I,1]:Ndm[I,2],] - OutL<- c(OutL,list(Fd)) - } - } - return(OutL) -} - -############################################## -# 13.05.03 - -Dividetable<- function(Tb) -{ - G<- Tb[[1]] - Gw<- G[[1]] - Gt<- G[Tb[[2]]] - Gy<- G[Tb[[3]]] - list(Gw,Gt,Gy) -} - -################################################ - -Doscaling<- function(G) -{ - GLg<- G - if(class(GLg)=="numeric") - { - if(LOGX==1) GLg[1]<- log(G[1], base=10) - if(LOGY==1) GLg[2]<- log(G[2], base=10) - Tmp<-c(SCALEX*GLg[1],SCALEY*GLg[2]) - return(Tmp) - } - else - { - if(LOGX==1) GLg[,1]<- log(G[,1],base=10) - if(LOGY==1) GLg[,2]<- log(G[,2],base=10) - Tmp1<-matrix(c(SCALEX,0,0,SCALEY),nrow=2) - Tmp<-GLg %*% Tmp1 - return(Tmp) - } -} - -######################################## - -Dotfilldata<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ShaL<- list() - Eps<- 0.01 - Kakudo<- 45 - Kosa<- 0.5 - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - for (N in seq(Nargs,1,by=-1)){ - Tmp<- varargin[[N]] - if(Mixtype(Tmp)!=1){ - break - } - } - if(N<Nargs){ - Kosa<- varargin[[N+1]] - } -# Kosa<- min(Kosa,1) - Tmp<- 1/(2*Kosa) - Kankaku<- Tmp*0.100*1000/2.54/MilliIn - NaitenL<- varargin[[1]] - if(Mixtype(NaitenL)==1){ - NaitenL<- list(NaitenL) - } - Ns<- 2 - StartP<- Op(1,NaitenL) - if(mode(StartP)=="character"){ - StartP<- c((Xmn+Xmx)/2,(Ymn+Ymx)/2) - } - else{ - StartP<- Doscaling(StartP) - } - Tmp<- varargin[[2]] - if(Mixtype(Tmp)==1){ - StartP<- Doscaling(Tmp) - Ns<- 3 - } - Tmp<- list() - for (I in Looprange(Ns,N)){ - Tmp<- Mixjoin(Tmp,list(varargin[[I]])) - } - Bdy<- Kyoukai(Tmp) - Bdys<-list() - for (I in 1:length(Bdy)){ - Tmp1<- Bdy[[I]] - Tmp2<- Doscaling(Tmp1) - Bdys<- Mixjoin(Bdys,list(Tmp2)) - } - Bdy<- Bdys - PtnL<- list() - for (I in Looprange(1,length(NaitenL))){ - Tmp<- Op(I,NaitenL) - if(mode(Tmp)=="numeric"){ - Tmp1<- Naigai(Tmp,Bdy) - PtnL<- Mixjoin(PtnL,list(Tmp1)) - } - else{ - if(mode(Tmp)!="character"){ - return("Mode Error") - } - Ptn<- c() - for (J in Looprange(1,nchar(Tmp))){ - if(substr(Tmp,J,J)=="i"){ - Ptn<- c(Ptn,1) - } - else{ - Ptn<- c(Ptn,0) - } - } - PtnL<- Mixjoin(PtnL,list(Ptn)) - } - } - Call<- length(Bdy) - Ptn<- c(seq(0, 0, length=Call)) - if(Member(Ptn,PtnL)){ - Wn<- Doscaling(Framedata()) - Bdy<- Mixjoin(Bdy,list(Wn)) - Tmp<- list() - for (I in Looprange(1,length(PtnL))){ - Tmp1<- c(Op(I,PtnL),1) - Tmp<- Mixjoin(Tmp,list(Tmp1)) - } - PtnL<- Tmp - } - V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180)) - Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180)) - Tmp<- Op(1,NaitenL) - if(mode(Tmp)=="numeric" && length(Tmp)==2){ - Tmp<- Doscaling(Tmp) - Delta<- Tmp-StartP - K<- trunc(Dotprod(Delta,Vm)/Kankaku) - PA<- StartP+K*Kankaku*Vm - P<- PA - Sha<- Makeshasen(PtnL,P,V,Bdy) - Sha<- Dividegraphics(Sha) - I<- 1 - while (length(Sha)>0){ - for (J in Looprange(1,length(Sha))){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if(abs(K1-Tmp)<Eps) K1=K1+1 - Tmp<- Dotprod(R-P,V)/Kankaku - K2<- floor(Tmp) - if(abs(Tmp-K2)<Eps) K2=K2-1 - for (K in Looprange(K1,K2)){ - Tmp1<- Pointdata(P+K*Kankaku*V) - ShaL<- Mixjoin(ShaL, list(Tmp1)) - } - } - P<- PA+I*Kankaku*Vm - Sha<- Makeshasen(PtnL,P,V,Bdy) - Sha<- Dividegraphics(Sha) - I<- I+1 - } - P<- PA-Kankaku*Vm - Sha<- Makeshasen(PtnL,P,V,Bdy) - I<- 2 - while (length(Sha)>0){ - for (J in 1:length(Sha)){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if(abs(K1-Tmp)<Eps) K1<- K1+1 - Tmp<- Dotprod(R-P,V)/Kankaku - K2<- floor(Tmp) - if(abs(Tmp-K2)<Eps) K2<- K2-1 - for (K in Looprange(K1,K2)){ - Tmp1<- Pointdata(P+K*Kankaku*V) - ShaL<- Mixjoin(ShaL, list(Tmp1)) - } - } - P<- PA-I*Kankaku*Vm - Sha<- Makeshasen(PtnL,P,V,Bdy) - I<- I+1 - } - } - else{ - Delta<- c(Xmn,Ymn)-StartP - K1<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymn)-StartP - K2<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymx)-StartP - K3<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmn,Ymx)-StartP - K4<- trunc(Dotprod(Delta,Vm)/Kankaku) - IM<- max(K1,K2,K3,K4) - Im<- min(K1,K2,K3,K4) - for (I in Im:IM){ - P<- StartP+I*Kankaku*Vm - Sha<- Makeshasen(PtnL,P,V,Bdy) - Sha<- Dividegraphics(Sha) - if(length(Sha)>0){ - for (J in 1:length(Sha)){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if(abs(K1-Tmp)<Eps) K1=K1+1 - Tmp<- Dotprod(R-P,V)/Kankaku - K2<- floor(Tmp) - if(abs(Tmp-K2)<Eps) K2=K2-1 - for (K in Looprange(K1,K2)){ - Tmp1<- Pointdata(P+K*Kankaku*V) - ShaL<- Mixjoin(ShaL, list(Tmp1)) - } - } - } - } - } - ShaLs<-list() - for (I in Looprange(1,length(ShaL))) - { - Tmp<- ShaL[[I]] - Tmp1<- Unscaling(Tmp) - ShaLs<- Mixjoin(ShaLs,Tmp1) - } - ShaL<- ShaLs - return(ShaL) -} - -############################################# - -Dottedline<- function(...) -{ - varargin <- list(...) - Nall <- length(varargin) - Nagasa <- 0.1 - Ookisa <- PenThick - I <- Nall - Tmp <- varargin[[I]] - while (mode(Tmp)=="numeric" && length(Tmp)==1 ) { - I <- I-1 - Tmp <- varargin[[I]] - } - if(I==Nall-1) { - Nagasa<-Nagasa*varargin[[Nall]] - Nall <- Nall-1 - } - if(I==Nall-2) { - Nagasa <- Nagasa*varargin[[Nall-1]] - Ookisa <- round(Ookisa*varargin[[Nall]]) - Nall <- Nall-2 - } - Nagasa <- 1000/2.54/MilliIn*Nagasa - for (N in 1:Nall) { - Pdata <- varargin[[N]] - if(mode(Pdata)=="numeric") { - Pdata <- list(Pdata) - } - for (II in 1:length(Pdata)) { - Clist <- MakeCurves(Op(II,Pdata)) - DinM <- Dataindex(Clist) - for (n in Looprange(1,Nrow(DinM))) { - Tmp <- DinM[n,] - Data <- Clist[Tmp[1]:Tmp[2],] - Len <- 0 - Lenlist <- c(0) - for (I in Looprange(2,Nrow(Data))) { - Len <- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist <- c(Lenlist,Len) - } - Lenall <- Lenlist[length(Lenlist)] - if(Lenall==0) { - next - } - Naga <- Nagasa - Nten <- round(Lenall/Naga)+1 - if(Nten > 1) { - Seg <- Lenall/(Nten-1) - } - else { - Seg <- Lenall - } - Eps <- 10^(-6)*Seg - PPd<-c() - Hajime <- 1 - for (I in Looprange(0,Nten-1)) { - Len <- Seg*I - if(I>0) { - J <- Hajime - while( Len>=Lenlist[J]+Eps) { - J <- J+1 - } - Hajime <- J-1 - } - T <- (Len-Lenlist[Hajime])/ - (Lenlist[Hajime+1]-Lenlist[Hajime]) - P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - PPd<-Appendrow(PPd,P) - if(I==Nten-1) { - if(Norm(P-Data[1,])<Eps) { - next - } - } - } - Str<-paste("\\special{pn ", as.character(Ookisa),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - for (I in Looprange(1,Nrow(PPd))){ - P<- Op(I,PPd) - if(Nrow(PPd)==1){ - V<- c(1,0) - } - else if(I==1){ - Tmp<- Op(I+1,PPd)-P - V<- 1/Norm(Tmp)*Tmp - } - else if(I==Nrow(PPd)){ - Tmp<- P-Op(I-1,PPd) - V<- 1/Norm(Tmp)*Tmp - } - else{ - Tmp1<- Op(I+1,PPd)-P - Tmp2<- P-Op(I-1,PPd) - Tmp3<-1/Norm(Tmp1)*Tmp1+1/Norm(Tmp2)*Tmp2 - V<- 1/Norm(Tmp3)*Tmp3 - } - Tmp<- round(MilliIn*P[1]-1/2*Ookisa*V[1]) - X<- as.character(Tmp) - Tmp<- -round(MilliIn*P[2]-1/2*Ookisa*V[2]) - Y<- as.character(Tmp) - Str<-paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Tmp<- round(MilliIn*P[1]+1/2*Ookisa*V[1]) - X<- as.character(Tmp) - Tmp<- -round(MilliIn*P[2]+1/2*Ookisa*V[2]) - Y<- as.character(Tmp) - Str<-paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("\\special{fp}",file=Wfile,append=TRUE) - if(I%%2==0){ - cat("%\n",file=Wfile,append=TRUE) - } - } - } - } - } - Tmp<-PenThick/PenThickInit - Setpen(Tmp); -} - -########################################### - -Drwline<-function(...) -{ - varargin<-list(...) - Nall<-length(varargin) - Thick<-0 - Tmp<-varargin[[Nall]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - Thick<-round(Tmp*PenThickInit) - Str<-paste("\\special{pn ", as.character(Thick),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - Nall<-Nall-1 - } - for (N in 1:Nall){ - Pdata<-varargin[[N]] - if(length(Pdata)==0) next - if(mode(Pdata)!="list") Pdata<-list(Pdata) - while(Mixtype(Pdata)==3){ # 10.07.25 - Tmp1<- list() - for(II in Looprange(1,length(Pdata))){ - Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) - } - Pdata<- Tmp1 - } # 10.07.25 - for (II in Looprange(1,length(Pdata))){ - Clist<-MakeCurves(Pdata[[II]]) - DinM<-Dataindex(Clist) - for (n in Looprange(1,Nrow(DinM))){ - Tmp<-DinM[n,] - Data<-Clist[Tmp[1]:Tmp[2],] - Mojisu<-0 - for (I in Looprange(1,Nrow(Data))){ - Tmp<-Data[I,] - X<- sprintf("%5.0f",MilliIn*Tmp[1]) # 11.07.19 - Y<- sprintf("%5.0f",-MilliIn*Tmp[2]) # 11.07.19 - Str<-paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<-Mojisu+nchar(Str) - if(Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<-0 - } - } - if(Mojisu!=0){ - cat("%\n",file=Wfile,append=TRUE) - } - cat("\\special{fp}%\n",file=Wfile,append=TRUE) - } - } - } - Str<-"%" - if(Thick>0){ - Tmp<-PenThick/PenThickInit - Setpen(Tmp) - } -} - -########################################### - -Drwpt<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - if(TenSize>TenSizeInit){ - N<- round(6*sqrt(TenSize/TenSizeInit)) - } - else{ - N<-4 - } - Tmp<- varargin[[Nargs]] - if(mode(Tmp)=="numeric"){ - if(length(Tmp)>1){ - Kosa<- 1; All<- Nargs - } - else{ - Kosa<- Tmp; All<- Nargs-1 - } - } - else if(mode(Tmp)=="list"){ - Kosa<- 1; All<- Nargs - } - CL<-c() - for (J in 0:N){ - Tmp<- TenSize*0.5*1000/2.54/MilliIn - Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) - CL<- append(CL,Tmp) - } - CL<- matrix(CL,nrow=2) - CL<- t(CL) - for (II in Looprange(1,All)){ - MS<- varargin[[II]] - MS=Flattenlist(MS) #17.10.11 - if(mode(MS)=="numeric"){ - MS<- list(MS) - } - for (I in Looprange(1,length(MS))){ - P<- MS[[I]] - if(InWindow(P)!="i") next - P<- Doscaling(P) - PL<-c() - for (J in 0:N){ - PL<- c(PL,P+CL[J+1,]) - } - PL<-matrix(PL,nrow=2) - PL<-t(PL) - Mojisu<-0 - for (J in 1:Nrow(PL)){ - Q<- PL[J,] - X<- as.character(round(MilliIn*Q[1])) - Y<- as.character(-round(MilliIn*Q[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if(Mojisu>80){ - cat("#\n",file=Wfile,append=TRUE) - } - Mojisu=0 - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- "\\special{fp}%\n" - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - } - } -} - -###################################################### - -Drwxy<-function(...) -{ - varargin<-list(...) - Nargs <- length(varargin) - Tmp<-grep("arrow", ZIKU) - if(length(Tmp)>0) - { - Arrowline(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]),ARROWSIZE) - Arrowline(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX),ARROWSIZE) - } - else - { - Drwline(Listplot(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]))) - Drwline(Listplot(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX))) - } - Letter(c(XMAX,GENTEN[2]),XPOS,XNAME) - Letter(c(GENTEN[1],YMAX),YPOS,YNAME) - Letter(GENTEN,OPOS,ONAME); -} - -########################################## -# 10.12.04 - -Enclosing<- function(...) -{ - Eps=10^(-7) # Scilab 16.12.05 - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - if(Mixtype(P)==2){ - Tmp<- Op(1,P) - if(mode(Tmp)!="numeric" || length(Tmp)>1){ - AnsL<- EnclosingS(...) - AnsL<- Joincrvs(AnsL) # 10.12.04 - } - } - Tmp1=Op(1,AnsL) # Scilab 16.12.05from - Tmp2=Op(nrow(AnsL),AnsL) - if(Norm(Tmp2-Tmp1)>Eps){ - AnsL=Appendrow(AnsL,Tmp1) - } - return(AnsL) -} - -######################################### - -EnclosingS<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - AnsL<- list() - PdataL<- varargin[[1]] - Nall<-length(PdataL) - Eps<- 10^(-3) - EEps<- 0.1 - S<- c() - Flg<- 0 - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ - S<- Tmp - } - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - if(Flg==0){ - Eps<- Tmp - Flg=Flg+1 - } - else{ - EEps<- Tmp - } - } - } - F<- Op(1,PdataL); G<- Op(Nall,PdataL) - KL<- IntersectcrvsPp(F,G) - if(length(KL)==1){ - Tmp<- Op(1,KL) - P<- Op(1,Tmp) - T1<- Op(2,Tmp) - } - if(length(KL)==0){ - if(Numptcrv(F)>Numptcrv(G)){ - Tmp<- Nearestpt(F,G) - P<- Op(1,Tmp) - T1=Op(2,Tmp) - } - else{ - Tmp<- Nearestpt(G,F) - P<- Op(3,Tmp) - T1<- Op(4,Tmp) - } - } - if(length(KL)>=2){ - if(length(S)==0){ - return("No Start Point") - } - Tmp<- Op(1,KL) - P<- Op(1,Tmp) - T1<- Op(2,Tmp) - Tmp<- Norm(P-S) - for (I in Looprange(2,length(KL))){ - Tmp1<- Op(1,Op(I,KL)) - Tmp2<- Norm(Tmp1-S) - if(Tmp2<Tmp){ - P<- Tmp1 - T1<- Op(2,Op(I,KL)) - Tmp<- Tmp2 - } - } - } - S<- P - AnsL<- list() - for (N in Looprange(1,Nall)){ - F<- Op(N,PdataL) - if(N>1) P<- Q - if(N==Nall){ - Q=S - } - else{ - Flg<- 0 - G<- Op(N+1,PdataL) - KL<- IntersectcrvsPp(G,F) - if(length(KL)==1){ - Tmp<- Op(1,KL) - Q<- Op(1,Tmp) - T3<- Op(2,Tmp) - Flg<- 10 - } - if(length(KL)==0) Flg<- 1 - if(length(KL)>=2){ # Maple bug? - Tmp1<- Op(1,Op(1,KL)) - Tmp2<- Op(1,Op(2,KL)) - Tmp<- Norm(Tmp1-Tmp2) - if(Tmp<Eps*10) Flg<- 1 - } - if(Flg==1){ - if(Numptcrv(F)>Numptcrv(G)){ - Tmp<- Nearestpt(F,G) - Q<- Op(1,Tmp) - T3<- Op(4,Tmp) - Flg<- 10 - } - else{ - Tmp<- Nearestpt(G,F) - Q<- Op(3,Tmp) - T3<- Op(2,Tmp) - Flg<- 10 - } - } - if(Flg<10){ - T2<- Inf - for (I in Looprange(1,length(KL))){ - Dt<- Op(I,KL) - Tmp1<- Op(1,Dt) - Tmp<- Op(3,Dt) - Tmp2<- Paramoncurve(Tmp1,Tmp,F) - Tmp3<- Op(2,Dt) - if(Tmp2>T1+Eps && Tmp2<T2-Eps){ - Q<- Tmp1 - T2<- Tmp2 - T3<- Tmp3 - } - } - } - } - Tmp<- Partcrv(P,Q,F) - T1<- T3 - AnsL<- Mixjoin(AnsL,list(Tmp)) - } - return(AnsL) -} - -######################################## - -Endpicture<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - if(Nargs==0) - { - Drwxy() - } - else - { - if(varargin[[1]]==1) Drwxy() - } - cat("\\end{picture}}%",file=Wfile,append=TRUE) -# MEMORI<<-MEMORINow*1000/2.54/MilliIn - Setunitlen("1cm") -} - -######################################### - -Execmd<- function(StrL) -{ - if(mode(StrL)=="character" && length(StrL)==1){ - StrL<- list(StrL) - } - for (I in Looprange(1,length(StrL))){ - if(!is.na(Op(I,StrL)) && nchar(Op(I,StrL))>0){ - eval(parse(text=Op(I,StrL))) - } - } -} - -######################################### - -Expr<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - Irng<-c(seq(from=1,to=Nargs,by=3)) - for (I in Irng) - { - Tmp<-varargin[[I]] - P<- Doscaling(Tmp) - X<-P[1] - Y<-P[2] - Houkou<-varargin[[I+1]] - Mojiretu<-paste("$",varargin[[I+2]],"$",sep="") - Hset<-Houkou - Vhoko<-"c" - if(length(grep("n",Hset))>0) - { - Vhoko<-"n"; Y<-Y+MEMORI - } - if(length(grep("s",Hset))>0) - { - Vhoko<-"s"; Y<-Y-MEMORI - } - Hhoko<-"c" - if(length(grep("e",Hset))>0) - { - Hhoko<-"e"; X<-X+MEMORI - } - if(length(grep("w",Hset))>0) - { - Hhoko<-"w"; X<-X-MEMORI - } - Hoko<-paste(Vhoko,Hhoko,sep="") - Suu<-"+-.0123456789" - SuuL<-Suu - J<-1; Dstr<-"" - while (J<=nchar(Houkou)) - { - Tmp<-substring(Houkou,J,J) - if(length(grep(Tmp,Suu))>0) - { - if(Dstr=="") Hk<-substring(Houkou,J-1,J-1) - Dstr<-paste(Dstr,Tmp,sep="") - } - else - { - if(Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI - if(Hk=="n") Y<-Y+D - if(Hk=="s") Y<-Y-D - if(Hk=="e") X<-X+D - if(Hk=="w") X<-X-D - Dstr<-"" - } - } - J<-J+1 - } - if(Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI; - if(Hk=="n") Y<-Y+D - if(Hk=="s") Y<-Y-D - if(Hk=="e") X<-X+D - if(Hk=="w") X<-X-D - } - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - cat("\\put(",file=Wfile,append=TRUE) - Tmp1<- sprintf("%7.7f",X) # 11.07.19 - Tmp2<- sprintf("%7.7f",Y) # 11.07.19 - Str<-paste(Tmp1,",",Tmp2,sep="") - cat(Str,file=Wfile,append=TRUE) - Tmp<-"){\\hspace*{\\Width}" - Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) - } -} - -########################################## - -Exprrot<- function(...) -{ - varargin<- list(...) - P<- varargin[[1]] - V<- varargin[[2]]; N<- 3 - P<- Doscaling(P) - V<- Doscaling(V) - Tmov<- 0 - Tmp<- varargin[[N]] - if(mode(Tmp)=="numeric"){ - Tmov<- Tmp; N<- N+1 - } - Nmov<- 0 - Tmp<- varargin[[N]] - if(mode(Tmp)=="numeric"){ - Nmov<- Tmp; N<- N+1 - } - Mojiretu<- paste("$",Assign(varargin[[N]]),"$",sep="") # 2017.11.26 - Tv<- 1/Norm(V)*V - Nv<- c(-Tv[2],Tv[1]) - P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv - Tmp<- acos(V[1]/Norm(V)) - Theta<- round(Tmp*180/pi) - if(V[2]>=0){ - Units<- "" - } - else{ - Units<- "units=-360," - } - Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") - Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") - Letter(P,"c",Tmp) -} - -###################################################### - -Findcell<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - Ag<- varargin[[2]] - Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" - if(mode(Ag)=="character"){ - Clm<- c() - Rstr<- "" - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,I,I) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - else{ - Rstr<- paste(Rstr,C,sep="") - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - Mrg<- eval(parse(text=Rstr)) - if(Nargs>=3){ - Ag<- varargin[[3]] - Clm<- c() - Rstr<- "" - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,1,1) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - if(length(Tmp)>1){ - Clm<- c(Clm,Tmp+1) - } - else{ - Rstr<- paste(Rstr,C,sep="") - } - } - Nrg2<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length[Clm]-I - Nrg2<- Nrg2+Tmp*26^Tmp1 - } - Nrg<- c(Nrg,Nrg2) - Tmp=eval(parse(text=Rstr)) - Mrg<- c(Mrg,Tmp) - } - } - else{ - Nrg<- varargin[[2]] - Mrg<- varargin[[3]] - } - if(length(Mrg)==1){ - m1<- Mrg; m2<- m1+1 - } - else{ - m1<- Mrg[1]; m2<- Mrg[2] # 10.12.12 - } - if(length(Nrg)==1){ - n1<- Nrg; n2<- n1+1 - } - else{ - n1<- Nrg[1]; n2<- Nrg[2] - } - n1<- n1+1; n2<- n2+1 - m1<- m1+1; m2<- m2+1 - Hind<- TbL[[2]] - Vind<- TbL[[3]] - Tmp<- TbL[[1]] - HL<- Tmp[Hind] - Tmp1<- Op(1,TbL[[4]]) - Tmp2<- Op(2,TbL[[4]]) - HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) - VL<- Tmp[Vind] - Tmp1<- Op(1,TbL[[5]]) - Tmp2<- Op(2,TbL[[5]]) - VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) - Tmp<- TbL[[6]] - Tmp1<- Listplot(c(Ptsw(Tmp),Ptnw(Tmp))) - Tmp2<- Listplot(c(Ptse(Tmp),Ptne(Tmp))) - HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) - Tmp1<- Listplot(c(Ptnw(Tmp),Ptne(Tmp))) - Tmp2<- Listplot(c(Ptsw(Tmp),Ptse(Tmp))) - VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) - Tmp<- HL[[n1]] - if(mode(Tmp)=="numeric"){ - H1<- Tmp[1,1] - } - else{ - Tmp1<- Tmp[[1]] - H1<- Tmp1[1,1] - } - Tmp<- HL[[n2]] - if(mode(Tmp)=="numeric"){ - H2<- Tmp[1,1] - } - else{ - Tmp1<- Tmp[[1]] - H2<- Tmp1[1,1] - } - Tmp<- VL[[m1]] - if(mode(Tmp)=="numeric"){ - V1<- Tmp[1,2] - } - else{ - Tmp1<- Tmp[[1]] - V1<- Tmp1[1,2] - } - Tmp<- VL[[m2]] - if(mode(Tmp)=="numeric"){ - V2<- Tmp[1,2] - } - else{ - Tmp1<- Tmp[[1]] - V2<- Tmp1[1,2] - } - Pt<- c((H1+H2)/2,(V1+V2)/2) - High<- (V1-V2)/2 - Wide<- (H2-H1)/2 - Out<- list(Pt,Wide,High) - return(Out) -} - -############################################ - -Flattenlist<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Out<- list() - for(N in Looprange(1,Nargs)){ - D<- varargin[[N]] - if(is.data.frame(D) || !is.list(D)){ # modify - Out<- c(Out,list(D)) - } - else{ - for(I in Looprange(1,length(D))){ - Ds<- D[[I]] - Tmp<- Flattenlist(Ds) - Out<- c(Out,Tmp) - } - } - } - return(Out) -} - -############################################ - -Fontsize<- function(Ookisa) -{ - Str<- "%" - S<- substr(Ookisa,1,1) - if(S=="n"){ - Str<- "\\normalsize%" - } - if(S=="s"){ - if(nchar(Ookisa)==1){ - Tmp<- "n" - } - else{ - Tmp<- substr(Ookisa,2,2) - } - if(Tmp=="s"){ - Str<- "\\scriptsize%" - } - else{ - Str<- "\\small%" - } - } - if(S=="f"){ - Str<- "\\footnotesize%" - } - if(S=="t"){ - Str<- "\\tiny%" - } - if(S=="l"){ - Str<- "\\large%" - } - if(S=="L"){ - if(nchar(Ookisa)==1){ - Tmp<- "a" - } - else{ - Tmp<- substr(Ookisa,2,2) - } - if(Tmp=="a"){ - Str<- "\\Large%" - } - else{ - Str<- "\\LARGE%" - } - } - if(S=="h"){ - Str<- "\\huge%" - } - if(S=="H"){ - Str<- "\\Huge%" - } - cat(Str,file=Wfile,append=TRUE) - cat("\n",file=Wfile,append=TRUE) -} - -########################################## - -Fracform<- function(...) -{ - varargin<- list(...) - Eps<- 10^(-10) - Nmax<- 1/Eps - Nargs<- length(varargin) - X<- varargin[[1]] - Nr<- Nrow(X) - X<- as.matrix(X,nrow=Nr) - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)!="numeric"){ - next - } - if(Tmp>1){ - Nmax<- Tmp - } - else if(Tmp>0){ - Eps<- Tmp - } - } - Tmp<- rep("",length(X)) - Out<- matrix(Tmp,nrow=nrow(X)) - for (I in Looprange(1,nrow(X))){ - for (J in Looprange(1,ncol(X))){ - Dt<- X[I,J] - if(mode(Dt)=="character"){ - Dt<- eval(parse(text=Dt)) - } - R<- 1 - N<- 0 - Rmin<- R - Nr<- N - while (R>Eps && N<Nmax){ - N<- N+1 - M<- round(Dt*N) - R<- abs(Dt-M/N) - if(R<Rmin){ - Rmin<- R - Nr<- N - } - } - if(N==Nmax){ - N<- Nr - M<- round(Dt*N) - } - Tmp<- as.character(M) - if(N!=1){ - Tmp<- paste(Tmp,"/",as.character(N),sep="") - } - Out[I,J]<- Tmp - } - } - if(nrow(Out)==1){ - Out<- as.character(Out) - } - return(Out) -} - -############################################## -# 2011.12.17 ( list ) - -Framedata<-function(...) -{ - varargin<- Flattenlist(list(...)) - N<-length(varargin) - if(N<= 1){ - H<- 1.0*10^(-4); - PA<-c(XMIN+H,YMIN+H) - PB<-c(XMAX-H,YMIN+H) - PC<-c(XMAX-H,YMAX-H) - PD<-c(XMIN+H,YMAX-H) - } - else{ - Tmp<-varargin[[N]] - if(is.numeric(Tmp) && length(Tmp)==1){ - Dy<-Tmp; Dx<-Dy - Tmp<-varargin[[N-1]] - if(is.numeric(Tmp) && length(Tmp)==1){ - Dx<-Tmp - } - Tmp<-varargin[[1]] - X<-Tmp[1]; Y<-Tmp[2] - X1<-X-Dx; X2<-X+Dx; Y1<-Y-Dy; Y2<-Y+Dy - } - else{ - Tmp<-varargin[[1]] - X1<-Tmp[1]; X2<-Tmp[2] - Tmp<-varargin[[2]] - Y1<-Tmp[1]; Y2<-Tmp[2] - } - PA<-c(X1,Y1); PB<-c(X2,Y1) - PC<-c(X2,Y2); PD<-c(X1,Y2) - } - Out<- Listplot(c(PA,PB,PC,PD,PA)) - return(Out) -} - -################################### - -Hatchdata<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - ShaL<- list() - Nargs<- length(varargin) - Kakudo<- 45 - Kankaku<- 0.125*1000/2.54/MilliIn - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - for (N in seq(Nargs,1, by=-1)) - { - Tmp<- varargin[[N]] - if(mode(Tmp)=="list") - { - break - } - } - if(N<Nargs) - { - Kakudo<- varargin[[N+1]] - if(N==Nargs-2) - { - Kankaku<- 0.125*varargin[[Nargs]] - } - } - NaitenL<- varargin[[1]] - if(mode(NaitenL)!="list") - { - NaitenL<- list(NaitenL) - } - Ns<- 2 - StartP<- Op(1,NaitenL) - if(mode(StartP)=="character") - { - StartP<- c((Xmn+Xmx)/2, (Ymn+Ymx)/2) - } - if(mode(varargin[[2]])=="numeric") - { - StartP<- varargin[[2]] - StartP<- Doscaling(StartP) - Ns<- 3 - } - Tmp<- list() - for ( I in Looprange(Ns,N)) - { - Tmp1<- list(varargin[[I]]) - Tmp2<- Mixjoin(Tmp, Tmp1) - Tmp<- Tmp2 - } - Bdy<- Kyoukai(Tmp) - Bdys<-list() - for (I in 1:length(Bdy)) - { - Tmp1<- Bdy[[I]] - Tmp2<- Doscaling(Tmp1) - Bdys<- Mixjoin(Bdys,list(Tmp2)) - } - Bdy<- Bdys - PtnL<- list() - for (I in Looprange(1,length(NaitenL))) - { - Tmp<- Op(I, NaitenL) - if(mode(Tmp)=="numeric") - { - Tmp1<- Naigai(Tmp,Bdy) - Tmp2<- Mixjoin(PtnL, list(Tmp1)) - PtnL<- Tmp2 - } - else - { - if(mode(Tmp)!="character") - { - return("Mode Error") - } - Ptn<-c() - for (J in 1:nchar(Tmp)) - { - if(Op(J,Tmp)=="i") - { - Ptn<- c(Ptn,1) - } - else - { - Ptn<- c(Ptn,0) - } - } - PtnL<- Mixjoin(PtnL, list(Ptn)) - } - } - Call<- length(Bdy) - Ptn<- c(seq(0, 0, length=Call)) - if(Member(Ptn,PtnL)) - { - Wn<- Doscaling(Framedata()) - Tmp<- Mixjoin(Bdy,list(Wn)) - Bdy<- Tmp - Tmp<- list() - for (I in Looprange(1, length(PtnL))) - { - Tmp1<- c(Op(I,PtnL),1) - Tmp2<- Mixjoin(Tmp,list(Tmp1)) - Tmp<- Tmp2 - } - PtnL<- Tmp - } - V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180)) - Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180)) - Tmp<- Op(1,NaitenL) - if(mode(Tmp)=="numeric" && length(Tmp)==2) - { - Tmp<- Doscaling(Tmp) - Delta<- Tmp-StartP - K<- trunc(Dotprod(Delta,Vm)/Kankaku) - PA<- StartP+K*Kankaku*Vm - Sha<- Makeshasen(PtnL,PA,V,Bdy) - I <- 1 - while (length(Sha)>0) - { - Tmp<- Mixjoin(ShaL, list(Sha)) - ShaL <- Tmp - Sha<- Makeshasen(PtnL,PA+I*Kankaku*Vm,V,Bdy) - I <- I+1 - } - Sha<- Makeshasen(PtnL,PA-Kankaku*Vm,V,Bdy) - I<- 2 - while (length(Sha)>0) - { - for (J in 1:length(Sha)) - { - Tmp<- Mixjoin(ShaL,list(Sha[[J]])) - ShaL<- Tmp - } - Sha<- Makeshasen(PtnL,PA-I*Kankaku*Vm,V,Bdy) - I<- I+1 - } - } - else - { - Delta<- c(Xmn,Ymn)-StartP - K1<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymn)-StartP - K2<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymx)-StartP - K3<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmn,Ymx)-StartP - K4<- trunc(Dotprod(Delta,Vm)/Kankaku) - IM<- max(K1,K2,K3,K4) - Im<- min(K1,K2,K3,K4) - for (I in Im:IM) - { - Sha<- Makeshasen(PtnL,StartP+I*Kankaku*Vm,V,Bdy) - for (J in Looprange(1,length(Sha))) - { - Tmp<- Mixjoin(ShaL, list(Sha[[J]])) - ShaL<- Tmp - } - } - } - ShaLs<-list() - for (I in Looprange(1,length(ShaL))) - { - Tmp<- ShaL[[I]] - Tmp1<- Unscaling(Tmp) - Tmp2<- Mixjoin(ShaLs, list(Tmp1)) - ShaLs<- Tmp2 - } - ShaL<- ShaLs - return(ShaL) -} - -###################################### - -Htickmark<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if(mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if(K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if(is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if(J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if(is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if(is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if(mode(Dt)=="numeric" && length(Dt)>1){ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt[1],Dt[2]) - next - } - if(mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt,GENTEN[2]) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y+MARKLEN)) - Tmp2<- Unscaling(c(X,Y-MARKLEN)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if(Ndt==3){ - Tmp<-Unscaling(c(X,Y-MARKLEN)) - Expr(Tmp,"s",Moji) - } - if(Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("s",Houkou) - if(length(Tmp)>0){ - Tmp<-Unscaling(c(X,Y-MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y+MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -############################################# -# 2013.08.07 - -Integrate<- function(Fs,Vs, Intv){ - if(is.function(Fs)){ - Fn<- Fs - } - else{ - Str<- paste("Fn<- function(",Vs, ") ", Fs, sep="") - eval(parse(text=Str)) - } - Tmp<- integrate(Fn, Intv[[1]], Intv[[2]]) - Out<- Tmp[[1]] - return(Out) -} - -############################################# - -Intersectcrvs<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - Eps<-10^(-4) - Tmp<-varargin[[Nargs]] - if(mode(Tmp)=="numeric" && length(Tmp)==1) - { - Eps<-Tmp - } - G1<-varargin[[1]] - if(mode(G1)=="numeric") - { - G1<-list(G1) - } - G2<-varargin[[2]] - if(mode(G2)=="numeric") - { - G2<-list(G2) - } - PL<-list() - for (N in 1:length(G1)) - { - for (M in 1:length(G2)) - { - KL<-IntersectcrvsPp(G1[[N]],G2[[M]],Eps) - for (I in Looprange(1,length(KL))) - { - Tmp<-KL[[I]] - P<-Tmp[1] - PL<-append(PL,P) - } - } - } - return(PL) -} - -########################################### - -IntersectcrvsPp<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - G1<-varargin[[1]]; G2<-varargin[[2]] - Eps<- 10.0^(-4) - if(Nargs>2) Eps<-varargin[[3]] - SqEps<- 10.0^(-10) - Eps2<- 0.1 - if(Nargs>3) Eps2<-varargin[[4]] - Data1<-G1 - Data2<-G2 - if(Nrow(Data1)==Nrow(Data2)) - { - Tmp<-seq(Nrow(Data2),1, by=-1) - Tmp1<-Data2[Tmp,] - Eps0<-10^(-6) - Tmp2<-Norm(Data1-Data2) - Tmp3<-Norm(Data1-Tmp1) - if(Tmp2<Eps0||Tmp3<Eps0) - { - KL<-list() - return(KL) - } - } - KL1<-list() - KL2<-list() - for (I in Looprange(1,Nrow(Data1)-1)) - { - A<-Data1[I,] - B<-Data1[I+1,] - for (J in Looprange(1,Nrow(Data2)-1)) - { - P<-Data2[J,]; Q<-Data2[J+1,] - Tmp<-Koutenseg(A,B,P,Q,Eps,Eps2) - if(mode(Tmp)=="list") - { - if(Tmp[[3]]==0) - { - Tmp1<-list(Tmp[[1]],Tmp[[2]],I,J) - KL1<-append(KL1,list(Tmp1)) - } - else - { - Tmp2<-list(Tmp[[1]],Tmp[[2]],I,J) - KL2<-append(KL2, list(Tmp2)) - } - } - } - } - KL<-list() - if(length(KL1)>0) - { - Tmp<-KL1[[1]] - P<-Tmp[[1]] - T<-Tmp[[2]] - I<-Tmp[[3]] - J<-Tmp[[4]] - Tmp<-list(P,I+T,J) - KL<-list(Tmp) - } - for (N in Looprange(2,length(KL1))) - { - Tmp<-KL1[[N]] - P<-Tmp[[1]] - Flg<-0 - for (K in 1:length(KL)) - { - if(1>length(KL)) break - Tmp<-KL[[K]] - if(Norm(P-Tmp[[1]])^2<SqEps) - { - Flg<-1 - break - } - } - if(Flg==0) - { - Tmp<-KL1[[N]] - T<-Tmp[[2]] - I<-Tmp[[3]] - J<-Tmp[[4]] - Tmp<-list(P,I+T,J) - KL<-append(KL,list(Tmp)) - } - } - for (N in Looprange(1,length(KL2))) - { - Tmp<-KL2[[N]] - P<-Tmp[[1]] - Flg<-0 - for (K in Looprange(1,length(KL))) - { - Tmp<-KL[[K]] - if(Norm(P-Tmp[[1]])^2<SqEps) - { - Flg<-1 - break - } - } - if(Flg==0) - { - Tmp<-KL2[[N]] - T<-Tmp[[2]] - T<-min(max(T,0),1) - I<-Tmp[[3]] - J<-Tmp[[4]] - Tmp<-list(P,I+T,J) - KL<-append(KL,list(Tmp)) - } - } - return(KL) -} - -########################################### -# 13.12.20 debugged - -Invdashline<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Nall<- Nargs; Sen<- 1 ; Gap<- 1 - Tmp<- varargin[[Nall]] - if(is.numeric(Tmp) && length(Tmp)==1 && Tmp>0){ # 13.12.20 - Tmp1<- varargin[[Nall-1]] - if(is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20 - Sen<- Tmp1; Gap<- Tmp - Nall<- Nall-2 - } - else{ - Sen<- Tmp; Gap<- Sen - Nall<- Nall-1 - } - } - Sen<- 1000/2.54/MilliIn*Sen - Gap<- 1000/2.54/MilliIn*Gap - for (N in Looprange(1,Nall)){ - Figdata<- varargin[[N]] - Makehasen(Figdata,Sen,Gap,1) - } -} - -######################################### - -Invert<- function(Pd) -{ - OutL=Pd[nrow(Pd):1,] - return(OutL) -} - -############################################ - -InWindow<-function(PA) -{ - Eps<-10.0^(-6); - if((length(PA)==2)&(is.numeric(PA))){ # 17.11.20 - X<-PA[1]; Y<-PA[2]; - if(X>XMIN-Eps && X<XMAX+Eps && Y>YMIN-Eps && Y<YMAX+Eps) - Rx<-"i" - else - Rx<-"o" - return(Rx) - }else{ - return("o") - } -} - -####################################### - -Joincrvs<- function(...) -{ - varargin<- list(...) - Nall<- length(varargin) - Eps<- 10^(-4) - Tmp<- varargin[[Nall]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - Eps<- Tmp - Nall<- Nall-1 - } - QdL<- Flattenlist(varargin[1:Nall]) # 11.06.25 - if(length(QdL)==0){ - PtL<-c() - return(PtL) - } - PtL<- Op(1,QdL) - for (I in Looprange(2,length(QdL))){ - Qd<- Op(I,QdL) - if(Numptcrv(Qd)<=1){next} # 11.06.25 - P<- Ptend(PtL) - S<- Ptstart(PtL) - Q<- Ptstart(Qd) - R<- Ptend(Qd) - MN<- min(Norm(P-Q),Norm(P-R),Norm(S-Q),Norm(S-R)) - if(MN==Norm(P-R)){ - Qd<- Invert(Qd) - } - else if(MN==Norm(S-Q)){ - PtL=Invert(PtL) - } - else if(MN==Norm(S-R)){ - PtL<- Invert(PtL) - Qd<- Invert(Qd) - } - if(MN>Eps){ - PtL<- Appendrow(PtL,Qd) - } - else{ - if(is.null(nrow(Qd))){ Qd<- as.matrix(Qd,nrow=1)} - PtL<- Appendrow(PtL,Qd[2:nrow(Qd),]) # 11.06.25 - } - } - return(PtL) -} - -######################################## -# 2011.11.02 - -Joingraphics<- function(...) -{ - varargin<- list(...) - Ls<- Flattenlist(varargin) - N<- length(Ls) - Tp<- Ls[[N]] - Listflg<- 0 - if( is.character(Tp)){ - Tmp<- toupper(substr(Tp,1,1)) - if(Tmp=="L"){ - Listflg<- 1 - } - N<- N-1 - Ls<- Ls[1:N] - } - if(Listflg==1){ - P<- Ls - } - else{ - P<- c() - for (I in 1:N){ - Tmp<- Ls[[I]] - P<- Appendrow(P,c(Inf,Inf)) - P<- Appendrow(P,Tmp) - } - P<- P[2:nrow(P),] - } - return(P) -} - -######################################## - -Kouten<- function(PA,V,P,Q) -{ - Eps<- 10.0^(-6) - A1<- PA[1]; A2<- PA[2] - V1<- V[1]; V2<- V[2] - P1<- P[1]; P2<- P[2] - U1<- Q[1]-P1; U2<- Q[2]-P2 - Tmp<- Norm(P-Q)*Norm(V) - if(Tmp==0) - { - Out<- list(Inf,-Inf) - return(Out) - } - D<- U1*V2-U2*V1 - if(abs(D)/Tmp<Eps) - { - Out<- list(Inf,-Inf) - return(Out) - } - S<- ((-A2+P2)*V1+(A1-P1)*V2)/D - if(S>1+Eps || S<Eps) - { - Out<-list(Inf,-Inf) - return(Out) - } - T<- ((-A2+P2)*U1+(A1-P1)*U2)/D - Tmp<- PA+T*V - Out<- list(T,Tmp,sign(D)) - return(Out) -} - -########################################## - -KoutenList<- function(PA,V,Bdy) -{ - Eps<-10.0^(-6) - TenL<-list() - for (N in 1:length(Bdy)) - { - KL<- Op(N,Bdy) - for (K in Looprange(1, Nrow(KL)-1)) - { - P<- Op(K,KL); Q<- Op(K+1,KL) - if(P!="/" && Q!="/") - { - Tmp<- Kouten(PA,V,P,Q); - if(Tmp[[1]]!=Inf) - { - Ten<- append(Tmp,N) - Flg<- 0 - NN<- length(TenL) - I<- 1 - while (Flg==0 && I<=NN) - { - Tmp<- Op(I,TenL) - if(Op(1,Ten)<Op(1,Tmp)-Eps) - { - Tmp1<- TenL[Looprange(1,I-1)] - Tmp2<- TenL[Looprange(I,length(TenL))] - TenL<- Mixjoin(Tmp1,list(Ten),Tmp2) - Flg<-1 - } - else - if(Op(1,Ten)<Op(1,Tmp)+Eps) - { - if(Op(4,Ten)!=Op(4,Tmp)) - { - Tmp1<- TenL[Looprange(1,I-1)] - Tmp2<- TenL[Looprange(I,length(TenL))] - TenL<- Mixjoin(Tmp1,list(Ten),Tmp2) - Flg<-1 - } - else - if(Op(3,Ten)!=Op(3,Tmp)) - { - Tmp1<- TenL[Looprange(I,I-1)] - Tmp2<- TenL[Looprange(I+1,length(TenL))] - TenL<- Mixjoin(Tmp1,Tmp2) - } - Flg<- 1 - } - I<- I+1 - } - if(Flg==0) - { - TenL<- Mixjoin(TenL,list(Ten)) - } - } - } - } - } - return(TenL) -} - -########################################## - -Koutenseg<-function(...) -{ - #pointdata on AB at which AB intersects CD - varargin<-list(...) - Nargs<-length(varargin) - Eps0 <- 10^(-4) - A<-varargin[[1]]; V<-varargin[[2]]-A - Sv2 <- V[1]^2+V[2]^2 - if(Sv2<10^(-6)) - { - Out<-Inf - return(Out) - } - P<-varargin[[3]]-A; Q<-varargin[[4]]-A - Eps <- 10.0^(-3) - if(Nargs>=5) - { - Eps<-varargin[[5]] - } - Eps2 <- 0.2 - if(Nargs>=6) - { - Eps2<-varargin[[6]] - } - Eps<-min(Eps2,Eps/sqrt(Sv2)) - P1<-(P[1]*V[1]+P[2]*V[2])/Sv2 - P2<-(-P[1]*V[2]+P[2]*V[1])/Sv2 - Q1<-(Q[1]*V[1]+Q[2]*V[2])/Sv2 - Q2<-(-Q[1]*V[2]+Q[2]*V[1])/Sv2 - m1 <- -Eps; M1 <- 1+Eps - m2 <- -Eps; M2 <- Eps - if(max(P1,Q1)<m1 || min(P1,Q1)>M1) - { - Out<-Inf - return(Out) - } - if(max(P2,Q2)<m2 || min(P2,Q2)>M2) - { - Out<-Inf - return(Out) - } - if(P2*Q2<0) - { - T<- P1-(Q1-P1)/(Q2-P2)*P2 - if(T>m1 && T<M1) - { - if(T > -Eps0 && T<1+Eps0) - { - Tmp1<-A+T*V - Tmp2<-min(max(T,0),1) - Out<-list(Tmp1,Tmp2,0) - } - else - { - Tmp1<-A+T*V - Tmp2<-min(max(T,0),1) - Out<-list(Tmp1,Tmp2,1) - } - return(Out) - } - if(P1<m1 || P1>M1 || P2<m2 || P2>M2) - { - if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2) - { - Out<-Inf - return(Out) - } - T<-min(max(Q1,0),1) - Tmp=A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - T<-min(max(P1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if(P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0) - { - T<- P1 - Tmp<- A+T*V - Out<- list(Tmp, T, 0) - return(Out) - } - if(Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2<Eps0) - { - T<- Q1 - Tmp<-A+T*V - Out<- list(Tmp,T,0) - return(Out) - } - if(P1<m1 || P1>M1 || P2<m2 || P2>M2) - { - if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2) - { - Out<-Inf - return(Out) - } - T<-min(max(Q1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2) - { - T<-min(max(P1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if(abs(P2)<abs(Q2)) - { - T<-min(max(P1,0),1) - } - else - { - T<-min(max(Q1,0),1) - } - Tmp<A+T*V - Out<-list(Tmp,T,1) - return(Out) -} - -########################################## - -Kukeiwake<- function(PL) -{ - Eps<-10.0^(-6) - NW<- c(XMIN,YMAX); SW<-c(XMIN,YMIN) - SE<- c(XMAX,YMIN); NE<-c(XMAX,YMAX) - Tmp<-matrix(c(NW,SW,SE,NE,NW),nrow=2) - Sikaku<- t(Tmp) - Kt<- IntersectcrvsPp(PL,Sikaku) - if(length(Kt)!=2) - { - print("not two points") - return(c()) - } - Tmp<- Op(1,Kt) - Pt1<- Op(1,Tmp) - N1<- trunc(Op(2,Tmp)) - M1<- Op(3,Tmp) - Tmp<- Op(2,Kt) - Pt2<- Op(1,Tmp) - N2<- trunc(Op(2,Tmp)) - M2<- Op(3,Tmp) - T1<- Paramoncurve(Pt1,M1,Sikaku) #18.02.06 - T2<- Paramoncurve(Pt2,M2,Sikaku) - QL<c() - if(Norm(Pt1-Op(N1+1,PL))>Eps) - { - QL<-Pt1 - } - Tmp<-Appendrow(QL,PL[(N1+1):N2,]) - QL<- Tmp - if(Norm(Pt2-Op(N2,PL))>Eps) - { - Tmp<-Appendrow(QL,Pt2) - QL<- Tmp - } - HidariL<- QL - Ms<- M2+1; Me<- M1 - if(T1<T2+Eps) Me<- M1+4 - for (M in Looprange(Ms,Me)) - { - Tmp<- Op(Nrow(HidariL),HidariL) - P<-Op(((M-1) %% 4)+1,Sikaku) - if(Norm(Tmp-P)>Eps) - { - Tmp<-Append(HidariL,P) - HidariL<-Tmp - } - } - Tmp<- Op(Nrow(HidariL),HidariL) - if(Norm(Tmp-Pt1)>Eps) - { - Tmp<-Append(HidariL,Pt1) - HidariL<-Tmp - } - MigiL<- QL - Ms<- M2; Me<- M1+1 - if(T1>T2-Eps) Me<- Me-4 - for (Mm in Looprange(Me,Ms)) - { - M<- Me+Ms-Mm - Tmp<- Op(Nrow(MigiL),MigiL) - P<- Op(((M-1) %% 4)+1,Sikaku) - if(Norm(Tmp-P)>Eps) - { - Tmp<-Appendrow(MigiL,P) - MigiL<-Tmp - } - } - Tmp<- Op(Nrow(MigiL),MigiL) - if(Norm(Tmp-Pt1)>Eps) - { - Tmp<-Appendrow(MigiL,Pt1) - MigiL<-Tmp - } - Out<- list(HidariL,MigiL) - return(Out) -} - -################################### -# 17.09.24 Eps - -Kyoukai<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps0<- 10^(-7) - DataL<-list() - for (I in 1:Nargs){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - DataL<- Mixjoin(DataL,list(list(Tmp))) - } - if(mode(Tmp)=="list"){ - if(mode(Tmp[[1]])!="list"){ - DataL<- Mixjoin(DataL, list(Tmp)) - } - else{ - DataL<-Mixjoin(DataL,Tmp) - } - } - } - Eps<- 10.0^(-4) #17.09.24 - PLall<- list() - Sflg<- 0 - N<- length(DataL) - for (I in 1:N){ - Data<- Op(I, DataL) - Tmp<- Op(length(Data),Data) - if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ - Rg<-Tmp ; Nd<-length(Data)-1 - } - else{ - if(mode(Tmp)=="character"){ - Rg<- Tmp ; Nd<-length(Data)-1 - } - else{ - Rg<- "c" ; Nd<-length(Data) - } - } - for (J in Looprange(1,Nd)){ - Tmp<- Op(J,Data) - if(mode(Tmp)=="character"){ - Rg<- Tmp - next - } - Points<- Tmp - P1<- Ptstart(Points) - P2<- Ptend(Points) - if(J==1){ - PL<- Points - Pfirst<- P1 - Plast<- P2 - if(Nd>=2){ - Tmp<- Data[[2]] - P<- Ptstart(Tmp) - Q<- Ptend(Tmp) - if(Norm(P2-P)>Eps && Norm(P2-Q)>Eps){ - Tmp< Nrow(PL) - PL<-PL[Tmp:1,] - Pfirst<- Ptstart(PL) - Plast<- Ptend(PL) - } - } - } - else{ - if(Norm(P1-Plast)<Eps){ - Stp<-1; Ks<-2; Ke=Nrow(Points) - } - else{ - if(Norm(P2-Plast)<Eps) { - Stp<- -1; Ks<-Nrow(Points)-1; Ke=1 - } - else{ - Tmp<-Appendrow(PL,c(Inf,Inf),Points) - PL<- Tmp - Sflg<- 1 - Pfirst<- P1 - Plast<- P2 - Stp<- 1; Ks<- Nrow(Points)-1; Ke<- 1 - } - } - for (K in seq(Ks,Ke, by=Stp)){ - Tmp<- Appendrow(PL,Op(K,Points)) - PL<-Tmp - } - Plast<- Op(Ke,Points) - } - } - if(Norm(Pfirst-Plast)>Eps){ - Np<- Nrow(PL) - if(Rg=="c"){ - Tmp<- Appendrow(PL,Pfirst) - PL<- Tmp - } - else if(Rg=="s"){ - Tmp<- c(PL[1:Np,2],YMIN) - Y<- min(Tmp)-1 - P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) - Tmp<- Appendrow(PL,P,Q,Pfirst) - PL<- Tmp - } - else if(Rg=="n"){ - Tmp<- c(PL[1:Np,2],YMAX) - Y<-max(Tmp)+1 - P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) - Tmp<- Appendrow(PL,P,Q,Pfirst) - PL<- Tmp - } - else if(Rg=="w"){ - Tmp<- c(PL[1:Np,1],XMIN) - X<- min(Tmp)-1 - P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) - Tmp<- Appendrow(PL,P,Q,Pfirst) - PL<- Tmp - } - else if(Rg=="e"){ - Tmp<- c(PL[1:Np,1],XMAX) - X<- max(Tmp)+1 - P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) - Tmp<- Appendrow(PL,P,Q,Pfirst) - PL<- Tmp - } - else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){ - Tmp<- Kukeiwake(PL) - Tmp1<- Op(1,Tmp) - Tmp2<- Naigai(Rg,list(Tmp1)) - if(Tmp2==c(1)){ - PL<-Op(1,Tmp) - } - else{ - PL<- Op(2,Tmp) - } - } - } - Tmp<- Ptstart(PL) - for (J in 2:Nrow(PL)){ - P<- Op(J,PL) - Q<- Op(Nrow(Tmp),Tmp) - if(Norm(P-Q)>Eps){ - Tmp1<-Appendrow(Tmp,P) - Tmp<-Tmp1 - } - } - PL<-Tmp - PLall<-Mixjoin(PLall,list(PL)) - } - if(length(PLall)==1 && Sflg==0){ - Tmp<- Op(1,PLall) -# Tmp<- Op(1,Tmp) - if(Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){ - Tmp1<- Appendrow(Tmp,Ptstart(Tmp)) - PLall<- list(Tmp1) - } - } - return(PLall) -} - -###################################### - -Letter<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - Irng<-c(seq(from=1,to=Nargs,by=3)) - for (I in Irng) - { - Tmp<-varargin[[I]] - P<- Doscaling(Tmp) - X<-P[1] - Y<-P[2] - Houkou<-varargin[[I+1]] - Mojiretu<-varargin[[I+2]] - Hset<-Houkou - Vhoko<-"c" - if(length(grep("n",Hset))>0) - { - Vhoko<-"n"; Y<-Y+MEMORI - } - if(length(grep("s",Hset))>0) - { - Vhoko<-"s"; Y<-Y-MEMORI - } - Hhoko<-"c" - if(length(grep("e",Hset))>0) - { - Hhoko<-"e"; X<-X+MEMORI - } - if(length(grep("w",Hset))>0) - { - Hhoko<-"w"; X<-X-MEMORI - } - Hoko<-paste(Vhoko,Hhoko,sep="") - Suu<-"+-.0123456789" - SuuL<-Suu - J<-1; Dstr<-"" - while (J<=nchar(Houkou)) - { - Tmp<-substring(Houkou,J,J) - if(length(grep(Tmp,SuuL))>0) - { - if(Dstr=="") Hk<-substring(Houkou,J-1,J-1) - Dstr<-paste(Dstr,Tmp,sep="") - } - else - { - if(Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI - if(Hk=="n") Y<-Y+D - if(Hk=="s") Y<-Y-D - if(Hk=="e") X<-X+D - if(Hk=="w") X<-X-D - Dstr<-"" - } - } - J<-J+1 - } - if(Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI; - if(Hk=="n") Y<-Y+D - if(Hk=="s") Y<-Y-D - if(Hk=="e") X<-X+D - if(Hk=="w") X<-X-D - } - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - cat("\\put(",file=Wfile,append=TRUE) - Tmp1<- sprintf("%7.7f",X) # 11.07.19 - Tmp2<- sprintf("%7.7f",Y) # 11.07.19 - Str<-paste(Tmp1,",",Tmp2,sep="") - cat(Str,file=Wfile,append=TRUE) - Tmp<-"){\\hspace*{\\Width}" - Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) - } -} - -###################################################### - -Letterrot<- function(...) -{ - varargin<- list(...) - P<- varargin[[1]] - V<- varargin[[2]]; N<- 3 - P<- Doscaling(P) - V<- Doscaling(V) - Tmov<- 0 - Tmp<- varargin[[N]] - if(mode(Tmp)=="numeric"){ - Tmov<- Tmp; N<- N+1 - } - Nmov<- 0 - Tmp<- varargin[[N]] - if(mode(Tmp)=="numeric"){ - Nmov<- Tmp; N<- N+1 - } - Mojiretu<- Assign(varargin[[N]]) #2017.11.26 - Tv<- 1/Norm(V)*V - Nv<- c(-Tv[2],Tv[1]) - P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv - Tmp<- acos(V[1]/Norm(V)) - Theta<- round(Tmp*180/pi) - if(V[2]>=0){ - Units<- "" - } - else{ - Units<- "units=-360," - } - Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") - Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") - Letter(P,"c",Tmp) -} - -################################### -# 10.12.04 - -Lineplot<-function(...) -{ - varargin <- list(...) - Nargs<-length(varargin) - A<-varargin[[1]] - if(is.numeric(A)) { - Tmp<-length(A) - if(Tmp>3) { - B <- A[(Tmp/2+1):Tmp] - A <- A[1:(Tmp/2)] - Is <- 2 - } - else { - B<-varargin[[2]] - Is <- 3 - } - } - else { - B<-A[[2]] - A<-A[[1]] - Is <- 2 - } - Mag <- 100 ; Semi <- "" ## 10.12.04 - for (I in Looprange(Is,Nargs)) { - Tmp <- varargin[[I]] - switch ( mode(Tmp), - "numeric"= Mag <- Tmp, - "character"= Semi <- Tmp - ) - } -V<- Mag/Norm(B-A)*(B-A) ## 10.12.04 from here - if(Semi=="") { - Out<- Listplot(c(A-V,A+V)) - } - else if(Semi=="+") { - Out<- Listplot(c(A,A+V)) - } - else { - Out<- Listplot(c(A-V,A)) - } ## 10.12.04 to here - return(Out) -} - -################################ - -Listplot<-function(...) -{ - varargin<-list(...); - Z<-c(); - for (I in 1:length(varargin)) - { - Data<-varargin[[I]]; - if(mode(Data)=="numeric") - { - if(class(Data)=="numeric") - { - Tmp<-matrix(Data,nrow=2); - Tmp<-t(Tmp); - Z<-Appendrow(Z,Tmp) - } - else - Z<-Appendrow(Z,Data) - } - else - { - for (J in 1:length(Data)) - { - Tmp<-Data[[J]]; - Z<-Appendrow(Z,Tmp) - } - } - } - return(Z) -} - -############################## - -MakeBowdata <- function(PA,PB,H) -{ - Eps <- 10^(-5) - BOWSTART <<- PA - BOWEND <<- PB - D <- 1/2*Norm(PB-PA) - R <- (H^2+D^2)/(2*H) - A1 <- PA[1]; A2<-PA[2] - B1 <- PB[1]; B2<-PB[2] - if(abs(A2-B2)>Eps){ -# x <- poly(0,"X") -# y <- -(A1-B1)*x/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) -# Eq1 <- (A1-x)^2+(A2-y)^2-R^2 -# Tmp <- coeff(Eq1) -# C0 <- Tmp[1]; C1<-Tm[2]; C2<-Tmp[3] - C0<- A1^2+(A2-(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2))^2-R^2 - C1<- -(A1+B1)*(A2^2+B2^2-2*A2*B2-2*A1*B1+A1^2+B1^2)/(A2-B2)^2 - C2<- 1+(A1-B1)^2/(A2-B2)^2 - Det <- sqrt(C1^2-4*C0*C2) - Ansx1 <- (-C1+Det)/(2*C2) - Ansx2 <- (-C1-Det)/(2*C2) - Tmp <- -(A1-B1)*Ansx1/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) - PC <- c(Ansx1,Tmp) - Tmp <--(A1-B1)*Ansx2/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) - PC2 <- c(Ansx2,Tmp) - } - else{ - Tmp <- 0.5*(PA+PB) - PC <- Tmp+c(0,R-H) # 11.06.02 - PC2 <- Tmp-c(0,R-H) - } - VA <- PA-PC - VB <- PB-PC - if(VA[1]*VB[2]-VA[2]*VB[1]<0) { - PC <- PC2 - } - AngA <- acos((PA[1]-PC[1])/R) - if(PA[2]-PC[2]<0){ - AngA <- -AngA - } - AngB <- acos((PB[1]-PC[1])/R) - if(PB[2]-PC[2]<0){ - AngB <- -AngB - } - if(AngA>AngB) { - AngB <- AngB+2*pi - } - Out <- list(PC,R,AngA,AngB) - return(Out) -} - -#################################################### - -MakeCurves<-function(...){ ## Scaling is implemented - varargin<-list(...) - Figdata<-varargin[[1]] - if(class(Figdata)=="numeric"){ - Figdata<-matrix(Figdata,nrow=1) - } - Ptout<-1 - if(length(varargin)>=2) Ptout<-varargin[[2]] - Eps<-10.0^(-6) - IndM<-Dataindex(Figdata) - Atos<-c() - for (Nd in 1:Nrow(IndM)){ - Tmp<-IndM[Nd,] - Motos<-Figdata[Tmp[1]:Tmp[2],] - All<-Nrow(Motos) - if(Nrow(Motos)==1){ - if(InWindow(Motos)=="o"){ - next - } - Tmp1<- as.numeric(Motos) - if(Ptout==1){ - Drwpt(Tmp1) - } - else{ - Tmp1<- Doscaling(Tmp1) - Atos<-Appendrow(Atos,c(Inf,Inf),Tmp1) - next - } - } - Crv<-c() - for (I in Looprange(2,All)){ - P<- Op(I-1,Motos) - Q<- Op(I,Motos) - Snbn<-MeetWindow(P,Q) - if(length(Snbn)==0){ - if(length(Crv)>0){ - Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) - Crv<-c() - } - } - else{ - if(Norm(Snbn[1,]-Snbn[2,])<Eps){ next} # naosi 101202 - if(length(Crv)==0){ - Crv<-Snbn - } - else{ - Tmp<-Op(Nrow(Crv),Crv) - if(Norm(Tmp-Op(1,Snbn))<Eps){ - Crv<-Appendrow(Crv,Op(2,Snbn)) - } - else{ - Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) - Crv<-Snbn - } - } - } - } - if(Nrow(Crv)>=2) - { - Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) - } - } - Outdata<-Atos[2:Nrow(Atos),] - if(class(Outdata)=="numeric") - { - Outdata<-matrix(Outdata,nrow=1) - } - return(Outdata) -} - -###################################### - -Makehasen<- function(Figdata,Sen,Gap,Ptn) -{ - Eps<- 10.0^(-6) - Clist<- MakeCurves(Figdata) - DinM<- Dataindex(Clist) - for (N in Looprange(1,Nrow(DinM))){ - Tmp<- DinM[N,] - Data<- Clist[Tmp[1]:Tmp[2],] - Dtall<- Nrow(Data) - Len<- 0 - Lenlist<- c(0) - for (I in Looprange(2,Dtall)){ - Len<- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist<- c(Lenlist,Len) - } - Lenall<- Lenlist[Dtall] - if(Lenall==0){ - next - } - Kari<- (Sen+Gap)*0.1 - Naga<- Sen*0.1 - Tobi<- Gap*0.1 - if(Norm(Data[1,]-Data[Dtall,])<Eps){ - Nsen<- max(ceiling(Lenall/Kari),3) - SegUnit<- Lenall/Nsen - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit)) - } - else{ - if(Ptn==0){ - Nsen<- max(ceiling((Lenall+Tobi)/Kari),3) - SegUnit<- Lenall*(Sen+Gap)/(Nsen*Sen+(Nsen-1)*Gap) - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit)) - } - else{ - Nsen<- max(ceiling((Lenall+Naga)/Kari),3) - SegUnit<- Lenall*(Sen+Gap)/((Nsen-1)*Sen+Nsen*Gap) - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(Tobi,Tobi+(Nsen-2)*SegUnit,by=SegUnit)) - } - } - Hajime<- 1; Owari<- 1 - Mojisu<- 0 - for (I in Looprange(1,length(SegList))){ - Len<- SegList[I] - J<- Owari - while (Len>=Lenlist[J]-Eps){ - if(J==Dtall){ - break - } - J<- J+1 - } - Hajime<- J-1 - J<- Hajime - while (Len+Naga>Lenlist[J]-Eps){ - if(J==Dtall){ - break - } - J<- J+1 - } - Owari<- J-1 - T<- (Len-Lenlist[Hajime]) - T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) - P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - for (J in Looprange(Hajime+1,Owari)){ - P<- Data[J,] - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - } - T<- (Len+Naga-Lenlist[Owari]) - T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) - P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str1<- paste("\\special{pa ",X," ",Y,"}",sep="") - Str2<- "\\special{fp}" - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str1)+nchar(Str2) - if(Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - cat("%\n%\n",file=Wfile,append=TRUE); -} - -###################################### - -Makeliststr<- function(L) -{ - Out="list(" - for (I in 1:length(L)){ - Dt<- L[[I]] - if(mode(Dt)=="numeric"){ - if(length(Dt)==1){ - Dts<- as.character(Dt) - } - else{ - Dts<- "c(" - for (J in Looprange(1,Nrow(Dt))){ - for (K in 1:ncol(Dt)){ - Dts<- paste(Dts,as.character(Dt[J,K]),sep="") - if(K< ncol(Dt)){ - Dts<- paste(Dts,",",sep="") - } - } - if(J<Nrow(Dt)){ - Dts<- paste(Dts,";",sep="") - } - else{ - Dts<- paste(Dts,")",sep="") - } - } - } - } - if(mode(Dt)=="character"){ - Dts<- paste(Prime(),Dt,Prime(),sep="") - } - if(mode(Dt)=="list"){ - Dts<- Makeliststr(Dt) - } - Out<- paste(Out,Dts,sep="") - if(I<length(L)){ - Out<- paste(Out,",") - } - else{ - Out<- paste(Out,")",sep="") - } - } - return(Out) -} - -############################################ - -Makeshasen<- function(PtnL,PA,V,Bdy) -{ - Eps<- 10^(-6) - TenL<- KoutenList(PA,V,Bdy) - Nten<- length(TenL) - Call<- length(Bdy) - Ptn<- c(seq(0, 0, length=Call)) - Out<- list() - GL<- c() - Te<- -10^6 - for (I in Looprange(1,Nten-1)){ - TenP<- Op(I,TenL); TenQ<- Op(I+1,TenL) - Ts<- Op(1,TenP) - P<- Op(2,TenP); Q<- Op(2,TenQ) - NC<- Op(4,TenP) - Tmp<- (Op(NC,Ptn)+1) %% 2 - Ptn[NC]<- Tmp - if(Op(1,TenQ)-Ts>Eps){ - if(Member(Ptn,PtnL)){ - if(abs(Te-Ts)>Eps){ - if(Nrow(GL)>0){ - Tmp<- Mixjoin(Out, list(GL)) - Out<- Tmp - } - GL<- Listplot(P,Q) - } - else{ - Tmp <- Appendrow(GL, Q) - GL<- Tmp - } - Te<- Op(1,TenQ) - } - } - } - if(Nrow(GL)>0){ - Tmp<- Mixjoin(Out, list(GL)) - Out<- Tmp - } - return(Out) -} - -############################################# - -Mawarikomi<- function(...) -{ - varargin<- list(...) - haba<- "10cm" - Nargs<- length(varargin) - if(Nargs>0){ - haba<- varargin[[1]] - } - cat("\\begin{mawarikomi}%\n",file="",append=TRUE) - cat("%<1>[5](0,0)%\n",file="",append=TRUE) - Str<- paste("{",haba,"}{%\n",sep="") - cat(Str,file="",append=TRUE) - cat("}%\n",file="",append=TRUE) - cat("\\end{mawarikomi}",file="",append=TRUE) -} - -############################################## - -MeetWindow<-function(PA,PB) -{ - if(InWindow(PA)=="i" && InWindow(PB)=="i") - { - R<-Appendrow(PA,PB) - return(R) - }; - Horner<-function(n,t) - { - PT<-(1-t)*PA+t*PB; - return(PT[n]) - } - Eps<-10.0^(-6); - Txm<-(-1); TxM<-(-1); Tym<-(-1); TyM<-(-1); - if(PA[1]!=PB[1]) - { - Txm<-(XMIN-PA[1])/(PB[1]-PA[1]); - TxM<-(XMAX-PA[1])/(PB[1]-PA[1]); - } - if(PA[2]!=PB[2]) - { - Tym<-(YMIN-PA[2])/(PB[2]-PA[2]); - TyM<-(YMAX-PA[2])/(PB[2]-PA[2]); - } - Tmp<-Horner(2,Txm); - if(Tmp<YMIN-Eps || Tmp>YMAX+Eps) - { - Txm<-(-1); - } - Tmp<-Horner(2,TxM); - if(Tmp<YMIN-Eps || Tmp>YMAX+Eps) - { - TxM<-(-1) - } - Tmp<-Horner(1,Tym); - if(Tmp<XMIN-Eps || Tmp>XMAX+Eps) - { - Tym<--1 - } - Tmp<-Horner(1,TyM); - if(Tmp<XMIN-Eps || Tmp>XMAX+Eps) - { - TyM<--1 - } - Tans<-sort(c(Txm,TxM,Tym,TyM)); - Tmp<-c(); - for (I in 1:length(Tans)) - { - Tmp1<-Tans[I]; - if(Tmp1>-Eps && Tmp1<1+Eps) - { - if(length(Tmp)==0) - { - Tmp<-c(Tmp1); - } - else - { - if(abs(Tmp[length(Tmp)]-Tmp1)>Eps) - { - Tmp<-c(Tmp,Tmp1) - } - } - } - } - Tans<-Tmp; - if(length(Tans)==0) - { - R<-c(); - return(R); - } - if(length(Tans)==1) - { - Ten1<-Horner(1:2,Tans[1]); - if(InWindow(PA)=="i") - { - R<-Appendrow(PA,Ten1) - return(R) - } - else - { - R<-Appendrow(Ten1,PB) - return(R) - } - } - Ten1<-Horner(1:2,Tans[1]) - Ten2<-Horner(1:2,Tans[2]) - R<-Appendrow(Ten1,Ten2) - return(R) -} - -######################################### - -# New 10.03.21 - -Mixjoin<-function(...) -{ - varargin<-list(...) - Nargs<- length(varargin) - M<- list() - for (I in 1:Nargs) - { - Tmp<-varargin[[I]] - if(length(Tmp)==0) next - if(Mixtype(Tmp)==1) - { - Tmp<-list(Tmp) - } - if(length(M)==0){ - M <- Tmp - } - else{ - M<- c(M,Tmp) - } - } - return(M) -} - -################################# - -Mixlength<- function(PL){ - if(length(PL)==0){ - return(0) - } - if(Mixtype(PL)==1){ - Out<- Nrow(PL) - } - else{ - Out<- length(PL) - } - return(Out) -} - -########################################### - -Mixtype<- function(D) -{ - if(mode(D)!="list") return(1) - for (I in 1:length(D)) - { - Tmp<- D[[I]] - if(mode(Tmp)=="list") return(3) - } - return(2) -} - -########################################### - -Naigai<- function(A,Bdy) -{ - V<- c(1,1) - Call<-length(Bdy) - KL<- KoutenList(A,V,Bdy) - Ptn<- seq(1,1,length=Call) - for (K in Looprange(1,length(KL))) - { - Ten<- Op(K,KL) - T<- Op(1,Ten); NC<- Op(4,Ten) - if(T<0) - { - Tmp<- (Ptn[NC]+1) %% 2 - Ptn[NC]<- Tmp - } - } - return(Ptn) -} - -######################################## - -Nearestpt<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - PL1<- varargin[[1]] - if(!is.matrix(PL1)){ - Tmp<- matrix(PL1); - PL1<- t(Tmp) - } - if(Nrow(PL1)==1) Flg=0 - else Flg=1 - Eps<- 10.0^(-6) - PL<- varargin[[2]] - Ans<- list(PL1[1,],1,PL[1,],1,Norm(PL1[1,]-PL[1,])) - for(N in Looprange(1,Nrow(PL1))){ - PA<- PL1[N,] - Pm<- PL[1,] - Im<- 1 - Sm<- Norm(Pm-PA) - for(I in Looprange(1,Nrow(PL)-1)){ - A1<- PL[I,1]; A2<-PL[I,2] - B1<- PL[I+1,1]; B2<-PL[I+1,2] - V1<- B1-A1; V2<-B2-A2 - X1<- PA[1]; X2<-PA[2] - Tmp<-V2^2+V1^2 - if(abs(Tmp)<Eps) next - T<- (-A2*V2-V1*A1+V1*X1+X2*V2)/Tmp - if(T< -Eps){ - P<- c(A1,A2) - }else{ - if(T>1+Eps){ - P<- c(B1,B2) - }else{ - P<- c(A1+T*V1,A2+T*V2) - } - } - S<- Norm(P-PA) - if(S<Sm-Eps){ - Tmp<- Paramoncurve(P,I,PL) - Pm<- P; Im<- Tmp; Sm<- S - } - } - if(Sm<Op(5,Ans)) Ans<- list(PA,N,Pm,Im,Sm) - if(Flg==0){ - Ans<- Ans[3:5] - } - } - return(Ans) -} - -######################################### - -Newlength<- function() -{ - Tmp1<- "\\newlength{\\Width}%\n" - Tmp2<- "\\newlength{\\Height}%\n" - Tmp3<- "\\newlength{\\Depth}%\n" - cat(Tmp1,file="",append=TRUE); - cat(Tmp2,file="",append=TRUE); - cat(Tmp3,file="",append=TRUE); -} - -######################################### - -Numptcrv<-function(Fig) -{ - return(Nrow(Fig)) -} - -# 2018.01.29 -Length<- function(Data){ - if(is.matrix(Data)){return(nrow(Data))} - if(is.character(Data)){return(nchar(Data))} - return(length(Data)) -} - -######################################### - -Op<-function(N,Data) -{ - C <- c() - if(length(Data)==0) return(C) - if(mode(Data)=="list"){ - if(class(Data)=="data.frame"){ # 10.02.23 - C<- Data[N,] - } - else{ - C<- Data[[N]] - } - return(C) - } - if(mode(Data)=="character"){ - if(length(Data)==1){ - C<- substring(Data,N,N) - } - else{ - C<- Data[N] - } - return(C) - } - if(mode(Data)=="numeric"){ - if(class(Data)=="matrix"){ - Din<- Dataindex(Data) - if(nrow(Din)==1){ - C<- Data[N,] - } - else{ - Tmp1<- Din[N,1] - Tmp2<- Din[N,2] - C<- Data[Tmp1:Tmp2,] - } - } - else{ - C=Data[N] - } - } - return(C) -} - -######################################### -# 2013.05.20 Changed ( Creator recorded) -# 2013.12.18 Beginpicture inclued - -Openfile<-function(...) -{ - varargin<- list(...) - File<- varargin[[1]] - Bflg<- 0 - Wfile<<- File - Creator<- "" - Cflg<- 0 - Nargs<- length(varargin) - for(N in Looprange(2,Nargs)){ - Tmp<- varargin[[N]] - Tmp1<- strsplit(Tmp,"=",fixed=TRUE) - Tmp1<- Tmp1[[1]] - if(length(Tmp1)>1){ - Creator<- Tmp1[2] - Cflg<- 1 - } - else{ - Unitstr<- Tmp - Bflg<- 1 - } - } - Recentf<- "" - Fv<- list.files() - Nv<- grep("\\.r$", Fv) - Rfiles<- Fv[Nv] - StrW<- paste("%%% ",File,sep="") #17.10.28 - StrC<- paste("%%% Generator=",Creator,sep="") - if(Cflg==0){ - } - cat(StrW,"\n",file=Wfile) - cat(StrC,"\n",file=Wfile,append=TRUE) - if(Bflg==1){ - Beginpicture(Unitstr) - } -} - -######################################### - -Openpar<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Tmp<- varargin[[1]] - Tmp1<- substr(Tmp,1,1) - if(Tmp1=="\\"){ - Namestr<- Tmp - N<- 2 - } - else{ - Namestr<- "\\tmp" - N<- 1 - } - Habastr<- varargin[[N]] - if(Nargs>N){ - Posstr<- paste("[",varargin[[N+1]],"]",sep="") - } - else{ - Posstr<- "[c]" - } - Openphr(Namestr) - S<- paste("\\begin{minipage}",Posstr,"{",Habastr,"}%\n",sep="") - cat(S,file=Wfile,append=TRUE) -} - -################################### - -Openphr<- function(Str) -{ - S<- paste("\\def",Str,"{%\n",sep="") - cat(S,file=Wfile,append=TRUE) -} - -##################################### - -Ovalbox<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Pos<- varargin[[1]] - Dr<- varargin[[2]] - StrV<- varargin[[3]] - R<- 0.2 - NDflg<- 0 - for (I in Looprange(4,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - R<- Tmp - } - else{ - if(substr(Tmp,1,1)=="-"){ - NDflg<- 1 - Tmp1<- substr(Tmp,2,nchar(Tmp)) - Cmdstr<- chartr("*","G",Tmp1) - } - } - } - Xr<- c(XMIN,XMAX) - Yr<- c(YMIN,YMAX) - Uv<- 0.6; Uh<- 0.8 - N<- nchar(StrV) - W<- Uh;H<- Uv*N - Setwindow(c(-W/2,W/2),c(-H,0)) - G<- Ovaldata(c(0,-H/2),W/2,H/2,R) - Openphr("\\ketpictmp") - Beginpicture("1cm") - if(NDflg==0){ - Drwline(G) - } - else{ - eval(parse(text=Cmdstr)) - } - for (I in Looprange(1,N)){ - Letter(c(0,Uv/2-Uv*I),"c",Op(I,StrV)) - } - Endpicture(0) - Closephr() - Setwindow(Xr,Yr) - Letter(Pos,Dr,"\\ketpictmp") -} - -########################################## - -Ovaldata<- function(...) #17.09.11 -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==1){ - Eps<- 1.0*10^(-4) - C<- c((XMIN+XMAX)/2,(YMIN+YMAX)/2) - Dx<- XMAX-C(1)-Eps - Dy<- YMAX-C(2)-Eps - N<- 1 - } - else{ - C<- varargin[[1]] - Dx<- varargin[[2]] - Dy<- varargin[[3]] - N<- 4 - } - Rc<- 0.2 - if(N<=Nargs){ #15.11.15 - Rc<- varargin[[N]]*Rc #15.11.15 - } - Out<- c() - P<- C+c(Dx-Rc,Dy-Rc) - Tmp1<- Circledata(c(P,Rc),"R=c(0,pi/2)","N=10") #17.11.29 - Tmp2<- Listplot(C+c(Dx-Rc,Dy),C+c(0,Dy)) - Tmp3<- Listplot(C+c(Dx,0),C+c(Dx,Dy-Rc)) - G<- Joincrvs(Tmp3,Tmp1,Tmp2) - Tmp<- Reflectdata(G,c(C,C+c(0,1))) - G<- Joincrvs(G,Tmp) - Tmp<- Reflectdata(G,c(C,C+c(1,0))) - Out<- Joincrvs(G,Tmp) -} - -######################################### - -Paramark<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - PA<- varargin[[1]] - PB<- varargin[[2]] - PC<- varargin[[3]] - R<- 0.5 - if(Nargs>=4){ - R<- varargin[[4]]*R - } - U<- R*(PA-PB)/Norm(PA-PB) - V<- R*(PC-PB)/Norm(PC-PB) - if(Crossprod(PA-PB,PC-PB)!=0){ - P<- Listplot(c(PB+U,PB+U+V,PB+V)) - } - else{ - P<- c() - } -} - -########################################### - -Paramoncurve<-function(...){ - varargin<-list(...) - Nargs<-length(varargin) - Eps<-10^(-8) - P<-varargin[[1]] - Gdata<-varargin[[Nargs]] - if(Nrow(P)>1){ - Tmp<-P; P<-Gdata; Gdata<-Tmp - } - if(Nargs==2){ - Tmp<-Nearestpt(P,Gdata) - Out<-Tmp[[2]] - return(Out) - } - N<-varargin[[2]] - PtL<-Gdata - N=min(N,Length(PtL)-1) #18.02.11from - Pa<-Ptcrv(N,PtL) - Pb<-Ptcrv(N+1,PtL) - V<-Pb-Pa - W<-P-Pa - D2<-Norm(V)^2 - if(D2<Eps) return(0) - S<-Dotprod(V,W)/D2 - S<-min(max(S,0),1) - Out=N+S #18.02.11upto - return(Out) -} - -############################################## - -Paramplot<- function(...) -{ - varargin<- list(...) - Eps<- 10^(-5) - Nargs<- length(varargin) - Fnflg<- 0 - Fnstr<- varargin[[1]]; Is=2 - Rgstr<- varargin[[Is]]; Is<- Is+1 - Range<- c(0,2*pi) - N<- 50 # Numpoints - E<-c() # Exclusions - D<- Inf # Discont - for (I in Looprange(Is,Nargs)) - { - Tmp<- varargin[[I]] - Tmp<- strsplit(Tmp,"=") - K<- Tmp[[1]] - Tmp<- K[1] - Lhs<- substring(Tmp,1,1) - Tmp1<- K[2] - Str<-paste(Lhs,"=",Tmp1,sep="") - eval(parse(text=Str)) - } - Tmp<- strsplit(Rgstr,"=") - K<-Tmp[[1]] - if(length(K)>1) - { - Vname<- K[1] - Tmp1<- K[2] - Rng<- eval(parse(text=Tmp1)) - } - else - { - Vname<- Rgstr - Rng<- c(0,2*pi) - } - T1<- Rng[1]; T2<- Rng[2] - Dt<- (T2-T1)/N #17.09.22 - if(Fnflg==0) - { - Str<- gsub(Vname,"t",Fnstr) - } - if(abs(Dt)<Eps){ # 16.12.13 - t=T1 - P=eval(parse(text=Str)) - return(P) - } - P<-c() - if(length(E)>0) - { - E<-sort(E) - E<E[length(E):1] - } - E<- c(E, Inf) - Tmp<- sort(E) - E<- E[length(Tmp):1] - Ke<- 1 -# for (t in seq(T1, T2+Eps, by=Dt)){#18.02.05 - for(jj in 1:(N+1)){ - t=T1+(jj-1)*Dt - Pa<- c() - if(t-E[Ke]< Eps) - { - if(Fnflg==0) - { - Tmp<-eval(parse(text=Str)) - Pa<- Tmp - } - else - { - } - } - if(abs(t-E[Ke])<=Eps) - { - if(Nrow(P)>0 && Op(Nrow(P),P)!=c(Inf,Inf)) - { - Pa<- c(Inf,Inf) - } - } - if(t-E[Ke]>Eps) - { - if(Fnflg==0) - { - Tmp<- eval(parse(text=Str)) - Pa<- Tmp - } - else - { - } - Ke<-Ke+1 - } - if(length(Pa)>0) - { - if(Pa[1]==Inf) - { - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else - { - if(Nrow(P)==0) - { - Tmp<- Appendrow(P,Pa) - P<-Tmp - } - else - { - Tmp<- Op(Nrow(P),P) - if(Tmp[1]==Inf) - { - Tmp<- Appendrow(P,Pa) - P<- Tmp - } - else - { - if(Norm(Tmp-Pa)<D) - { - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else - { - Tmp<- Appendrow(P,c(Inf,Inf),Pa) - P<- Tmp - } - } - } - } - } - } - Tmp<- Nrow(P) - Tmp1<- Op(Tmp,P) - if(Tmp1[1]==Inf) - { - P<- P[1:(Tmp-1),] - } - return(P) -} - -##################################### - -Partcrv<- function(A,B,PkL) -{ - Eps<- 10.0^(-3) - if(mode(A)=="numeric" && length(A)==1){ - if(A>B+Eps){ - Npt<- Numptcrv(PkL) - Out1<- Partcrv(A,Npt,PkL) - Out2<- Partcrv(1,B,PkL) - Tmp<- Ptstart(PkL)-Ptend(PkL) - if(Norm(Tmp)<Eps){ - Ans<- Joincrvs(Out1,Out2) - } - else{ - Ans<- list(Out1,Out2) - } - return(Ans) - } - Is<- ceiling(A) - Ie<- floor(B) - PL<- c() - if(A<Is-Eps){ - P<- (Is-A)*PkL[Is-1,]+(1-Is+A)*PkL[Is,] - PL<- c(P) - } - PL<- Appendrow(PL, PkL[Looprange(Is,Ie),]) - if(B>Ie+Eps){ - P<- (1-B+Ie)*PkL[Ie,]+(B-Ie)*PkL[Ie+1,] - PL<- Appendrow(PL,P) - } - Ans<- PL - return(Ans) - } - Tmp<- Nearestpt(A,PkL) - Ta<- Op(2,Tmp) - Tmp<- Nearestpt(B,PkL) - Tb<- Op(2,Tmp) - Ans<- Partcrv(Ta,Tb,PkL) -} - -########################################## -# 13.05.03 - -Partframe<- function(Tb,St,Ed) -{ - G<- Dividetable(Tb) - Gw<- G[[1]] - Gt<- G[[2]] - Gy<- G[[3]] - Gwt<- Tb[[4]] - Gwy<- Tb[[5]] - Gat<- c(list(Gwt[[1]]),Gt,list(Gwt[[2]])) - Gay<- c(list(Gwy[[1]]),Gy,list(Gwy[[2]])) - Tmp1<- Ptstart(Gat[[St[1]]]) - Tmp2<- Ptstart(Gay[[St[2]]]) - Ps<- c(Tmp1[1],Tmp2[2]) - Tmp1<- Ptstart(Gat[[Ed[1]]]) - Tmp2<- Ptstart(Gay[[Ed[2]]]) - Pe<- c(Tmp1[1],Tmp2[2]) - Pars<- Paramoncurve(Ps,Gw) - Pare<- Paramoncurve(Pe,Gw) - if(Pars<Pare){ - Out<- Partcrv(Pars,Pare,Gw) - } - else{ - Tmp1<- Partcrv(Pars,Numptcrv(Gw),Gw) - Tmp2<- Partcrv(1,Pare,Gw) - Out<- Joincrvs(Tmp1,Tmp2) - } -return(Out) -} - - -########################################## -# 10.12.04 - -Plotdata<- function(...) -{ - varargin<- list(...) - Eps<- 10^(-5) - Fnstr<- varargin[[1]]; Is<- 2 - Fnflg<- 0 - Rgstr<- varargin[[Is]]; Is<- Is+1 - Tmp<- strsplit(Rgstr,"=") - K<-Tmp[[1]] - if(length(K)>1){ - Vname<- K[1] - Tmp1<- K[2] - Rng<- eval(parse(text=Tmp1)) - } - else{ - Vname<- Rgstr - Rng<- c(XMIN,XMAX) - } - N<- 50 # Numpoints - E<-c() # Exclusions - Exfun<- "" # Exclusion function - D<- Inf # Discont - for (I in Looprange(Is,length(varargin))){ - Tmp<- varargin[[I]] - Lhs<- substring(Tmp,1,1) - Tmp<- strsplit(Tmp,"=") - K<- Tmp[[1]] - Tmp1<- K[2] - Tmp2<- grep(Vname,Tmp1,fixed=TRUE) ## 10.12.04 - if(length(Tmp2)==0){ - Str<-paste(Lhs,"=",Tmp1,sep="") - eval(parse(text=Str)) - } - else{ - Exfun<-Tmp1 - } - } - X1<- Rng[1]; X2<- Rng[2] - dx<- (X2-X1)/N # 17.09.22 - if(Fnflg==0){ - Str<- gsub(Vname,"x",Fnstr,fixed=TRUE) - } - if(abs(dx)<Eps){ # Scilab 16.12.13 - x=X1 - P=c(X1,eval(parse(text=Str))) - return(P) - } - Exfun<- gsub(Vname,"x",Exfun,fixed=TRUE) - P<-c() - if(length(E)>0){ - E<-sort(E) - E<E[length(E):1] - } - E<- c(E, Inf) - Tmp<- sort(E) - E<- E[length(Tmp):1] - Ke<- 1 - for (x in seq(X1,X2,by=dx)){ - if(nchar(Exfun)>0){ - Tmp<-eval(parse(text=Exfun)) - if(abs(Tmp)<Eps){ - P<- Appendrow(P,c(Inf,inf)) - next - } - } - Pa<- c() - if(x-E[Ke]< -Eps){ ## 10.12.04 - Tmp<-eval(parse(text=Str)) - Pa<- c(x,Tmp) - } - if(abs(x-E[Ke])<=Eps){ - if(Nrow(P)>0 && P[Nrow(P),]!=c(Inf,Inf)){ - Pa<- c(Inf,Inf) - } - } - if(x-E[Ke]>Eps){ - Tmp<- eval(parse(text=Str)) - Pa<- c(x,Tmp) - Ke<-Ke+1 - } - if(length(Pa)>0){ - if(Pa[1]==Inf){ - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else{ - if(Nrow(P)==0){ - Tmp<- Appendrow(P,Pa) - P<-Tmp - } - else{ - Tmp<- P[Nrow(P),] - if(Tmp[1]==Inf){ - Tmp<- Appendrow(P,Pa) - P<- Tmp - } - else{ - if(Norm(Tmp-Pa)<D){ - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else{ - Tmp<- Appendrow(P,c(Inf,Inf),Pa) - P<- Tmp - } - } - } - } - } - } - Tmp<- Nrow(P) - Tmp1<-P[Tmp,] - if(Tmp1[1]==Inf) - { - P<- P[1:(Tmp-1),] - } - return(P) -} - -###################################### - -Pointoncurve<-function(...) -{ - varargin<-list(...) - Eps<-10^(-4) - T<-varargin[[1]] - Gdata<-varargin[[2]] - if(Nrow(T)>1) - { - Tmp<-T; T<-Gdata; Gdata<-Tmp - } - PtL<-Gdata - N<-trunc(T+Eps); - S<-max(T-N,0); - if(N==Nrow(PtL)) - { - Out<-PtL[N,] - } - else - { - Pa<-PtL[N,] - Pb<-PtL[N+1,] - Out<-(1-S)*Pa+S*Pb - } - return(Out) -} - -############################################## -# 10.11.20 -# 13.05.03 Inf - -Pointdata<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - PL<- list() - for (I in Looprange(1,Nargs)){ # 10.11.20 - DL<-varargin[[I]] - DL<- Flattenlist(DL) # 10.11.20 from here - for (J in Looprange(1,length(DL))){ - Dt<- DL[[J]] - if(is.matrix(Dt)|| is.data.frame(Dt)){ - for (K in 1:nrow(Dt)){ - Tmp<- as.numeric(Dt[K,]) - if(Tmp[1]<Inf){ - PL<- c(PL,list(Tmp)) - } - } - } - else{ - PL<- c(PL,list(Dt)) - } - } - } # to here - if(length(PL)==1) - { - PL<-PL[[1]] - } - return(PL) -} - -############################################## - -Prime<- function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out="'" - } - else{ - Out<- paste(varargin[[1]],"'",sep="") - } - return(Out) -} - -############################################ -# 17.09.29 - -Ptcrv<-function(N,Fig) -{ - if(is.matrix(Fig)){ - return(Fig[N,]) - } - else{ - return(Fig) - } -} - -######################################### - -Ptend<-function(Fig) -{ - if(Length(Fig)>0){ #18.02.09 - return(Op(Length(Fig),Fig)) - }else{ - return(c()) - } -} - -######################################### - -Ptne<-function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out<- c(XMAX,YMAX) - } - else{ - G<- varargin[[1]] - XM<- max(G[,1]) - YM<- max(G[,2]) - Out<- c(XM,YM) - } - return(Out) -} - -######################################### - -Ptnw<-function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out<- c(XMIN,YMAX) - } - else{ - G<- varargin[[1]] - Xm<- min(G[,1]) - YM<- max(G[,2]) - Out<- c(Xm,YM) - } - return(Out) -} - -######################################### - -Ptse<-function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out<- c(XMAX,YMIN) - } - else{ - G<- varargin[[1]] - XM<- max(G[,1]) - Ym<- min(G[,2]) - Out<- c(XM,Ym) - } - return(Out) -} - -############################################# - -Ptstart<-function(Fig) -{ - if(Length(Fig)>0){ #18.02.09 - return(Op(1,Fig)) - }else{ - return(c()) - } -} - -######################################### - -Ptsw<-function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out<- c(XMIN,YMAX) - } - else{ - G<- varargin[[1]] - Xm<- min(G[,1]) - Ym<- min(G[,2]) - Out<- c(Xm,Ym) - } - return(Out) -} - -############################################## - -Putcell<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - Str<- varargin[[Nargs]] - if(mode(Str)=="numeric"){ - Str<- as.character(Str) - } - Pos<- varargin[[Nargs-1]] - Nrg<- varargin[[2]] - if(mode(Nrg)=="character"){ - if(Nargs==4){ - Cell<- Findcell(TbL,Nrg) - } - else{ - Mrg<- varargin[[3]] - Cell<- Findcell(TbL,Nrg,Mrg) - } - } - else{ - Mrg<- varargin[[3]] - Cell<- Findcell(TbL,Nrg,Mrg) - } - Pt<- Cell[[1]]; Dr<- "c" - Posh<- substr(Pos,1,1) - Post<- substr(Pos,2,nchar(Pos)) - if(toupper(Posh)=="R"){ - Pt<- Pt+c(Cell[[2]],0) - if(nchar(Post)==0){ - Dr<- "w1" - } - else{ - Dr<- paste("w",Post,sep="") - } - } - if(toupper(Posh)=="L"){ - Pt=Pt-c(Cell[[2]],0) - if(nchar(Post)==0){ - Dr<- "e1" - } - else{ - Dr<- paste("e",Post,sep="") - } - } - if(toupper(Posh)=="U"){ - Pt<- Pt+c(0,Cell[[3]]) - if(nchar(Post)==0){ - Dr<- "s1" - } - else{ - Dr<- paste("s",Post,sep="") - } - } - if(toupper(Posh)=="D"){ - Pt<- Pt-c(0,Cell[[3]]) - if(nchar(Post)==0){ - Dr<- "n1" - } - else{ - Dr<- paste("n",Post,sep="") - } - } - if(toupper(Posh)=="B"){ - Pt<- Pt-c(0,Cell[[3]]) - if(nchar(Post)==0){ - Dr<- "n1" - } - else{ - Dr<- paste("n",Post,sep="") - } - Str<- paste("$\\mathstrut$",Str,sep="") - } - Letter(Pt,Dr,Str) -} - -############################################# - -PutcoL<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if(mode(TbL)!="list"){ - return("Tabledata missing") - } - Ag<- varargin[[2]] - if(mode(Ag)=="numeric"){ - CoL<- Ag - } - else{ - Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" - Clm<- c() - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,I,I) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - CoL<- Nrg - } - Nc<- length(TbL[[3]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if(I-3>Nc){ - break - } - Dt<- varargin[[I]] - if(mode(Dt)!="list"){ - Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- Dt[[N]] - Rrng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if(mode(Tmp)=="numeric"){ - Rrng<- c(K,K+Tmp) - } - if(mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,CoL,Rrng,Pos,Str) - K<- Crng[2] - } - } -} - -Putcol<- function(...) -{ - PutcoL(...) -} - -PutcoLexpr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if(mode(TbL)!="list"){ - return("Tabledata missing") - } - Ag<- varargin[[2]] - if(mode(Ag)=="numeric"){ - CoL<- Ag - } - else{ - Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" - Clm<- c() - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,I,I) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - CoL<- Nrg - } - Nc<- length(TbL[[3]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if(I-3>Nc){ - break - } - Dt<- varargin[[I]] - if(mode(Dt)!="list"){ - Dt<- paste("$",Dt,"$",sep="") - Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- paste("$",Dt[[N]],"$",sep="") - Rrng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if(mode(Tmp)=="numeric"){ - Rrng<- c(K,K+Tmp) - } - if(mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,CoL,Rrng,Pos,Str) - K<- Crng[2] - } - } -} - -Putcolexpr<- function(...) -{ - PutcoLexpr(...) -} - -##################################################### - -PutcoLstr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Tb<- varargin[[1]] - Nr<- varargin[[2]] - Pos<- varargin[[3]] - Str<- varargin[[4]] - Sep<- "" - if(Nargs>4){ - Sep<- varargin[[5]] - } - if(nchar(Sep)==0){ - for (I in Looprange(1,nchar(Str))){ - Tmp<- substr(Str,I,I) - Putcell(Tb,Nr,I,Pos,Tmp) - } - } - else{ - Ltr<- "" - K<- 1 - for (I in Looprange(1,length(Str))){ - Tmp<- substr(Str,I,I) - if(Tmp==Sep){ - Putcell(Tb,Nr,K,Pos,Ltr) - K<- K+1 - Ltr<- "" - } - else{ - Ltr<- paste(Ltr,Tmp,sep="") - } - } - if(nchar(Ltr)>0){ - Putcell(Tb,Nr,K,Pos,Ltr) - } - } -} - -############################################# - -Putrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if(mode(TbL)!="list"){ - return("Tabledata missing") - } - Row<- varargin[[2]] - Nr<- length(TbL[[2]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if(I-3>Nr){ - break; - } - Dt<- varargin[[I]] - if(mode(Dt)!="list"){ - Putcell(TbL,K,Row,Dpos,Dt) # 110308 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- Dt[[N]] - Crng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if(mode(Tmp)=="numeric"){ - Crng<- c(K,K+Tmp) - } - if(mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,Crng,Row,Pos,Str) - K<- Crng[2] - } - } -} - -Putrowexpr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if(mode(TbL)!="list"){ - return("Tabledata missing") - } - Row<- varargin[[2]] - Nr<- length(TbL[[2]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if(I-3>Nr){ - break; - } - Dt<- varargin[[I]] - if(mode(Dt)!="list"){ - Dt<- paste("$",Dt,"$",sep="") - Putcell(TbL,K,Row,Dpos,Dt) #110308 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- paste("$",Dt[[N]],"$",sep="") - Crng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if(mode(Tmp)=="numeric"){ - Crng<- c(K,K+Tmp) - } - if(mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,Crng,Row,Pos,Str) - K<- Crng[2] - } - } -} - -#################################################### - -Putrowstr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Tb<- varargin[[1]] - Nr<- varargin[[2]] - Pos<- varargin[[3]] - Str<- varargin[[4]] - Sep<- "" - if(Nargs>4){ - Sep<- varargin[[5]] - } - if(nchar(Sep)==0){ - for (I in Looprange(1,nchar(Str))){ - Tmp<- substr(Str,I,I) - Putcell(Tb,I,Nr,Pos,Tmp) - } - } - else{ - Ltr<- "" - K<- 1 - for (I in Looprange(1,length(Str))){ - Tmp<- substr(Str,I,I) - if(Tmp==Sep){ - Putcell(Tb,K,Nr,Pos,Ltr) - K<- K+1 - Ltr<- "" - } - else{ - Ltr<- paste(Ltr,Tmp,sep="") - } - } - if(nchar(Ltr)>0){ - Putcell(Tb,K,Nr,Pos,Ltr) - } - } -} - -############################################ -# 11.05.28 - -Ratiocmyk<- function(Color) -{ - if(is.numeric(Color)){ - return(Color) - } - R<- - switch(Color, - greenyellow=c(0.15,0,0.69,0), - yellow=c(0,0,1,0), - goldenrod=c(0,0.1,0.84,0), - dandelion=c(0,0.29,0.84,0), - apricot=c(0,0.32,0.52,0), - peach=c(0,0.5,0.7,0), - melon=c(0,0.46,0.5,0), - yelloworange=c(0,0.42,1,0), - orange=c(0,0.61,0.87,0), - burntorange=c(0,0.51,1,0), - bittersweet=c(0,0.75,1,0.24), - redorange=c(0,0.77,0.87,0), - mahogany=c(0,0.85,0.87,0.35), - maroon=c(0,0.87,0.68,0.32), - brickred=c(0,0.89,0.94,0.28), - red=c(0,1,1,0), - orangered=c(0,1,0.5,0), - rubinered=c(0,1,0.13,0), - wildstrawberry=c(0,0.96,0.39,0), - salmon=c(0,0.53,0.38,0), - carnationpink=c(0,0.63,0,0), - magenta=c(0,1,0,0), - violetred=c(0,0.81,0,0), - rhodamine=c(0,0.82,0,0), - mulberry=c(0.34,0.9,0,0.02), - redviolet=c(0.07,0.9,0,0.34), - fuchsia=c(0.47,0.91,0,0.08), - lavender=c(0,0.48,0,0), - thistle=c(0.12,0.59,0,0), - orchid=c(0.32,0.64,0,0), - darkorchid=c(0.4,0.8,0.2,0), - purple=c(0.45,0.86,0,0), - plum=c(0.5,1,0,0), - violet=c(0.79,0.88,0,0), - royalpurple=c(0.75,0.9,0,0), - blueviolet=c(0.86,0.91,0,0.04), - periwinkle=c(0.57,0.55,0,0), - cadetblue=c(0.62,0.57,0.23,0), - cornflowerblue=c(0.65,0.13,0,0), - midnightblue=c(0.98,0.13,0,0.43), - navyblue=c(0.94,0.54,0,0), - royalblue=c(1,0.5,0,0), - blue=c(1,1,0,0), - cerulean=c(0.94,0.11,0,0), - cyan=c(1,0,0,0), - processblue=c(0.96,0,0,0), - skyblue=c(0.62,0,0.12,0), - turquoise=c(0.85,0,0.2,0), - tealblue=c(0.86,0,0.34,0.02), - aquamarine=c(0.82,0,0.3,0), - bluegreen=c(0.85,0,0.33,0), - emerald=c(1,0,0.5,0), - junglegreen=c(0.99,0,0.52,0), - seagreen=c(0.69,0,0.5,0), - green=c(1,0,1,0), - forestgreen=c(0.91,0,0.88,0.12), - pinegreen=c(0.92,0,0.59,0.25), - limegreen=c(0.5,0,1,0), - yellowgreen=c(0.44,0,0.74,0), - springgreen=c(0.26,0,0.76,0), - olivegreen=c(0.64,0,0.95,0.4), - rawsienna=c(0,0.72,1,0.45), - sepia=c(0,0.83,1,0.7), - brown=c(0,0.81,1,0.6), - tan=c(0.14,0.42,0.56,0), - gray=c(0,0,0,0.5), - black=c(0,0,0,1), - white=c(0,0,0,0) - ) - if(length(R)<4){ - print("No color") - return(c()) - } - return(R) -} - -############################################ -# 11.01.07 - -Readtextdata<- function(...) -{ - varargin<- list(...) - OutL<- list() - Nargs<- length(varargin) - Fname<- varargin[[1]] - Tmp<- readLines(Fname,n=1) - if(length(grep("\t",Tmp))>0){ - Sep<- "\t" - } - else if(length(grep(",",Tmp))>0){ - Sep<- "," - } - else{ - Sep<- " " - } - Hajime<- c(1,1) - Owari<- c(Inf,Inf) - C<- Inf - R<- Inf - Rna<- FALSE - Cna<- TRUE - Mat<- FALSE - Num<- TRUE - D<- -Inf - Flg<- 0 - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - if (Flg==0){ - Hajime<- Tmp - Flg<- 1 - } - else{ - Owari<- Tmp - } - } - else{ - eval(parse(text=Tmp)) - } - } - Tmp<- Hajime+c(R-1,C-1) - Owari<- c(min(Owari[1],Tmp[1]),min(Owari[2],Tmp[2])) - if(Cna){ - Df<- read.table(Fname,sep=Sep,header=TRUE,,stringsAsFactors=FALSE) - } - else{ - Df<- read.table(Fname,sep=Sep,header=FALSE,,stringsAsFactors=FALSE) - Nv<- c(1:ncol(Df)) - colnames(Df)<- Nv - } - if(Rna){ - rownames(Df)<-Df[,1] - Hajime<- Hajime+c(0,1) - } - if(Mat){ - M<- as.matrix(Df) - Tmp1<- min(Owari[1],nrow(M)) - Tmp2<- min(Owari[2],ncol(M)) - Out<- as.matrix(M[Hajime[1]:Tmp1,Hajime[2]:Tmp2]) - if(Num){ - Tmp1<- as.numeric(Out) - Out<- matrix(Tmp1,nrow=nrow(Out)) - } - } - else{ - Tmp1<- min(Owari[1],nrow(Df)) - Tmp2<- min(Owari[2],ncol(Df)) - Out<- Df[Hajime[1]:Tmp1,Hajime[2]:Tmp2] - } - if(D!=-Inf){ # 11.01.20 v2 - Tmp<- ncol(Out) # 11.01.07 - Tmp1<- rep(Inf,Tmp) - Out[Out[,1]<=D,]<- Tmp1 # 11.01.07 - } - return(Out) -} - -################################## - -Reflectdata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if(Mixtype(ML)==1){ - ML<- list(ML) - } - if(Nargs==1){ - PtA<- c(0,0); PtB<- PtA - } - else{ - Pts<- varargin[[2]] - if(length(Pts)==2){ - PtA<- Pts; PtB<- PtA - } - else{ - PtA<- Pts[1:2]; PtB<- Pts[3:4] - } - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if(X1==Inf){ - X2<- X1 - Y2<- Y1 - } - else{ - if(Norm(PtA-PtB)<Eps){ - X2<- 2*PtA[1]-X1 - Y2<- 2*PtA[2]-Y1 - } - else{ - U<- PtB[1]-PtA[1] - V<- PtB[2]-PtA[2] - A<- PtA[1] - B<- PtA[2] - X2<- (U^2-V^2)/(U^2+V^2)*X1+2*U*V/(U^2+V^2)*Y1 - X2<- X2-2*V*(U*B-V*A)/(U^2+V^2) - Y2<- 2*U*V/(U^2+V^2)*X1-(U^2-V^2)/(U^2+V^2)*Y1 - Y2<- Y2+2*U*(U*B-V*A)/(U^2+V^2) - } - } - Out<- Appendrow(Out,c(X2,Y2)) - } - OutL<- Mixjoin(OutL,list(Out)) - } - if(length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -########################################## - -Writetextdata<- function(...) -{ - varargin<- list(...) - OutL<- list() - Nargs<- length(varargin) - Data<- varargin[[1]] - Fname<- varargin[[2]] - Sep="," - for (I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - eval(parse(text=Tmp)) - } - write.table(Data,Fname,sep=Sep,row.names=FALSE,na="") -} - -########################################## -# 2014.12.17 -# 2015.10.29 - -WriteOutData<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) -# if modulo(Nargs,2)==0 then -# Fname=Fnameout; -# Nst=1; -# else - Fname=varargin[[1]] - Nst=2; -# end; - for(N in seq(Nst,Nargs,by=2)){ - Gname=varargin[[N]] - Tmp=paste(Gname,"//",sep="") - if(N==Nst){ - cat(Tmp,"\n",sep="",file=Fname) - } - else{ - cat(Tmp,"\n",sep="",file=Fname,append=TRUE) - } - Gdata=varargin[[N+1]] - Gdata=Flattenlist(Gdata) - if(!is.list(Gdata)){Gdata=list(Gdata)} - for(K in Looprange(1,length(Gdata))){ - GL=Dividegraphics(Gdata[[K]]) -# for(J in seq(1,length(GL))){ - for(J in Looprange(1,length(GL))){ - cat("start//","\n",sep="",file=Fname,append=TRUE) - Str="" - Iend=Numptcrv(GL[[J]]) -# for(II in seq(1,Iend)){ - for(II in Looprange(1,Iend)){ - Pt=Ptcrv(II,GL[[J]]) - if(nchar(Str)>0){ - Str=paste(Str,",",sep="") - } - if(length(Pt)<3){ - Str=paste(Str,sprintf("[%5.5f,%5.5f]",Pt[1],Pt[2]),sep="") - } - else{ - Str=paste(Str,sprintf("[%5.5f,%5.5f,%5.5f]",Pt[1],Pt[2],Pt[3]),sep="") - } - if(nchar(Str)>80){ - cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) - Str="" - } - } - if(nchar(Str)>0){ - cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) - } - if((N==Nargs-1) & (K==length(Gdata)) & (J==length(GL))){ -# cat("end////","\n",sep="",file=Fname,append=TRUE) - cat("end//","\n",sep="",file=Fname,append=TRUE) - } - else{ - cat("end//","\n",sep="",file=Fname,append=TRUE) - } - } - } - } - cat("//","\n",sep="",file=Fname,append=TRUE) # 15.11.05 -} - -###### Old #################################### -# 2015.10.23 -ReadOutData<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Fname=varargin[[1]] - cmdall=readLines(Fname) - cmdall=gsub("//","",cmdall,fixed=TRUE) - varname=cmdall[1] - outdt=list() - varL=c() - ptL=list() - flg=0 - for(cmd in cmdall){ - if(nchar(cmd)>0){ - if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ - if(cmd=="start"){ - pts=c() - } - if(cmd=="end"){ - ptL=c(ptL,list(pts)) - } - if(substring(cmd,1,1)=="["){ - tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") - tmp1=strsplit(tmp1,"]",fixed=TRUE) - tmp1=tmp1[[1]] - tmp1=gsub(",[","c(",tmp1,fixed=TRUE) - for(st in tmp1){ - tmp=eval(parse(text=paste(st,")",sep=""))) - pts=rbind(pts,tmp) - } - row.names(pts)=1:nrow(pts) - } - } - else{ - varname=cmd - varL=c(varL,varname) - if(flg==0){ # 17.10.07from - flg=1 - }else{ - outdt=c(outdt,list(ptL)) - } # 17.10.07upto - ptL=c() - } - } - } - outdt=c(outdt,list(ptL)) # 17.10.07 - names(outdt)=varL - for(var in varL){ - tmp=paste(var,"<<- outdt$",var,sep="") - eval(parse(text=tmp)) - } -# print(varL) - outdt -} - -#################################################### - -ReadOutData<- function(...){ #2017.10.23 - varargin<- list(...) - Nargs<- length(varargin) - Fname=varargin[[1]] - cmdall=readLines(Fname) - cmdall=gsub("//","",cmdall,fixed=TRUE) - varname=""#17.12.13 cmdall[1] - outdt=list() - varL=c() - ptL=list() - flg=0 - for(cmd in cmdall){ - if(nchar(cmd)>0){ - if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ - if(cmd=="start"){ - tmp=paste(varname,"<<- c(",varname,",list(c()))",sep="") - eval(parse(text=tmp)) - Ctr=Ctr+1 - } - if(cmd=="end"){ - } - if(substring(cmd,1,1)=="["){ - tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") - tmp1=strsplit(tmp1,"]",fixed=TRUE) - tmp1=tmp1[[1]] - tmp1=gsub(",[","c(",tmp1,fixed=TRUE) - for(st in tmp1){ - tmp=paste(varname,"[[",as.character(Ctr),"]]",sep="") - tmp=paste(tmp,"<<- rbind(",tmp,",",st,"))",sep="")# - eval(parse(text=tmp)) - } - } - } - else{ - # 17.12.13from - if(nchar(varname)>0){ - tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") - eval(parse(text=tmp)) - } - # 17.12.13upto - varname=cmd - tmp=paste(varname,"<<- list()",sep="") - eval(parse(text=tmp)) - Ctr=0 - if(flg==0){ # 17.10.07from - flg=1 - }else{ - } # 17.10.07upto - } - } - } - # 17.12.13from - tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") - eval(parse(text=tmp)) - # 17.12.13upto -} - -#################################################### - -Rotatedata<- function(..., deg=FALSE) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if(Mixtype(ML)==1){ - ML<- list(ML) - } - Theta<- varargin[[2]] - if(deg) Theta<- Theta*pi/180 # 10.12.07 - if(Nargs==2){ - Pt<- c(0,0) - } - else{ - Pt<- varargin[[3]] - } - Cx<- Pt[1]; Cy<- Pt[2] - OutL<- c() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if(X1==Inf){ - X2<- X1 - Y2<- Y1 - } - else{ - X2<- Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta) - Y2<- Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta) - } - Out<- Appendrow(Out,c(X2,Y2)) - } - if(nrow(Out)==1){ - Out<- Out[1,] - } - OutL<- Mixjoin(OutL,list(Out)) - } - if(length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -############################################### - -Scaledata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if(Mixtype(ML)==1){ - ML<- list(ML) - } - A<- varargin[[2]] - B<- varargin[[3]] - if(Nargs==3){ - Pt<- c(0,0) - } - else{ - Pt<- varargin[[4]] - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if(X1==Inf){ - X2<- X1 - Y2<-Y1 - } - else{ - X2<- Pt[1]+A*(X1-Pt[1]) - Y2<- Pt[2]+B*(Y1-Pt[2]) - } - Out<- Appendrow(Out,c(X2,Y2)) - } - OutL<- Mixjoin(OutL,list(Out)) - } - if(length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -################################ - -Setarrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - Str<- paste("Size=",YaSize,",","Angle=",YaAngle,",",sep="") - Str<- paste(Str,"Position=",YaThick,",","Style=",YaStyle,sep="") - return(Str) - } - Flg<- 0 - for (I in 1:Nargs){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - Flg<- Flg+1 - if(Flg==1) YaSize<<-Tmp - if(Flg==2){ - if(Tmp<5){ - YaAngle<<- 18*Tmp - } - else{ - YaAngle<<- Tmp - } - } - if(Flg==3) YaPosition<<- Tmp - if(Flg==4) YaThick<<- Tmp - } - if(mode(Tmp)=="character"){ - YaStyle<<- Tmp - } - } -} - -#################################### - -Setax<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - if(ZIKU=="line"){ - Tmp<- "," - } - else{ - Tmp<- paste("(Arrowsize=", as.character(ARROWSIZE),"),",sep="") - } - Str<- paste(ZIKU,Tmp,XNAME,",",XPOS,",",sep="") - Str<- paste(Str,YNAME,",",YPOS,",",ONAME,",",OPOS,sep="") - return(Str) - } - ArgL<- c() - Is<- 1 - Tmp<- varargin[[1]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - Is<- varargin[[1]] - ArgL<- c() - for (I in Looprange(1,Is-1)){ - ArgL<- c(ArgL,"") - } - for (I in Looprange(2,Nargs)){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - else{ - if(Nargs==1){ - ArgL<- c(varargin[[1]]) - } - else{ - Tmp<- varargin[[2]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - ARROWSIZE<<-Tmp - ArgL<- c(varargin[[1]]) - for (I in Looprange(3,Nargs)){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - else{ - ArgL<- c() - for (I in 1:Nargs){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - } - } - for (I in Looprange(length(ArgL)+1,7)){ - ArgL<- c(ArgL,"") - } - Zk<- ArgL[1] - if(nchar(Zk)>0){ - ZL<-substr(Zk,2,nchar(Zk)) - Zk<-substr(Zk,1,1) - if(nchar(ZL)>0){ - ARROWSIZE<<- as.numeric(ZL) - } - } - Xn<- ArgL[2]; Xp<- ArgL[3] - Yn<- ArgL[4]; Yp<- ArgL[5] - Genn<- ArgL[6]; Genp<- ArgL[7] - if(nchar(Zk)>0){ - C<- Zk - if(C=="a"){ - ZIKU<<- "arrow" - } - else{ - ZIKU<<- "line" - } - } - if(nchar(Xn)>0){ - XNAME<<- paste("$",Xn,"$",sep="") - } - if(nchar(Xp)>0){ - XPOS<<- Xp - } - if(nchar(Yn)>0){ - YNAME<<- paste("$",Yn,"$",sep="") - } - if(nchar(Yp)>0){ - YPOS<<-Yp - } - if(nchar(Genn)>0){ - ONAME<<- Genn - } - if(nchar(Genp)>0){ - OPOS<<- Genp - } - Out<- ""; -} - -################################# -# 11.08.24 - -Setcolor<- function(...){ - varargin<- list(...) - Color<- 'black' - Kosa<- 1 - for(J in Looprange(1,length(varargin))){ - Tmp<- varargin[[J]] - if(is.character(Tmp)) Color<- Tmp - if(is.numeric(Tmp)){ - if(length(Tmp)==1){# 11.08.24 - Kosa<- Tmp - } - else{ - Color<- Tmp - } - }# 11.08.24 - } - Iro<- Ratiocmyk(Color) - if(length(Iro)==0) return(c()) - Str<- "\\color[cmyk]{" #17.09.22 - for(J in 1:4){ - Str<- paste(Str,as.character(Kosa*Iro[J]),sep="") - if(J<4){ - Str<- paste(Str,",",sep="") - } - } - Str<- paste(Str,"}",sep="") - Texcom(Str) -} - -################################## - -Setmarklen<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - Tmp<- MARKLENNow/MARKLENInit - Tmp=round(Tmp*100)/100 - return(Tmp) - } - Size<- varargin[[1]] - MARKLENNow<<- MARKLENInit*Size - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn -} - -############################### - -Setorigin<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - return(GENTEN) - } - Pt<- varargin[[1]] - GENTEN<<- Pt; -} - -################################ - -Setscaling<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0) - { - return(c(SCALEY,LOGX,LOGY)) - } - for (I in 1:Nargs) - { - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric") - { - SCALEY<<- Tmp - } - if(mode(Tmp)=="character") - { - if(Tmp=="l") - { - LOGX<<- 0 - LOGY<<- 1 - } - else if(Tmp=="ll") - { - LOGX<<- 1 - LOGY<<- 1 - } - else - { - LOGX<<- 0 - LOGY<<- 0 - } - } - } - Tmp<- c(SCALEY,LOGX,LOGY); -} - -######################################### - -Setpen<-function(Width) -{ - PenThick<<-round(PenThickInit*Width) - Str=paste("\\special{pn ", as.character(PenThick),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) -} - -############################################## - -Setpt<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0) - { - Tmp<- TenSize/TenSizeInit - Tmp<- round(Tmp*100)/100 - return(Tmp) - } - Size<- varargin[[1]] - TenSize<<- TenSizeInit*Size; -} - -############################################## - -Setunitlen<-function(...) -{ - varargin<-list(...) - if(length(varargin)==0){ - return(ULEN) - } - Ul=varargin[[1]] - Dx<-XMAX-XMIN - Dy<-YMAX-YMIN - Sym<-".0123456789 +-*/" - SL<-Sym - OL<-"+-*/" - if(nchar(Ul)>0){ - ULEN<<-Ul - } - Is<-1 - VL<-"" - Ucode<-ULEN - for (I in 1:nchar(Ucode)){ - C<-substring(Ucode,I,I) - if(length(grep(C,SL))>0){ - if(length(grep(C,OL))>0){ - Tmp<-substring(Ucode,Is,I-1) - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1 - } - } - else{ - Unit<-substring(Ucode,I,I+1) - Str<-substring(Ucode,Is,I-1) - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)) - Str<-as.character(Valu) - ULEN<<-paste(Str,Unit,sep=""); - if(Unit=="cm") MilliIn<<-1000/2.54*Valu - if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if(Unit=="in") MilliIn<<-1000*Valu - if(Unit=="pt") MilliIn<<-1000/72.27*Valu - if(Unit=="pc") MilliIn<<-1000/6.022*Valu - if(Unit=="bp") MilliIn<<-1000/72*Valu - if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu - if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<-MARKLENNow*1000/2.54/MilliIn - MEMORI<<-MEMORINow*1000/2.54/MilliIn #17.12.17 -} - -######################################### -# 10.11.20 - -Setwindow<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - if(Nargs==0){ - Out<-c(XMIN,XMAX,YMIN,YMAX) - return(Out) - } - if(Nargs==1){ - Dt<- varargin[[1]] - if(is.list(Dt) && !is.data.frame(Dt)){ - Tmp<- as.data.frame(Dt) - Dt<- t(Tmp) - } - Xm<- min(Dt[,1]) - XM<- max(Dt[,1]) - Ym<- min(Dt[,2]) - YM<- max(Dt[,2]) - Str<- "Setwindow(" - Str<- paste(Str,"c(",as.character(Xm),",",as.character(XM),"),c(",sep="") - Str<- paste(Str,as.character(Ym),",",as.character(YM),")",sep="") - Str<- paste(Str,")",sep="") - print(Str) - } - if(Nargs==2){ - RgX<-varargin[[1]] - RgY<-varargin[[2]] - XMIN<<-RgX[1]; XMAX<<-RgX[2] - YMIN<<-RgY[1]; YMAX<<-RgY[2] - } - if(Nargs==4){ - XMIN<<-varargin[[1]]; XMAX<<-varargin[[2]] - YMIN<<-varargin[[3]]; YMAX<<-varargin[[4]] - } - Out<- c(XMIN,XMAX,YMIN,YMAX); -} - -######################################### - -Shade<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg=0 - Kosa=1 - if(Nargs>1){ - Iro=varargin[[Nargs]] - if(is.character(Iro)){ - Iroflg=1 - if(length(grep("{",Iro))>0){ - Str=paste("{\\color",Iro,sep="") - } - else{ - Str=paste("{\\color{",Iro,"}",sep="") - } - } - else{ - if(length(Iro)==1){ - Kosa=Iro - } - else{ - Iroflg=1 - if(length(Iro)==4){ - Str="{\\color[cmyk]{" - } - else{ - if(length(Iro)==3){ - Str="{\\color[rgb]{" - } - } - for(J in 1:length(Iro)){ - Str=paste(Str,as.character(Iro[J]),sep="") - if(J<length(Iro)){ - Str=paste(Str,",") - } - } - Str=paste(Str,"}") - } - } - if(Iroflg==1){ - Str=paste(Str,"%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - } - } - Tmp=varargin[[1]] - Data=Kyoukai(Tmp) - for (I in Looprange(1, length(Data))){ - PL<- Op(I,Data) - Mojisu<- 0 - for (J in 1:Nrow(PL)){ - P<- Doscaling(Op(J,PL)) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if(Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- paste("\\special{ip}%\n",sep="") - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - } - if(Iroflg==1){ - cat("}%\n",file=Wfile,append=TRUE) - } -} - -####### Shade new 17.09.24############ - -Shade<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg<- 0 - Kosa<- 1 - if(Nargs>1){ - Iro<- varargin[[Nargs]] - if(mode(Iro)=="character"){ - Iroflg<- 1 - if(length(grep(Iro,"{"))>0) - Str<- paste("{\\color",Iro,sep="") - else - Str<- paste("{\\color{",Iro,"}",sep="") - } - else{ - if(length(Iro)==1) - Kosa<- Iro - else{ - Iroflg<- 1 - if(length(Iro)==4) - Str<- paste("{\\color[cmyk]{",sep="") - else - if(length(Iro)==3) - Str<- paste("{\\color[rgb]{",sep="") - for (J in Looprange(1,length(Iro))){ - Str<- paste(Str,as.character(Iro[J]),sep="") - if(J<length(Iro)) - Str<- paste(Str,",",sep="") - } - Str<- paste(Str,"}",sep="") - } - } - if(Iroflg==1){ - if(Wfile=="default") - cat(Str,"%\n",file="",append=TRUE,sep="") - else - cat(Str,"%\n",file=Wfile,append=TRUE,sep="") - } - } - Tmp<- varargin[[1]] - Data<- Kyoukai(Tmp) - for (I in Looprange(1, length(Data))){ - PL<- Op(I,Data) - Mojisu<- 0 - for (J in 1:Nrow(PL)){ - P<- Doscaling(Op(J,PL)) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - if(Wfile=="default") - cat(Str,file="",append=TRUE,sep="") - else - cat(Str,file=Wfile,append=TRUE,sep="") - Mojisu<- Mojisu+nchar(Str) - if(Mojisu>80){ - if(Wfile=="default") - cat("%\n",file="",append=TRUE,sep="") - else - cat("%\n",file=Wfile,append=TRUE,sep="") - Mojisu<- 0 - } - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- paste("\\special{ip}%\n",sep="") - if(Wfile=="default"){ - cat(Str1,file="",append=TRUE,sep="") - cat(Str2,file="",append=TRUE,sep="") - } - else{ - cat(Str1,file=Wfile,append=TRUE,sep="") - cat(Str2,file=Wfile,append=TRUE,sep="") - } - } - if(Iroflg==1){ - if(Wfile=="default") - cat("}%\n",file="",append=TRUE,sep="") - else - cat("}%\n",file=Wfile,append=TRUE,sep="") - } -} - -############################################## -# 11.01.07 - -Splinedata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-3) - PL<- varargin[[1]] - if(mode(PL)=="character"){ - Fname<- PL - PL<- Readtextdata(Fname) - } - else{ - PL<- as.matrix(PL) - if(Nrow(PL)==1){ - PL<- matrix(PL, nrow=length(PL)/2) - PL<- t(PL) - } - } - if(ncol(PL)==3){ - Flg3<- 1 - } - else{ - Flg3<- 0 - } - PLL<- Dividegraphics(PL) - N<- 50 - C<- c() - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)!="character") next - if(length(grep("=",Tmp,fixed=TRUE))>0){ - eval(parse(text=Tmp)) - } - else{ - Tmp1<- substr(Tmp,1,1) - if(toupper(Tmp1)=="C"){ - C<- 1:length(PLL) - } - } - } - Cflg<- rep(0,length(PLL)) - for(J in Looprange(1,length(C))){ - K<- C[J] - Cflg[K]<- 1 - } - if(length(N)>1){ - Nj<- as.numeric(N) - } - else{ - Tmp<- lapply(PLL,nrow) - Tmp1<- as.numeric(Tmp) - MxP<- max(Tmp1) - Nj<- c() - for (J in 1:length(PLL)){ - Tmp<- nrow(PLL[[J]]) - Tmp1<- round(N/MxP*(Tmp-1)) - Nj<- c(Nj,Tmp1) - } - } - OutL<- list() - for(J in 1:length(PLL)){ - PL<- PLL[[J]] - if(Cflg[J]==1){ - if(Norm(PL[1,]-PL[Nrow(PL),])>Eps){ - PL<-Appendrow(PL,PL[1,]) - Nj[J]=round(N/MxP*nrow(PL)) - } - else{ - PL[Nrow(PL),]<- PL[1,] - } - } - Tn<- 1:Nrow(PL) - Xn<- PL[,1] - Yn<- PL[,2] - if(Flg3==1) Zn<- PL[,3] - if(Cflg[J]==0){ - Dxn<- spline(Tn,Xn,n=Nj[J]) - Dyn<- spline(Tn,Yn,n=Nj[J]) - if(Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J]) - } - else{ - Dxn<- spline(Tn,Xn,method="periodic") - Dyn<- spline(Tn,Yn,method="periodic") - if(Flg3==1) Dzn<- spline(Tn,Zn,method="periodic") - } - Tmp1<- Dxn$y - Tmp2<- Dyn$y - Tmp3<-c() - if(Flg3==1) Tmp3<- Dzn$y - Out<- matrix(c(Tmp1,Tmp2,Tmp3),nrow=length(Tmp1)) - OutL<- c(OutL,list(Out)) - } - return(OutL) -} - -############################################ -# 2013.05.03 Domain is optional - -Tabledata<- function(...){ - varargin<- list(...) - Eps<- 0.001 - Tmp<- varargin[[1]] # 130503 from - if(is.numeric(Tmp)){ - Domain<- varargin[[1]] - VL<- varargin[[2]] - HL<- varargin[[3]] - } - else{ - Domain<- c(-1,-1) - VL<- varargin[[1]] - HL<- varargin[[2]] - } # 130503 upto - Hsize<- Domain[1] - SvL<- list(0) - S<- 0 - for (I in Looprange(1,length(VL))){ - Tmp<- VL[[I]] - S<- S+Tmp[1] - Tmp[1]<- S - SvL<- c(SvL,list(Tmp)) - } - if(Hsize>S){ - SvL<- c(SvL,list(Hsize)) - } - Hsize<- Op(1,SvL[[length(SvL)]]) - Vsize<- Domain[2] - ShL<- list(0) - S<- 0 - for (I in Looprange(1,length(HL))){ - Tmp<- HL[[I]] - S<- S+Tmp[1] - Tmp[1]<- S - ShL<- c(ShL,list(Tmp)) - } - if(Vsize>S){ - ShL<- c(ShL,list(Vsize)) - } - Vsize<- Op(1,ShL[[length(ShL)]]) - Marw<- 0; Mare<- 0; Mars<- 0; Marn<- 0 - if(length(Domain)>2){ - Marw<- Domain[3] - Mare<- Domain[4] - } - if(length(Domain)>4){ - Marn<- Domain[5] - Mars<- Domain[6] - } - Setwindow(c(-Marw,Hsize+Mare),c(-Mars,Vsize+Marn)) - Tmp<- Framedata(c(Eps,Hsize-Eps),c(Eps,Vsize-Eps)) - Gdata<- list(Tmp) - Tmp<- -Marw - Hdata<- list(Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn)))) - for (I in Looprange(1,length(SvL))){ - Data<- SvL[[I]] - X<- Data[1] - if(length(Data)==1){ - Y1<- 0 - Y2<- Vsize - G<- Listplot(c(X,Y1),c(X,Y2)) - } - else{ - G<- c() - for (J in seq(2,length(Data),by=2)){ - Y1<- Vsize-Op(1,ShL[[Data[J]]]) - Y2<- Vsize-Op(1,ShL[[Data[J+1]]]) - Tmp<- Listplot(c(c(X,Y1),c(X,Y2))) - Tmp1<- Appendrow(G,c(Inf,Inf)) - G<- Appendrow(Tmp1,Tmp) - } - G<- G[2:nrow(G),] - } - Hdata<- c(Hdata,list(G)) - } - Tmp<- Hsize+Mare - Tmp1<- Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn))) - Hdata<- c(Hdata,list(Tmp1)) - Tmp<- Vsize+Marn - Vdata<- list(Listplot(c(c(-Marw,Tmp),c(Hsize+Mare,Tmp)))) - for (I in Looprange(1,length(ShL))){ - Data<- ShL[[I]] - Y<- Vsize-Data[1] - if(length(Data)==1){ - X1<- 0 - X2<- Hsize - G<- Listplot(c(X1,Y),c(X2,Y)) - } - else{ - G<- c() - for (J in seq(2,length(Data),by=2)){ - X1<- Op(1,SvL[[Data[J]]]) - X2<- Op(1,SvL[[Data[J+1]]]) - Tmp<- Listplot(c(X1,Y),c(X2,Y)) - G<- Appendrow(G,c(Inf,Inf)) - G<- Appendrow(G,Tmp) - } - G<-G[2:nrow(G),] - } - Vdata<- c(Vdata,list(G)) - } -# Tmp<- Listplot(c(c(0,0),c(Hsize,0))) # 2011.03.02 -# Vdata<- Mixjoin(Vdata,list(Tmp)) - Tmp<- Listplot(c(c(-Marw,-Mars),c(Hsize+Mare,-Mars))) - Vdata<- Mixjoin(Vdata,list(Tmp)) - Tmp1<- Hdata[Looprange(3,length(Hdata)-2)] - Tmp2<- Vdata[Looprange(3,length(Vdata)-2)] - Gdata<- Mixjoin(Gdata,Tmp1,Tmp2) - Hind<- Looprange(2,1+length(Tmp1)) - Vind<- Looprange(2+length(Tmp1),1+length(Tmp1)+length(Tmp2)) - G=Gdata[[1]] - P1<- Ptsw(G); P2<- Ptnw(G) - Q1<- Ptse(G); Q2<- Ptne(G) - Tmp1<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) - P1<- Ptnw(G); P2<- Ptne(G) - Q1<- Ptsw(G); Q2<- Ptse(G) - Tmp2<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) - Tmp3<- Framedata() - Out<- list(Gdata,Hind,Vind,Tmp1,Tmp2,Tmp3) - return(Out) -} - -################################ - -Texcom<- function(Meirei) -{ - if(Meirei=="\\thinlines"){ - Setpen(1); - return(); - } - if(Meirei=="\\thicklines"){ - Setpen(2); - return() - } - if(Meirei=="\\Thicklines"){ - Setpen(3); - return() - } - if(length(Meirei)==0){ # 09.12.07 - Tmp<- c() - } - else{ - Tmp<- grep("newline",Meirei) - } - if(length(Tmp)>0){ - cat("\n",file=Wfile,append=TRUE); - } - else{ - Tmp<- paste(Meirei,"%\n",sep="") - Tmp<- gsub("//","\\",Tmp,fixed=TRUE) # 11.03.02 - cat(Tmp,file=Wfile,append=TRUE); - } -} - -############################################### - -Texctr<- function(N){ - if(is.numeric(N)){ - Alpha<- "abcdefghijklmnopqrstuvwxyz" - Out<- paste("ketpicctr",substr(Alpha,N,N),sep="") - } - else{ - if(grep("\\",N,fixed=TRUE)>0){ - Out<- substr(N,2,nchar(N)) - } - else{ - Out<- N - } - } - return(Out) -} - -############################################### - -Texelse<- function (){ - Texcom(""); - Texcom("\\else") -} - -############################################### - -Texend<- function() -{ - Texcom("%\n}") -} - -############################################### - -Texendfor<- function(I){ - Last<- TEXFORLAST[[TEXFORLEVEL]] - Texcom("") - Tmp<- paste("\\ifnum",Texthectr(I),"<",Last,sep="") - Texcom(Tmp) - Texcom("\\repeat") - Texcom("}") - TEXFORLEVEL<<- TEXFORLEVEL-1 - TEXFORLAST<<- TEXFORLAST[1:(length(TEXFORLAST)-1)] -} - -############################################### - -Texendif<- function(){ - Texcom("") - Texcom("\\fi") - Texcom("}") -} - -############################################### - -Texfor<- function(I,First,Last){ - TEXFORLEVEL<<- TEXFORLEVEL+1; - Texsetctr(I,"0") - Texsetctr(I,paste(as.character(First),"-1",sep="")) - Texcom("") - Texcom("{") - Texcom("\\loop") - Texsetctr(I,"+1") - TEXFORLAST<<- c(TEXFORLAST,as.character(Last)) -} - -############################################### - -Texforinit<- function(){ - TEXFORLEVEL<<- 0 - TEXFORLAST<<- list() -} - -############################################### - -Texif<- function(...){ - varargin<- list(...) - Condstr<- varargin[[1]] - Tp<- 0 - if(length(varargin)>1){ - Tp<- varargin[[2]] - } - Texcom("") - Texcom("{") - if(Tp==0){ - Texcom("\\ifnum") - } - else{ - Texcom("\\ifdim ") - } - Texcom(paste(Condstr," ",sep="")) -} - -###################################### - -Texletter<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - for (I in seq(1,Nargs,by=3)){ - P<- varargin[[I]] - X<- P[1] - if(mode(X)=="numeric"){ - X<- as.character(X) - } - Y<- P[2] - if(mode(Y)=="numeric"){ - Y<- as.character(Y) - } - Houkou<- varargin[[I+1]] - Mojiretu<- varargin[[I+2]] - Hset<- Houkou - Vhoko<- "c" - if(length(grep("n",Hset))>0){ - Vhoko<- "n" - } - if(length(grep("s",Hset))>0){ - Vhoko<- "s" - } - Hhoko<- "c"; - if(length(grep("e",Hset))>0){ - Hhoko<- "e" - } - if(length(grep("w",Hset))>0){ - Hhoko<- "w" - } - Hoko<- paste(Vhoko,Hhoko,sep="") - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - Tmp<- paste("\\put(",X,",",Y,"){\\hspace*{\\Width}",sep="") - Str<- paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - } -} - -################################################## - -Texnewcmd<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Str<- varargin[[1]] - S<- paste("\\newcommand{",Str,"}",sep="") - if(Nargs>1){ - Tmp<- as.character(varargin[[2]]) - S<- paste(S,"[",Tmp,"]",sep="") - } - if(Nargs>2){ - Tmp<- varargin[[3]] - if(mode(Tmp)=="numeric"){ - Tmp<- as.character(Tmp) - } - S<- paste(S,"[",Tmp,"]",sep="") - } - S<- paste(S,"{",sep="") - Texcom(S) -} - -############################################### - -Texnewctr<- function(N) -{ - if(mode(N)=="character"){ - Str<- paste("\\newcounter{",N,"}",sep="") - Texcom(Str) - } - else{ - for (I in N){ - Str<- paste("\\newcounter{",Texctr(I),"}",sep="") - Texcom(Str) - } - } -} -############################################### - -Texrenewcmd<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Str<- varargin[[1]] - S<- paste("\\renewcommand{",Str,"}",sep="") - if(Nargs>1){ - Tmp<- as.character(varargin[[2]]) - S<- paste(S,"[",Tmp,"]",sep="") - } - if(Nargs>2){ - Tmp<- varargin[[3]] - if(mode(Tmp)=="numeric"){ - Tmp<- as.character(Tmp) - } - S<- paste(S,"[",Tmp,"]",sep="") - } - S<- paste(S,"{",sep="") - Texcom(S) -} - -############################################### - -Texsetctr<- function(Nctr,Opstr) -{ - Ctr<- Texctr(Nctr) - Opstr<- paste(Opstr,"%",sep="") - OperL<- "+-*/%" - Oper<- "" - Va<- "" - Evflg<- 0 - Paflg<- 0 - for (I in Looprange(1,nchar(Opstr))){ - Tmp<- substring(Opstr,I,I) - if(Tmp=="("){ - Paflg<- 1 - if(nchar(Va)>0){ - Evflg<- 1 - Va<- paste(Va,Tmp,sep="") - } - next - } - if(Tmp==")"){ - Paflg<- 0 - if(Evflg>0){ - Va<- paste(Va,Tmp,sep="") - } - next - } - if(Paflg>0){ - Va<- paste(Va,Tmp,sep="") - next - } - if(length(grep(Tmp,OperL))==0){ - Va<- paste(Va,Tmp,sep="") - } - else{ - if(Evflg>0){ - Tmp1<- eval(parse(text=Va)) - Va<- paste("\\value{",Tmp1,"}",sep="") - Evflg<- 0 - } - if(Oper==""){ - if(nchar(Va)>0){ - Str<- paste("\\setcounter{",Ctr,"}{",Va,"}",sep="") - Texcom(Str) - } - Oper<- Tmp - Va<-"" - } - else if(Oper=="+"){ - Str<- paste("\\addtocounter{",Ctr,"}{",Va,"}",sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="-"){ - Str<- paste("\\addtocounter{",Ctr,"}{-",Va,"}",sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="*"){ - Str<- paste("\\multiply\\value{",Ctr,"} by ",Va,sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="/"){ - Str<- paste("\\divide\\value{",Ctr,"} by ",Va,sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - } - } -} - -############################################### - -Texthectr<- function(N) -{ - Out<- paste("\\the",Texctr(N),sep="") - return(Out) -} - -############################################### - -Texvalctr<- function(N){ - Out<- paste("\\value{",Texctr(N),"}",sep="") - return(Out) -} - -############################################### - -Texvctr<- function(N) -{ - Out<- paste("\\value{",Texctr(N),"}",sep="") - return(Out) -} - -############################################### - -Tonumeric <- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Data<- varargin[[1]] - Sp<- c(1,1) - Ep<- c(Inf,Inf) - if(Nargs>1){ - Sp<- varargin[[2]] - } - if(Nargs>2){ - Ep<- varargin[[3]] - } - Nrs<- Sp[1] - Nre<- min(nrow(Data),Ep[1]) - Ncs<- Sp[2] - Nce<- min(ncol(Data),Ep[2]) - Tmp1<- Data[Nrs:Nre, Ncs:Nce] - Tmp2 <- as.numeric(Tmp1) - Out <- matrix(Tmp2,nrow=nrow(Tmp1)) - Sp<- c() - for (I in 1:nrow(Out)){ - for (J in 1:ncol(Out)){ - Tmp<- Out[I,J] - if(!is.na(Tmp)){ - Sp<- c(I,J) - break; - } - } - if(length(Sp)>0) break - } - if(length(Sp)==0){ - return("Numeric data not found") - } - Ep<- c(nrow(Out),ncol(Out)) - for (I in Sp[1]:nrow(Out)){ - Tmp<- Out[I,Sp[2]] - if(is.na(Tmp)){ - Ep[1]<- I-1 - break - } - } - for (J in Sp[2]:ncol(Out)){ - Tmp<- Out[Sp[1],J] - if(is.na(Tmp)){ - Ep[2]<- J-1 - break - } - } - Out<- Out[Sp[1]:Ep[1], Sp[2]:Ep[2]] - return(Out) -} - -################################################## - -Translatedata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if(Mixtype(ML)==1){ - ML<- list(ML) - } - Tmp=varargin[[2]] - if(mode(Tmp)=="numeric" && length(Tmp)>1){ - A<- Tmp[1]; B<- Tmp[2] - } - else{ - A<- Tmp - if(Nargs>=3){ - B<- varargin[[3]] - } - else{ - B<- 0 - } - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if(X1==Inf){ - X2<- X1 - Y2<-Y1 - } - else{ - X2<- X1+A - Y2<- Y1+B - } - Out<- Appendrow(Out,c(X2,Y2)) - } - OutL<- Mixjoin(OutL,list(Out)) - } - if(length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -####################################### - -Unscaling<- function(G) -{ - GLg<- G - if(class(GLg)=="numeric"){ - GLg<-c(G[1]/SCALEX, G[2]/SCALEY) - Tmp<-GLg - if(LOGX==1) Tmp[1]<- 10^(GLg[1]) - if(LOGY==1) Tmp[2]<- 10^(GLg[2]) - return(Tmp) - } - else{ - Tmp1<-matrix(c(1/SCALEX,0,0,1/SCALEY),nrow=2) - GLg<-G %*% Tmp1 - Tmp<-GLg - if(LOGX==1) Tmp[,1]<- 10^(G[,1]) - if(LOGY==1) Tmp[,2]<- 10^(G[,2]) - return(Tmp) - } -} - -############################################# - -Vtickmark<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if(mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if(K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if(is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if(J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if(is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if(is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if(mode(Dt)=="numeric" && length(Dt)>1){ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt[1],Dt[2]) - next - } - if(mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(GENTEN[1],Dt) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X+MARKLEN,Y)) - Tmp2<- Unscaling(c(X-MARKLEN,Y)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if(Ndt==3){ - Tmp<-Unscaling(c(X-MARKLEN,Y)) - Expr(Tmp,"w",Moji) - } - if(Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("w",Houkou) - if(length(Tmp)>0){ - Tmp<-Unscaling(c(X-MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X+MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -############################################ - -Windisp<-function(...){ - varargin<-list(...) - Nargs<-length(varargin) - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") - Tmp<- Doscaling(Listplot(c(0,YMIN),c(0,YMAX))) - axis(2,at=as.numeric(Tmp[,2]), labels=round(c(YMIN,YMAX),2)) - Tmp<- Doscaling(Listplot(c(XMIN,0),c(XMAX,0))) - axis(1,at=as.numeric(Tmp[,1]), labels=round(c(XMIN,XMAX),2)) - Tmp1<- c(XMIN,GENTEN[2]) - Tmp2<- c(XMAX,GENTEN[2]) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if(Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp1<- c(GENTEN[1],YMAX) - Tmp2<- c(GENTEN[1],YMIN) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if(Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp<-Doscaling(Framedata()) - lines(Tmp[,1],Tmp[,2]) - for (I in Looprange(1,Nargs)){ - Pdata<-varargin[[I]] - if(mode(Pdata)=="numeric"){ - Pdata<-list(Pdata) - } - while(Mixtype(Pdata)==3){ # 10.02.23 - Tmp1<- list() - for(II in Looprange(1,length(Pdata))){ - Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) - } - Pdata<- Tmp1 - } # 10.02.23 - for (II in Looprange(1,length(Pdata))){ - Tmp<-Pdata[[II]] - P<-MakeCurves(Tmp,0) - Ndm<-Dataindex(P) - for (J in Looprange(1,Nrow(Ndm))){ - Q<-P[Ndm[J,1]:Ndm[J,2],] - if(Nrow(Q)==1){ - Tmp<-seq(1,Ncol(Q),by=2) - for (K in Tmp){ - Pt<-Q[K:(K+1)] - points(Pt[1],Pt[2]) - } - } - else{ - lines(Q[,1],Q[,2]) - } - } - } - } -} - -############################################ - -WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ # 10.12.04 - par(new=new) - varargin<-list(...) - Nargs<-length(varargin) - if(!new) # 10.12.04 - { - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") - Tick<- sort(c(YMIN,YMAX,vtick)) #### 10.12.04 from here - Tmp1<- matrix(c(rep(0,length(Tick)),Tick),ncol=2) - Tmp<- Doscaling(Tmp1) - axis(2,at=as.numeric(Tmp[,2]), labels=round(Tick,2)) - Tick<- sort(c(XMIN,XMAX,htick)) - Tmp1<- matrix(c(Tick,rep(0,length(Tick))),ncol=2) - Tmp<- Doscaling(Tmp1) - axis(1,at=as.numeric(Tmp[,1]), labels=round(Tick,2)) #### 10.12.04 to here - Tmp1<- c(XMIN,GENTEN[2]) - Tmp2<- c(XMAX,GENTEN[2]) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if(Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp1<- c(GENTEN[1],YMAX) - Tmp2<- c(GENTEN[1],YMIN) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if(Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp<-Doscaling(Framedata()) - lines(Tmp[,1],Tmp[,2]) - } - for (I in Looprange(1,Nargs)){ - Pdata<-Flattenlist(varargin[[I]]) # 101129 from here - Cmd<- list() - for (II in Looprange(1,length(Pdata))){ - Tmp<-Pdata[[II]] - if(length(Tmp)==1){ - Cmd<- c(Cmd,list(Tmp)) - next - } - - P<-MakeCurves(Tmp,0) - - if(length(Cmd)>0){ - if(length(Cmd)>=3){ - polygon(P,col=Cmd[[1]],border=Cmd[[2]],density=Cmd[[3]]) - } - else{ - polygon(P,col=Cmd[[1]],border=Cmd[[2]]) - } - next - } # 101129 to here - Ndm<-Dataindex(P) - for (J in Looprange(1,Nrow(Ndm))){ - Q<-P[Ndm[J,1]:Ndm[J,2],] - if(Nrow(Q)==1){ - Tmp<-seq(1,Ncol(Q),by=2) - for (K in Tmp){ - Pt<-Q[K:(K+1)] - points(Pt[1],Pt[2],col=color)#taka101111 - } - } - else{ - lines(Q[,1],Q[,2],col=color,lwd=width)#taka101111 - } - } - } - } - par(new=FALSE) -} - -###################################### - -# 3D - -################################# - -# 10.08.16 -CameracoordCurve<- function(Curve){ - Out<- c() - for(J in Looprange(1,Nrow(Curve))){ - P<- Ptcrv(J,Curve) #P=Curve(J,:); - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Xz<- X3 - Yz<- E3/(E3-X3)*Y3 - Zz<- E3/(E3-X3)*Z3 - Out<- rbind(Out,c(Yz,Zz,Xz)) - } - rownames(Out)<- 1:Nrow(Out) - return(Out) -} - -######################################### - -#100815 -CameraCurve<- function(Curve){ - Eps<- 10^(-6) - for (I in Looprange(1,Nrow(Curve))){ - P<- Curve[I,] - x<- P[1]; y<- P[2]; z<- P[3] - if(x!=Inf){ - Tmp<- Perspt(P) - if(I==1){ - AnsL<- rbind(c(),Tmp) - }else{ - Tmp1<- AnsL[Nrow(AnsL),] - if(Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){ - AnsL<- rbind(AnsL,Tmp) - } - } - }else{ - AnsL<- rbind(AnsL,c(Inf,Inf)) - } - } - rownames(AnsL)<- 1:Nrow(AnsL) - return(AnsL) -} - -###################################### - -Cancoordpara<- function(P){ # 18.02.15 - Xz<- P[1] - Yz<- P[2] - Zz<- P[3] - X<- -Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA) - Y<- Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA) - Z<- Yz*sin(THETA)+Zz*cos(THETA) - Out<- c(X,Y,Z) - return(Out) -} - -###################################### - -Cancoordpers<- function(P){ - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Xz<- P[3]; Yz<- P[1]; Zz<- P[2] - X3<- Xz; Y3<- Yz*(E3-Xz)/E3; Z3<- Zz*(E3-Xz)/E3 - X2<- X3*Cb-Sb*Z3; Y2<- Y3; Z2<- Cb*Z3+Sb*X3 - X1<- X2*Ca-Sa*Y2; Y1<- Ca*Y2+Sa*X2; Z1<- Z2 - X<- X1+FocusPoint[1] - Y<- Y1+FocusPoint[2] - Z<- Z1+FocusPoint[3] - Out<- c(X,Y,Z) - return(Out) -} - -####################################### - -Embed<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Pd3<- varargin[[1]] - if(Mixtype(Pd3)==1){ - Pd3<- list(Pd3) - } - else if(Mixtype(Pd3)==3){ - Tmp<- list(); - for(I in Looprange(1,length(Pd3))){ - Tmp<- c(Tmp,Pd3[[I]]) - } - Pd3<- Tmp - } - Tmpf=varargin[[2]] - if(mode(Tmpf)=="character"){ - Tmp<- varargin[[3]] - Tmp1<- gsub("c(","(",Tmp,fixed=TRUE) - Vstr<- gsub(")",")",Tmp1,fixed=TRUE) - Str<- paste("Tmpfn<- function",Vstr,"{",Tmpf,"}",sep="") - eval(parse(text=Str)) - } - else{ - Tmpfn<- Tmpf - } - Out<- list() - for(I in Looprange(1,length(Pd3))){ - PD<- Pd3[[I]] - Ans<- c() - for(J in Looprange(1,Nrow(PD))){ - P<- PD[J,] - Tmp<- Tmpfn(P[1],P[2]) - Ans<- rbind(Ans,Tmp) - } - Out<- c(Out, list(Ans)) - } - if(length(Out)==1){ - Out<- Out[[1]] - } - return(Out) -} - -####################### -# 10.08.17 -# 14.03.30 -Facesdata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - FL<- varargin[[1]] - PT<- varargin[[length(varargin)]] - Tmp<-grep("para",PT,fixed=TRUE) - if(length(Tmp)>0){ - Ptype<- 1 - }else{ - Ptype<- -1 - } - if(Nargs==2){ - CLadd<- list() - }else{ - CLadd<- varargin[[2]] - } - NohiddenL<- list() - HiddenL<- list() - Eps<- 10^(-4) - if(length(CLadd)>0){ - if(mode(CLadd)=="numeric"){ - C<- list() - if(Nrow(CLadd)>1){ - for (I in Looprange(1,Nrow(CLadd))){ - C<- c(C,list(CLadd[I,])) - } - }else{ - I<- 1 - while (I<=Ncol(CLadd)){ - C<- c(C,list(CLadd[1,I:(I+2)])) - I<- I+3 - } - } - CrvL<- list(C) - }else if(mode(CLadd[[1]])=="numeric"){ - CrvL<- list() - for (J in Looprange(1,length(CL))){ - Ctmp<- CLadd[[J]] - C<- list() - if(Nrow(Ctmp)>1){ - for (I in Looprange(1,Nrow(Ctmp))){ - C<- c(C,list(Ctmp[I,])) - } - }else{ - I<- 1 - while(I<=Ncol(Ctmp)){ - C<- c(C,list(Ctmp[1,I:(I+2)])) - I<- I+3 - } - } - CrvL<- c(CrvL,list(C)) - } - }else{ - CrvL<- CLadd - } - }else{ - CrvL<- list() - } - Out<- MakeveLfaceL(FL) - VELNO<<- Out[[1]] - VELHI<<- list() - for (I in Looprange(1,length(CrvL))){ - Tmp<- CrvL[[I]] - for (J in Looprange(1,length(Tmp)-1)){ - Edge<- list(Tmp[J],Tmp[J+1]) - Ntmp<- length(VELNO) - VELNO(Ntmp+1)<<- list(Edge,0,Ntmp+1) - } - } - FaceL<- Out[[2]] - Tmp<- grep("raw",PT,fixed=TRUE) - if(length(Tmp)==0){ - for (Nf in Looprange(1,length(FaceL))){ - Face<- FaceL[[Nf]] - Menkakusi2(Face,Nf,Ptype) - } - } - for (I in Looprange(1,length(VELNO))){ - Edge<- Op(1,VELNO[[I]]) - if(Norm(Edge[[1]]-Edge[[2]])>Eps){ - NohiddenL<- c(NohiddenL,list(Spaceline(Edge))) - } - } - EdgeL<- list() # from 13.03.30 - for(K in Looprange(1,length(VELHI))){ - Edge<- Op(1,VELHI[[K]]) - P<- Edge[[1]]; Q<- Edge[[2]] - if(Norm(P-Q)>Eps){ - EdgeL<- c(EdgeL,list(Edge)) - } - } - for(K in Looprange(1,length(EdgeL))){ - Edge<- EdgeL[[K]] - P<- Edge[[1]]; Q<- Edge[[2]] - Cflg<- 0 - for(J in Looprange(K+1,length(EdgeL))){ - Ej<- EdgeL[[J]] - Pj<- Ej[[1]]; Qj<- Ej[[2]] - if(Norm(Crossprod(Q-P,Qj-Pj))>Eps){ - next - } - if(Norm(Q-Pj)<Eps){ - EdgeL[[J]]<- list(P,Qj) - Cflg<- 1 - break - } - if(Norm(P-Qj)<Eps){ - EdgeL[[J]]=list(Q,Pj) - Cflg<- 1 - break - } - } - if(Cflg==0){ - HiddenL<- c(HiddenL,list(Spaceline(Edge))) - } - } # upto 14.03.30 - PHHIDDENDATA<<- HiddenL - return(NohiddenL) -} - -############################## -# 2014.03.31 - -PhHiddenData<- function(){ - PHHIDDENDATA -} - -########## Old Fullform ( Check the case of Polygon )#################### - -Fullformfunc<- function(FdL){# Out=Fullformfunc(FdL) - Out<- list(Op(1,FdL)) - N<- Mixlength(FdL) - for (Jrg in Looprange(1,N)){ - Tmp<- Stripblanks(Op(Jrg,FdL)) - Tmp1<- grep("=c(",Tmp,fixed=TRUE) - if(length(Tmp1)>0){ - break - } - } - Urg<- Stripblanks(Op(Jrg,FdL)) - StrV<- strsplit(Urg,"=",fixed=TRUE)[[1]] - Uname<- StrV[1] - Vrg<- Stripblanks(Op(Jrg+1,FdL)) - StrV<- strsplit(Vrg,"=",fixed=TRUE)[[1]] - Vname<- StrV[1] - if(Jrg==2){ - Tmp<- Stripblanks(Op(1,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- list(Uname,Vname,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - }else if(Jrg==4){ - Tmp<- Stripblanks(Op(1,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- Stripblanks(Op(2,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Xname<- StrV[1] - Xf<- StrV[2] - Tmp<- Stripblanks(Op(3,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Yname<- StrV[1] - Yf<- StrV[2] - Tmp<- gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) - Zf<- gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) - Tmp<- list(Xf,Yf,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - }else{ - Tmp<- Stripblanks(Op(2,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Xf<- StrV[2] - Tmp<- Stripblanks(Op(3,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Yf<- StrV[2] - Tmp<- Stripblanks(Op(4,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- list(Xf,Yf,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - } - DrwS<- "enws" - BdyL<- c() - for (I in Looprange(Jrg+2,Mixlength(FdL))){ - Tmp<- Op(I,FdL) - if(mode(Tmp)=="character"){ - if(length(Tmp)==0){ - Tmp<- " " - } - DrwS<- Tmp - } - if(mode(Tmp)=="numeric" && Ncol(Tmp)>1){ - BdyL<- Tmp - } - } - Tmp<- list(DrwS,BdyL) - Out<- c(Out,Tmp) - return(Out) -} - -#################################### - -Initangle<- function (){ - PHI<<- 30*pi/180 - THETA<<- 60*pi/180 -} - -########################## - -Invparapt<- function(...){ - varargin<- list(...) - Eps<- 10^(-4) - Fk<- varargin[[length(varargin)]] - NFk<- Numptcrv(Fk) - Tmp<- varargin[[1]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ # debug - Ph<- Tmp - Fh<- varargin[[2]] - }else{ - Fh<- Projpara(Fk) - if(NFk>2){ - Tmp1<- Nearestpt(Tmp,Fh) - Ph<- Tmp1[[2]] - }else{ - Ah<- Ptcrv(1,Fh); Bh=Ptcrv(2,Fh) - V1<- Tmp-Ah; V2<- Bh-Ah - Tmp1<- Crossprod(V1,V2) - if(abs(Tmp1)>Eps){ - print("Not on the line") - return(c()) - }else{ - Ph<- Dotprod(V1,V2)/Norm(V2)^2+1 - } - } - } - if(NFk>2){ - N<- trunc(Ph) - S0<- Ph-N - if(Ph>Numptcrv(Fh)-Eps){ - Out<- list(Ptend(Fk),Numptcrv(Fh)) - return(Out) - } - }else{ - N<- 1 - S0<- Ph-1 - } - Ak<- Ptcrv(N,Fk); Bk=Ptcrv(N+1,Fk) - Ah<- Ptcrv(N,Fh); Bh=Ptcrv(N+1,Fh) - Ph<- (1-S0)*Ah+S0*Bh - T2<- S0 - Pk<- (1-T2)*Ak+T2*Bk - Out<- list(Pk,N+T2) - return(Out) -} - -################################# - -#100815 -Invperspt<- function(...){ - varargin<-list(...) - Eps<- 10^(-4) - Fk<- varargin[[length(varargin)]] - NFk<- Numptcrv(Fk) - Tmp<- varargin[[1]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - Ph<- varargin[[1]] - Fh<- varargin[[2]] - }else{ - Fh<- Projpers(Fk) - if(NFk>2){ - Tmp1<- Nearestpt(Tmp,Fh) - Ph<- Tmp1[[2]] - }else{ - Ah<- Ptcrv(1,Fh); Bh<- Ptcrv(2,Fh) - V1<- Tmp-Ah; V2<- Bh-Ah - Tmp1<- Crossprod(V1,V2) - if(abs(Tmp1)>Eps){ - print("Not on the line") - Out<- c() - return(Out) - }else{ - Ph<- Dotprod(V1,V2)/Norm(V2)^2+1# 09.11.12 - } - } - } - if(NFk>2){ - N<- trunc(Ph) - S0<- Ph-N - if(Ph>Numptcrv(Fh)-Eps){ - Out<- list(Ptend(Fk),Numptcrv(Fh)) - return(Out) - } - }else{ - N<- 1 - S0<- Ph-1 # 09.11.12 - } - Ak<- Ptcrv(N,Fk); Bk<- Ptcrv(N+1,Fk) - Ah<- Ptcrv(N,Fh); Bh<- Ptcrv(N+1,Fh) - Ph<- (1-S0)*Ah+S0*Bh - Phc<- Cancoordpers(c(Ph,0)) - Ahc<- Cancoordpers(c(Ah,0)) - Bhc<- Cancoordpers(c(Bh,0)) - Vp<- Phc-EyePoint - Va<- Ak-EyePoint - AB<- Bk-Ak - Cp<- Crossprod(Vp,AB) - Nmr<- Crossprod(Va,Vp) - Mx<- max(abs(Cp)) - if(abs(Cp[1])==Mx){ - T2<- Nmr[1]/Cp[1] - }else if(abs(Cp[2])==Mx){ - T2<- Nmr[2]/Cp[2] - }else{ - T2<- Nmr[3]/Cp[3] - } - Pk<- (1-T2)*Ak+T2*Bk - Out<- list(Pk,N+T2) - return(Out) -} - -######################### - -Kukannozoku<- function(Jokyo,KukanL){ - Eps<- 10^(-6) - N<- Nrow(KukanL) - T1<- Jokyo[1]; T2<- Jokyo[2] - Tmp<- KukanL[1,] - T1<- max(T1,Tmp[1]) - Tmp<- KukanL[N,] - T2<- min(T2,Tmp[2]) - Res<- c() - Flg<- 0 - for (I in Looprange(1,N)){ - Ku<- KukanL[I,] - if(Flg==0){ - if(Ku[2]<T1){ - Res<- rbind(Res,Ku) - }else{ - Flg<- 1 - if(Ku[1]<T1-Eps){ - Tmp<- c(Ku[1],T1) - Res<- rbind(Res,Tmp) - } - if(Ku[2]>T2+Eps){ - Tmp<- c(T2,Ku[2]) - Res<- rbind(Res,Tmp) - } - } - }else if(Flg==1){ - if(Ku[2]<T2){ - next - }else{ - Flg<- 2 - if(Ku[1]<T2-Eps){ - Ku<- c(T2,Ku[2]) - } - Res<- rbind(Res,Ku) - } - }else{ - Res<- rbind(Res,Ku) - } - } - return(Res) -} - -######################################## - -Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){ - Eps<- 10.0^(-3) - Dmat<- c() - Dind<- c() - for (I in Looprange(1,Mixlength(Plt2L))){ - Dt<- Op(I,Plt2L) - N1<- Nrow(Dmat)+1 - if(Nrow(Dmat)==0){ - Dmat<- Dt - }else{ - Dmat<- rbind(Dmat,Dt) - } - N2<- Nrow(Dmat) - Dind<- c(Dind,N1,N2) - } - Dind<- matrix(Dind,ncol=2,byrow=TRUE) - Nind<- Nrow(Dind) - Allres<- list() - for (Nobj in Looprange(1,Mixlength(Obj2L))){ - Plt2<- Op(Nobj,Obj2L) - PhL<- Plt2[,1:2] - ClipL<- c() - for (Ns in Looprange(1,Nrow(PhL)-1)){ - P1<- PhL[Ns:(Ns+1),] - for (I in Looprange(1,Nrow(Dind))){ - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - P2<- Tmp[,1:2] - KC<- IntersectcrvsPp(P1,P2,Eps) - if(Mixlength(KC)>0){ - for (J in 1:Mixlength(KC)){ - P<- Op(1,Op(J,KC)) - Tmp<- Op(2,Op(J,KC)) - if(Tmp<1+Eps && Ns==1){ - next - } - if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ - next - } - N1<- Ns - N2<- Op(3,Op(J,KC)) - Pa<- Plt2[N1,1:2] - Za<- Plt2[N1,3] - Pb<- Plt2[N1+1,1:2] - Zb<- Plt2[N1+1,3] - if(Norm(Pa-Pb)<Eps){ - next - } - T1<- Norm(Pa-P)/Norm(Pa-Pb) - Z1<- (1-T1)*Za+T1*Zb - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - Pa<- Tmp[N2,1:2] - Za<- Tmp[N2,3] - Pb<- Tmp[N2+1,1:2] - Zb<- Tmp[N2+1,3] - if((Norm(Pa-Pb)<Eps)){ - next - } - T2<- Norm(Pa-P)/Norm(Pa-Pb) - Z2<- (1-T2)*Za+T2*Zb - if(Z1<Z2-Eps2){ - if(Nrow(ClipL)==0){ - Tmp<- 1 - }else{ - Tmp1<- ClipL[,1]-P[1] - Tmp2<- ClipL[,2]-P[2] - Tmp3<- Tmp1^2+Tmp2^2 - Tmp<- min(Tmp3) - } - if(Tmp>Eps^2){ - Tmp1<- P1[2,]-P1[1,] - Tmp2<- Pb-Pa - Tmp3<- Dotprod(Tmp1,Tmp2) - Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) - Tmp<- 1-0.5*Tmp3^2 - ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) - } - } - } - } - } - } - Te<- Nrow(Plt2) - KukanL<- rbind(c(),c(1.0,Te)) - P1<- PhL - if(Nrow(ClipL)>0){ - for (I in 1:Nrow(ClipL)){ - P<- ClipL[I,1:2] - NN<- ClipL[I,3] - T<- NN+ClipL[I,4] - R<- ClipL[I,5] - Flg<- 0 - for (J in NN:1){ - Q<- Pointoncurve(J,P1) - if(Norm(P-Q)<R){ - next - } - Flg<- 1 - break - } - if(Flg==0){ - T1<- 1 - }else{ - T1<- J; T2<- T - H<- T2-T1 - for (N in 1:10){ - H<- H*0.5 - Q<- Pointoncurve(T1+H,P1) - if(Norm(P-Q)<R){ - T2<- T2-H - }else{ - T1<- T1+H - } - } - } - Ku<- c(T1) - Flg<- 0 - for (J in Looprange(NN+1,Te)){ - Q<- Pointoncurve(J,P1) - if(Norm(P-Q)<R){ - next - } - Flg<- 1 - break - } - if(Flg==0){ - T2<- Te - }else{ - T1<- T; T2<- J - H<- T2-T1 - for (N in 1:10){ - H<- H*0.5 - Q<- Pointoncurve(T1+H,P1) - if(Norm(P-Q)<R){ - T1<- T1+H - }else{ - T2<- T2-H - } - } - } - Ku<- c(Ku,T2) - KukanL<- Kukannozoku(Ku,KukanL) - } - } - Res<- list() - for (I in Looprange(1,Nrow(KukanL))){ - T1<- KukanL[I,1]; N1<- trunc(T1) - T2<- KukanL[I,2]; N2<- trunc(T2) - PtL<- list() - if(T1-N1<1-Eps){ - Tmp<- Pointoncurve(T1,P1) - PtL<- list(Tmp) - } - for (J in Looprange(N1+1,N2)){ - Tmp<- Pointoncurve(J,P1) - PtL<- c(PtL,list(Tmp)) - } - if(T2-N2>Eps){ - Tmp<- Pointoncurve(T2,P1) - PtL<- c(PtL,list(Tmp)) - } - Res<- c(Res,list(Listplot(PtL))) - } - Allres<- c(Allres,Res) - } - return(Allres) -} - -######################### - -#100815 -Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){ - Eps<- 10.0^(-3) - Dmat<- c() - Dind<- c() - for (I in Looprange(1,Mixlength(Plt2L))){ - Dt<- Op(I,Plt2L) - N1<- Nrow(Dmat)+1 - Dmat<- rbind(Dmat,Dt) - N2<- Nrow(Dmat) - Dind<- rbind(Dind,c(N1,N2)) - } - Nind<- Nrow(Dind) - Allres<- list() - for (Nobj in Looprange(1,Mixlength(Obj2L))){ - Plt2<- Op(Nobj,Obj2L) - PhL<- Plt2[,1:2] - ClipL<- c() - for (Ns in Looprange(1,Nrow(PhL)-1)){ - P1<- PhL[Ns:(Ns+1),] - for (I in Looprange(1,Nrow(Dind))){ - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - P2<- Tmp[,1:2] - KC<- IntersectcrvsPp(P1,P2,Eps) - if(Mixlength(KC)>0){ - for (J in Looprange(1,Mixlength(KC))){# - P<- Op(1,Op(J,KC)) - Tmp<- Op(2,Op(J,KC)) - if(Tmp<(1+Eps) && Ns==1){ - next - } - if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ - next - } - N1<- Ns - N2<- Op(3,Op(J,KC)) - Pa<- Plt2[N1,1:2] - Za<- Plt2[N1,3] - Pb<- Plt2[N1+1,1:2] - Zb<- Plt2[N1+1,3] - if(Norm(Pa-Pb)<Eps){ - next - } - T1<- Norm(Pa-P)/Norm(Pa-Pb)#norm(Pa-P)/norm(Pa-Pb) - Pka<- Cancoordpers(c(Pa[1],Pa[2],Za)) - Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb)) - if(T1>1-Eps){ - Pk<- Pkb - }else{ - Tmp1<- Listplot(c(Pa,Pb)) - Tmp2<- Spaceline(c(Pka,Pkb)) - Tmp<- Invperspt(1+T1,Tmp1,Tmp2) - Pk<- Op(1,Tmp) - } - Z1<- Zperspt(Pk) - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - Pa<- Tmp[N2,1:2] - Za<- Tmp[N2,3] - Pb<- Tmp[N2+1,1:2] - Zb<- Tmp[N2+1,3] - if(Norm(Pa-Pb)<Eps){ - next - } - T2<- Norm(Pa-P)/Norm(Pa-Pb) - Pka<- Cancoordpers(c(Pa[1],Pa[2],Za)) - Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb)) - if(T2>(1-Eps)){ - Pk<- Pkb - }else{ - Tmp1<- Listplot(c(Pa,Pb)) - Tmp2<- Spaceline(c(Pka,Pkb)) - Tmp<- Invperspt(1+T2,Tmp1,Tmp2) - Pk<- Op(1,Tmp) - } - Z2<- Zperspt(Pk) - if(Z1<(Z2-Eps2)){ - if(length(ClipL)==0){ - Tmp<- 1 - }else{ - Tmp1<- ClipL[,1]-P[1] - Tmp2<- ClipL[,2]-P[2] - Tmp3<- Tmp1^2+Tmp2^2 - Tmp<- min(Tmp3) - } - if(Tmp>Eps^2){ - Tmp1<- P1[2,]-P1[1,] - Tmp2<- Pb-Pa - Tmp3<- Dotprod(Tmp1,Tmp2) - Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) - Tmp<- 1-0.5*Tmp3^2 - ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) - } - } - } - } - } - } - Te<- Nrow(Plt2) - KukanL<- rbind(c(),c(1.0,Te)) - P1<- PhL - if(Nrow(ClipL)>0){ - for (I in Looprange(1,Nrow(ClipL))){ - P<- ClipL[I,1:2] - NN<- ClipL[I,3] - T<- NN+ClipL[I,4] - R<- ClipL[I,5] #added 10.08.17 - Flg<- 0 - for (J in NN:1){ - Q<- Pointoncurve(J,P1) - if(Norm(P-Q)<R){#(norm(P-Q)<R) - next - } - Flg<- 1 - break - } - if(Flg==0){ - T1<- 1 - }else{ - T1<- J; T2<- T - H<- T2-T1 - for (N in 1:10){ - H<- H*0.5 - Q<- Pointoncurve(T1+H,P1) - if(Norm(P-Q)<R){ # norm(P-Q)<R - T2<- T2-H - }else{ - T1<- T1+H - } - } - } - Ku<- c(T1)#Ku<- [T1] - Flg<- 0 - for (J in Looprange(NN+1,Te)){ - Q<- Pointoncurve(J,P1) - if(Norm(P-Q)<R){ - next#continue - } - Flg<- 1 - break - } - if(Flg==0){ - T2<- Te - }else{ - T1<- T; T2<- J - H<- T2-T1 - for (N in 1:10){ - H<- H*0.5 - Q<- Pointoncurve(T1+H,P1) - if(Norm(P-Q)<R){ - T1<- T1+H - }else{ - T2<- T2-H - } - } - } - Ku<- c(Ku,T2)#[Ku,T2] - KukanL<- Kukannozoku(Ku,KukanL) - } - } - Res<- list()#[] - for (I in Looprange(1,Nrow(KukanL))){#(I=1:size(KukanL,1)) - T1<- KukanL[I,1]; N1<- trunc(T1) - T2<- KukanL[I,2]; N2<- trunc(T2) - PtL<- list()#[] - if(T1-N1<1-Eps){ - Tmp<- Pointoncurve(T1,P1) - PtL<- list(Tmp)#100816c(PtL,list(Tmp)) PtL<- MixS(Tmp) - } - for (J in Looprange(N1+1,N2)){ - Tmp<- Pointoncurve(J,P1) - PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp) - } - if(T2-N2>Eps){ - Tmp<- Pointoncurve(T2,P1) - PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp) - } - Res<- c(Res,list(Listplot(PtL)))#Res<- Mixadd(Res,Listplot(PtL)) - } - Allres<- c(Allres,Res)#Allres<- Mixjoin(Allres,Res) - } - return(Allres) -} - -##############################3 - -MakeveLfaceL<- function(VfL){ -# // Out format -# // VeL Edge, Face num(as numlist), VeL num -# // FL Face (Vertexs) - Eps<- 10^(-4) - Tmp<- VfL[[length(VfL)]] - Tmp1<- Tmp[[1]] - if(mode(Tmp1)=="numeric"){ - FvL<- list(VfL) - }else{ - FvL<- VfL - } - EL<- list(); FL<- list() - for (Nn in Looprange(1,length(FvL))){ - Tmp<- FvL[[Nn]] - VL<- Tmp[[1]] - if(length(VL)>0){ - FnL<- Tmp[[2]] - FaceL<- list() - for (I in Looprange(1,length(FnL))){ - Tmp1<- FnL[[I]] - PtL<- list() - for (J in Looprange(1,length(Tmp1))){ - Tmp2<- Tmp1[[J]] - PtL[[J]]<- VL[[Tmp2]] - } - FaceL[[I]]<- PtL - } - }else{ - FaceL<- list(Tmp[[2]]) - } - for (I in Looprange(1,length(FaceL))){ - Face<- FaceL[[I]] - Face<- c(Face,list(Face[[1]])) - FL<- c(FL,list(Face)) - for (J in Looprange(1,length(Face)-1)){ - Edge<- list(Face[[J]],Face[[J+1]]) - Flg<- 0 - for (K in Looprange(1,length(EL))){ - Tmp<- EL[[K]] - Tmp1<- Tmp[[1]] - Tmp2<- Norm(Edge[[1]]-Tmp1[[1]])+Norm(Edge[[2]]-Tmp1[[2]]) - Tmp3<- Norm(Edge[[1]]-Tmp1[[2]])+Norm(Edge[[2]]-Tmp1[[1]]) - if(Tmp2<Eps || Tmp3<Eps){#( - Tmp<- EL[[K]] - Tmp1<- Tmp[[1]] - Tmp2<- c(Tmp[[2]],length(FL)) - EL[[K]]<- list(Tmp1,Tmp2,K) - Flg<- 1 - break - } - } - if(Flg==0){ - Ntmp<- length(EL) - EL[[Ntmp+1]]<- list(Edge,c(length(FL)),Ntmp+1) - } - } - } - } - Out<- list(EL,FL) - return(Out) -} - -########################### -#// 09.10.29 -#// 09.11.15 - -Menkakusi2<- function(Face,Nf,Ptype){ -# global THETA PHI EyePoint FocusPoint VELNO VELHI - Eps0<- 10^(-6) - Eps<- 10^(-4) - Tmp1<- Face[[1]]-Face[[2]] - Tmp2<- Face[[3]]-Face[[2]] - if(Norm(Tmp1)<Eps || Norm(Tmp2)<Eps){ - return() - } - Vec<- 1/Norm(Tmp1)/Norm(Tmp2)*Crossprod(Tmp1,Tmp2) - if(Norm(Vec)<Eps){ - return() - } - if(Ptype== -1){ - W<- EyePoint - Tmp<- Dotprod(Vec,W-Face[[1]]) - }else{ - W<- c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)) - W<- 100*W - Tmp<- Dotprod(Vec,W-Face[[1]]) - } - if(abs(Tmp)<Eps){ - return() - } - if(Tmp<-Eps){ - Vec<- -Vec - } - if(Ptype==-1){ - G1<- Projpers(Spaceline(Face)) - }else{ - G1<- Projpara(Spaceline(Face)) - } - VL<- list() - for (I in Looprange(1,Numptcrv(G1))){ - VL[[I]]<- Ptcrv(I,G1) - } - Out1L<- list() - Out2L<- VELHI - for (N in Looprange(1,length(VELNO))){ - Out1<- list() - Out2<- list() - Tmp<- VELNO[[N]] - Edge<- Tmp[[1]] - Ne<- Tmp[[2]] - NNe<- Tmp[[3]] - if(Member(Nf,Ne)){ - Out1L<- c(Out1L, list(list(Edge,Ne,NNe))) - next - } - if(Ptype==-1){ - PtA<- Perspt(Edge[[1]]) - PtB<- Perspt(Edge[[2]]) - }else{ - PtA<- Parapt(Edge[[1]]) - PtB<- Parapt(Edge[[2]]) - } - if(Norm(PtA-PtB)<Eps){ - next - } - Bdy<- list(G1) - V<- PtB-PtA - TenL<- KoutenList(PtA,V,Bdy) - Nten<- length(TenL) - if(Nten==0){ # debug 10.08.17 - Out1L<- c(Out1L,list(list(Edge,Ne,NNe))) - next - } - Te<- 0 - Pe3<- Edge[[1]] - if(Ptype==-1){ - Tmp1<- Perspt(Pe3) - Tmp<- Invperspt(Tmp1,Spaceline(Face)) - }else{ - Tmp1<- Parapt(Pe3) - Tmp<- Invparapt(Tmp1,Spaceline(Face)) - } - Qe3<- Tmp[[1]] - Flg<- 0 - for (I in Looprange(1,Nten)){ - TenP<- TenL[[I]] - Ts<- TenP[[1]] - P<- TenP[[2]] - if(Ts< -Eps){ - next - } - Eline<- Spaceline(Edge) - if(Ptype==-1){ - Tmp<- Invperspt(P,Eline) - Tmp1<- Invperspt(P,Spaceline(Face)) - }else{ - Tmp<- Invparapt(P,Eline) - Tmp1<- Invparapt(P,Spaceline(Face)) - } - P3<- Tmp[[1]]; Q3<- Tmp1[[1]] - if(Ts>1-Eps){# // P3, Q3 are necessary - Flg<- I - break - } - if(abs(Te-Ts)>Eps0){ - if((I%%2)==1){ - Out1<- c(Out1,list(list(Pe3,P3))) - }else{ - if(length(Qe3)==0){ - Tmp<- Op(2,TenL[[I-1]]) - if(Ptype==-1){ - Tmp1<- Invperspt(Tmp,Spaceline(Face)) - }else{ - Tmp1<- Invparapt(Tmp,Spaceline(Face)) - } - Qe3<- Tmp1[[1]] - } - PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) - if(Ptype==-1){ - Z1<- Zperspt(PM); Z2<- Zperspt(QM) - }else{ - Z1<- Zparapt(PM); Z2<- Zparapt(QM) - } - if(Z1>Z2){ - Out1<- c(Out1, list(list(Pe3,P3))) - }else{ - Out2<- c(Out2, list(list(Pe3,P3))) - }## - } - } - Te<- Ts; Pe3<- P3; Qe3<- Q3 - } - if(Flg==0){ - if(Norm(Pe3-Edge[[2]])>Eps0){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - } - }else{ - if((Flg%%2)==1){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - }else{ - PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) - if(Ptype==-1){ - Z1<- Zperspt(PM); Z2<- Zperspt(QM) - }else{ - Z1<- Zparapt(PM); Z2<- Zparapt(QM) - } - if(Z1>Z2){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - }else{ - Out2<- c(Out2, list(list(Pe3,Edge[[2]]))) - } - } - } - for (I in Looprange(1,length(Out1))){ - Tmp<- Out1[[I]] - if(I==1){ - SeL<- Tmp - }else{ - if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){ - SeL[[2]]<- Tmp[[2]] - }else{ - Out1L<- c(Out1L, list(list(SeL,Ne,NNe))) - SeL<- Tmp - } - } - } - if(length(Out1)>0){ - Out1L<- c(Out1L, list(list(SeL,Ne,NNe))) - } - for (I in Looprange(1,length(Out2))){ - Tmp<- Out2[[I]] - if(I==1){ - SeL<- Tmp - }else{ - if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){ - SeL[[2]]<- Tmp[[2]] - }else{ - Out2L<- c(Out2L, list(list(SeL,Ne,NNe))) - SeL<- Tmp - } - } - } - if(length(Out2)>0){ - Out2L<- c(Out2L, list(list(SeL,Ne,NNe))) - } - } - VELNO<<- Out1L - VELHI<<- Out2L -} - -################################### - -Parapt<- function(Plist){ # 18.02.19 changed (for point list) - if(!is.list(Plist)){Plist=list(Plist)} - Out=list() - for(jj in 1:length(Plist)){ - P=Op(jj,Plist) - x<- P[1] - y<- P[2] - z<- P[3] - Xz<- -x*sin(PHI)+y*cos(PHI) - Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA) - Out<- c(Out,list(c(Xz,Yz))) - } - if(length(Out)==1){Out=Op(1,Out)} - return(Out) -} - -################################### - -Partcrv3<- function(T1,T2,Fk){ - Eps0=10^(-4) -#// Tmp=Mixop(1,Fk) -#// new part from - if(T1>(T2+Eps0)){ - Npt<- Nrow(Fk) - Out1<- Partcrv3(T1,Npt,Fk) - Out2<- Partcrv3(1,T2,Fk) - Tmp<- Fk[1,]-Fk[Npt,] - if(Norm(Tmp)<Eps0){ - PL<- Joincrvs(Out1,Out2) - }else{ - PL<- list(Out1,Out2) - } - rownames(PL)<- 1:Nrow(PL) - return(PL) - } - if(floor(T1)==floor(T2)){ #18.02.26from - Tmp=floor(T1) - p1=Op(Tmp,Fk); p2=Op(Tmp+1,Fk) - PL=c(p1+(T1-Tmp)*(p2-p1)) - PL=Appendrow(PL, p1+(T2-Tmp)*(p2-p1)) #18.02.26upto - }else{ - Is<- ceiling(T1) - Ie<- floor(T2) - PL<- c() - if(T1<Is-Eps0){ - P<- (Is-T1)*Fk[Is-1,]+(1-Is+T1)*Fk[Is,] - PL<- Appendrow(PL, P) #18.02.10(bug) - } - PL<- Appendrow(PL,Fk[Is:Ie,]) - if(T2>(Ie+Eps0)){ - P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,] - PL<- Appendrow(PL,P) - } - } - return(PL) -} - -################################### - -#100815 -Perspt<- function(P){ - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1];F1<- Tmp[2];G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Yz<- E3/(E3-X3)*Y3 - Zz<- E3/(E3-X3)*Z3 - Out<- c(Yz,Zz) - return(Out) -} - - -################################# - -Phcutdata<- function(VL,FaceL,PlaneD){ - Out<- list() - EL<- list() - Eps<- 10^(-4) - for (I in Looprange(1,Mixlength(FaceL))){ - Face<- Op(I,FaceL) - for (J in Looprange(1,length(Face))){ - Nj<- J+1 - if(J==length(Face)){ - Nj<- 1 - } - N1<- Face[J]; N2<- Face[Nj] - Tmp<- c(N1,N2) - Flg<- 0 - for (K in Looprange(1,Mixlength(EL))){ - Tmp1<- Op(K,EL) - Tmp2<- Tmp1[2:1] - if(all(Tmp==Tmp1) || all(Tmp==Tmp2)){ - Flg<- 1 - break - } - } - if(Flg==0){ - EL<- c(EL,list(Tmp)) - } - } - } - Out0<- list() - for (I in Looprange(1,Mixlength(EL))){ - Tmp<- Op(I,EL) - Tmp1<- Op(Tmp[1],VL) - Tmp2<- Op(Tmp[2],VL) - Out0<- c(Out0, list(Spaceline(Tmp1,Tmp2))) - } - if(Mixtype(PlaneD)!=1){ - V1<- Op(1,PlaneD) - Tmp<- Op(2,PlaneD) - if(length(Tmp)>1){ - d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] - }else{ - d<- Tmp - } - }else if(mode(PlaneD)=="numeric"){ - V1<- PlaneD[1:3] - d<- PlaneD[4] - }else{ - StrV<- strsplit(PlaneD,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Tmp1<- StrV[1] - Tmp2<- StrV[2] - PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") - } - x<- 0; y<- 0; z<- 0 - d<- -eval(parse(text=PlaneD)) - x<- 1; y<- 0; z<- 0; - Tmp1<- eval(parse(text=PlaneD))+d - x<- 0; y<- 1; z<- 0 - Tmp2<- eval(parse(text=PlaneD))+d - x<- 0; y<- 0; z<- 1 - Tmp3<- eval(parse(text=PlaneD))+d - V1<- c(Tmp1,Tmp2,Tmp3) - } - if(all(V1==c(0,0,0))){ - return(Out0) - } - V3<- c(1,0,0) - Out1<- Rotate3data(Out0,V1,V3) - Tmp2<- Rotate3pt(c(1,0,0),V3,V1) - Tmp<- V1[1]*Tmp2[1]+V1[2]*Tmp2[2]+V1[3]*Tmp2[3] - x0<- d/Tmp - PtL<- list() - for (I in Looprange(1,Mixlength(Out1))){ - Tmp<- Op(I,Out1) - Tmp1<- Tmp[1,]; Tmp2<- Tmp[2,] - P<- list(Tmp1,Tmp2-Tmp1) - Tmp<- list(Tmp1[1],Tmp2[1]-Tmp1[1]) - if(abs(Tmp[[2]]) < Eps){ - Tmp<- c() - }else{ - Tmp1<- Tmp[[2]] - Tmp2<- x0-Tmp[[1]] - Tmp<- c(Tmp2/Tmp1) - } - if(length(Tmp)>0){ - Tmp<- Tmp[1] - if(Tmp>-Eps && Tmp<(1+Eps)){ - Tmp3<- P[[1]]+Tmp*P[[2]] - Tmp3<- Rotate3pt(Tmp3,V3,V1) - if(Tmp<Eps){ - Tmp1<- Op(I,EL) - Tmp1<- Tmp1[1] - Tmp4<- list(c(Tmp1,Tmp1),Tmp3) - }else{ - if(Tmp>1-Eps){ - Tmp1<- Op(I,EL) - Tmp1<- Tmp1[2] - Tmp4<- list(c(Tmp1,Tmp1),Tmp3) - }else{ - Tmp4<- list(Op(I,EL),Tmp3) - } - } - Flg<- 0 - for (J in Looprange(1,Mixlength(PtL))){ - Tmp<- Op(J,PtL) - Tmp<- Op(2,Tmp) - if(Norm(Tmp3-Tmp)<Eps){ - Flg<- 1 - break - } - } - if(Flg==0){ - PtL<- c(PtL,list(Tmp4)) - } - } - } - } - if(Mixlength(PtL)==0){ - return(Out0) - } - PL<- list(Op(1,PtL)) - QL<- PtL[2:Mixlength(PtL)] - N<- Mixlength(QL) - for (I in Looprange(2,N+1)){ - Tmp1<- Op(Mixlength(PL),PL) - Tmp1<- Op(1,Tmp1) - for (J in Looprange(1,Mixlength(QL))){ - Tmp2<- Op(J,QL) - Tmp2<- Op(1,Tmp2) - Flg<- 0 - for (K in Looprange(1,Mixlength(FaceL))){ - Tmp3<- Op(K,FaceL); - if(Member(Tmp1[1],Tmp3) && - Member(Tmp1[2],Tmp3) && - Member(Tmp2[1],Tmp3) && - Member(Tmp2[2],Tmp3)){ - Flg<- 1 - break - } - } - if(Flg==1){ - break - } - } - J<- min(J, Mixlength(QL)) - PL<- c(PL,list(Op(J,QL))) - Tmp1<- QL[Looprange(1,J-1)] - Tmp2<- QL[Looprange(J+1,Mixlength(QL))] - QL<- c(Tmp1,Tmp2) - if(Mixlength(QL)==0){ - break - } - } - PHCUTPOINTL<<- PL - Tmp<- list() - for (J in Looprange(1,Mixlength(PL))){ - Tmp1<- Op(J,PL) - Tmp1<- Op(2,Tmp1) - Tmp<- c(Tmp,list(Tmp1)) - } - Tmp1<- Op(1,PL) - Tmp1<- Op(2,Tmp1) - Tmp<- c(Tmp,list(Tmp1)) - Out2<- Spaceline(Tmp) - Out<- c(Out0,list(Out2)) -} - -######################################### - -Phcutoffdata<- function(...){ - varargin<-list(...) - Eps<- 10^(-4) - Out2<- list() - VL<- varargin[[1]] - FaceL<- varargin[[2]] - PlaneD<- varargin[[3]] - Sgnstr<- varargin[[4]] - Fugou<- 1 - if(Sgnstr=="-" || Sgnstr=="n"){ - Fugou<- -1 - } - Out0<- Phcutdata(VL,FaceL,PlaneD) - PtL<- PHCUTPOINTL - PHVERTEXL<<- VL - PHFACEL<<- FaceL - if(length(PtL)==0){ - Out2<- Out0 - return(Out2) - } - N1<- Mixlength(VL) - Face<- c() - for (I in Looprange(1,Mixlength(PtL))){ - Tmp<- Op(I,PtL) - Tmp3<- Op(1,Tmp) - Tmp1<- Tmp3[[1]]; Tmp2<- Tmp3[[2]] # debugged 10.08.14 - if(Tmp1!=Tmp2){ - VL<- c(VL,list(Op(2,Tmp))) - N1<- N1+1 - Tmp1<- N1 - } - Face<- c(Face,Tmp1) - PtL[[I]]<- list(Op(1,Tmp),Tmp1) - } - OutfL<- list(Face) - if(Mixtype(PlaneD)!=1){ - V1<- Op(1,PlaneD) - Tmp<- Op(2,PlaneD) - if(length(Tmp)>1){ - d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] - }else{ - d<- Tmp - } - }else if(mode(PlaneD)=="numeric"){ - V1<- PlaneD[1:3] - d<- PlaneD[4] - }else{ - StrV<- strsplit(PlaneD,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Tmp1<- StrV[1] - Tmp2<- StrV[2] - PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") - } - x<- 0; y<- 0; z<- 0 - d<- -eval(parse(text=PlaneD)) - x<- 1; y<- 0; z<- 0 - Tmp1<- eval(parse(text=PlaneD))+d - x<- 0; y<- 1; z<- 0 - Tmp2<- eval(parse(text=PlaneD))+d - x<- 0; y<- 0; z<- 1 - Tmp3<- eval(parse(text=PlaneD))+d - V1<- c(Tmp1,Tmp2,Tmp3) - } - for (I in Looprange(1,Mixlength(FaceL))){ - Face<- Op(I,FaceL) - TmpL<- list() - for (J in Looprange(1,length(Face))){ - N1<- Face[J] - if(J==length(Face)){ - N2<- Face[1] - }else{ - N2<- Face[J+1] - } - for (K in Looprange(1,Mixlength(PtL))){ - Pd<- Op(K,PtL) - Tmp<- Op(1,Pd) - if(Tmp[1]==Tmp[2]){ - if(Tmp[1]==N1){ - TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) - } - }else{ - if(all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){ - TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) - } - } - } - } - if(Mixlength(TmpL)<2){ - Flg<- 0 - for (J in Looprange(1,length(Face))){ - Tmp<- Op(Face[J],VL) - Tmp1<- Fugou*(Dotprod(V1,Tmp)-d) - if(Tmp1< -Eps){ - Flg<- 1 - break - } - } - if(Flg==0){ - OutfL<- c(OutfL,list(Face)) - } - next - } - Pd<- Op(1,TmpL) - Qd<- Op(2,TmpL) - Outf1<- c(Op(3,Pd)) - Nf<- Op(1,Pd)+1 - Tmp<- Op(2,Pd) - JJ<- 0 - while (!all(Tmp==Op(2,Qd))){ - JJ<- JJ+1 - if(JJ>20){ - print("bug") - return() - } - Tmp1<- Tmp[2] - if(Outf1[length(Outf1)]!=Tmp1){ - Outf1<- c(Outf1,Tmp1) - } - Tmp<- c(Face[Nf]) - Nf<- Nf+1 - if(Nf>length(Face)){ - Nf<- 1 - } - Tmp<- c(Tmp,Face[Nf]) - } - Tmp1<- Op(3,Qd) - if(Outf1[length(Outf1)]!=Tmp1){ - Outf1<- c(Outf1,Tmp1) - } - Outf2<- c(Op(3,Pd)) - Nf<- Op(1,Pd) - Tmp<- Op(2,Pd) - JJ<- 0 - while (!all(Tmp==Op(2,Qd))){ - JJ<- JJ+1 - if(JJ>20){ - print("bug") - return() - } - Tmp1<- Tmp[1] - if(Outf2[length(Outf2)]!=Tmp1){ - Outf2<- c(Outf2,Tmp1) - } - Tmp<- c(Face[Nf]) - Nf<- Nf-1 - if(Nf<1){ - Nf<- length(Face) - } - Tmp<- c(Face[Nf],Tmp) - } - Tmp1<- Op(3,Qd) - if(Outf2[length(Outf2)]!=Tmp1){ - Outf2<- c(Outf2,Tmp1) - } - if(length(Outf1)<3 || length(Outf2)<3){ - Face<- Outf1 - if(length(Outf1)<length(Outf2)){ - Face<- Outf2 - } - Flg<- 0 - for (J in Looprange(1,length(Face))){ - Tmp<- Op(Face(J),VL) - Tmp1<- Fugou*(Dotprod(V1,Tmp)-d) - if(Tmp1<-Eps){ - Flg<- 1 - break - } - } - if(Flg==0){ - OutfL<- c(OutfL,list(Face)) - } - }else{ - Tmp<- Op(Outf1[2],VL) - Tmp1<- Outf1 - Tmp2<- Fugou*(Dotprod(V1,Tmp)-d) - if(Tmp2<0){ - Tmp1<- Outf2 - } - OutfL<- c(OutfL,list(Tmp1)) - } - } - PHVERTEXL<<- VL - PHFACEL<<- OutfL - Out2<- Phcutdata(VL,OutfL,c(0,0,0,0)) - return(Out2) -} - -####################### - -Phparadata<- function(VL,FaceL){ - Out<- Facesdata(list(VL,FaceL),"para") - return(Out) -} - -#################################### - -Phpersdata<- function(VL,FaceL){ - Out<- Facesdata(list(VL,FaceL),"pers") - return(Out) -} - -#################################### - -Phspersdata<- function(Fdata){ - Out<- Facesdata(Fdata,"pers") - return(Out) -} - -#################################### - -Phsparadata<- function(Fdata){ - Out<- Facesdata(Fdata,"para") - return(Out) -} - -######################### - -#100816 -Projpers<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Flg<- 0 - if(Nargs==1 && Mixtype(varargin[[1]])==1){ - Flg<- 1 - } - CL<- list() - for (N in Looprange(1,Nargs)){ - Crv<- varargin[[N]] - if(Mixtype(Crv)==1){ - Tmp<- CameraCurve(Crv) - CL<- c(CL,list(Tmp)) - }else{ - if(Mixtype(Crv)==3){ - ObjL<- list() - for (I in Looprange(1,Mixlength(Crv))){ - Tmp1<- Op(I,Crv) - if(Mixtype(Tmp1)==1){ - ObjL<- c(ObjL,list(Tmp1)) - }else{ - ObjL<- c(ObjL,Tmp1) - } - } - Crv<- ObjL - } - for (J in Looprange(1,Mixlength(Crv))){ - Tmp<- CameraCurve(Op(J,Crv)) - CL<- c(CL,list(Tmp)) - } - } - } - if(Mixlength(CL)==1 && Flg==1){ - CL<- Op(1,CL) - } - return(CL) -} - -################################### - -ProjcoordCurve<- function(Curve){ - SP<- sin(PHI); CP<- cos(PHI) - ST<- sin(THETA); CT<- cos(THETA) - Out<- c() - for (J in Looprange(1,Nrow(Curve))){ - P<- Ptcrv(J,Curve) - x<- P[1]; y<- P[2]; z<- P[3] - Xz<- -x*SP+y*CP - Yz<- -x*CP*CT-y*SP*CT+z*ST - Zz<- x*CP*ST+y*SP*ST+z*CT - Out<- c(Out,Xz,Yz,Zz) - } - Out<- matrix(Out,ncol=3,byrow=TRUE) - return(Out) -} - -################################# - -ProjCurve<- function(Curve){ # 2018.02.26 rewritten - AnsL= c() - SP=sin(PHI); CP=cos(PHI) - ST=sin(THETA); CT=cos(THETA) - for(I in Looprange(1,Length(Curve)) ){ - P=Op(I,Curve) - x=P[1]; y=P[2]; z=P[3] - if(x!=Inf){ - Xz=-x*SP+y*CP - Yz= -x*CP*CT-y*SP*CT+z*ST - AnsL=Appendrow(AnsL,c(Xz,Yz)) - Tmp= c(Xz,Yz) - }else{ - AnsL=Appendrow(AnsL,c(Inf,Inf)) - } - } - return(AnsL) -} - -#################################### - -Projpara<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Flg<- 0 - if((Nargs==1)&&(is.numeric(varargin[[1]]))){ - Flg<- 1 - } - CL<- list() - for (N in Looprange(1,Nargs)){ - Crv<- varargin[[N]] - if(is.numeric(Crv)){ - Tmp<- ProjCurve(Crv) - CL<- c(CL,list(Tmp)) - } - else{ - if(is.list(Crv)){ - ObjL<- list() - for (I in Looprange(1,Mixlength(Crv))){ - Tmp1<- Op(I,Crv) - if(is.numeric(Tmp1)){ - ObjL<- c(ObjL,list(Tmp1)) - } - else{ - ObjL<- c(ObjL,Tmp1) - } - } - Crv<- ObjL - } - for (J in Looprange(1,length(Crv))){ - Tmp<- ProjCurve(Op(J,Crv)) - CL<- c(CL,list(Tmp)) - } - } - } - if((length(CL)==1)&&(Flg==1)){ - CL<- Op(1,CL) - } - return(CL) -} - -######################### - -#100816 -Projpers<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Flg<- 0 - if(Nargs==1 && Mixtype(varargin[[1]])==1){ - Flg<- 1 - } - CL<- list() - for (N in Looprange(1,Nargs)){ - Crv<- varargin[[N]] - if(Mixtype(Crv)==1){ - Tmp<- CameraCurve(Crv) - CL<- c(CL,list(Tmp)) - }else{ - if(Mixtype(Crv)==3){ - ObjL<- list() - for (I in Looprange(1,Mixlength(Crv))){ - Tmp1<- Op(I,Crv) - if(Mixtype(Tmp1)==1){ - ObjL<- c(ObjL,list(Tmp1)) - }else{ - ObjL<- c(ObjL,Tmp1) - } - } - Crv<- ObjL - } - for (J in Looprange(1,Mixlength(Crv))){ - Tmp<- CameraCurve(Op(J,Crv)) - CL<- c(CL,list(Tmp)) - } - } - } - if(Mixlength(CL)==1 && Flg==1){ - CL<- Op(1,CL) - } - return(CL) -} - -######################################### -# 11.08.27 -# 14.03.23 Debugged "center" - -Rotate3data<- function(...){ -#Eps=10^(-4) - varargin<-list(...) - Nargs<- length(varargin) - Pd3<- varargin[[1]] - W1<- varargin[[2]] - W2<- varargin[[3]] - C<- c(0,0,0) - if(Nargs>=4){ - C<- varargin[[4]] - } - if(Mixtype(Pd3)==1){ - Pd3<- list(Pd3) - } else if(Mixtype(Pd3)==3){ - Tmp<- list() - for (I in Looprange(1,Mixlength(Pd3))){ - Tmp<- c(Tmp,Op(I,Pd3)) - } - Pd3<- Tmp - } - Out<- list() - for (I in Looprange(1,Mixlength(Pd3))){ - PD<- Op(I,Pd3) - Ans<- c() - for (J in Looprange(1,Nrow(PD))){ - if(is.matrix(PD)){ # 11.08.27 - P<- PD[J,] - } - else{ - P<- PD - } - Tmp<- Rotate3pt(P,W1,W2,C) # 14.03.23 - Ans<- rbind(Ans,Tmp) - } # 11.08.27 - rownames(Ans)<- 1:Nrow(Ans) #10.08.16 - Out<- c(Out,list(Ans)) - } - if(Mixlength(Out)==1){ - Out<- Op(1,Out) - } - return(Out) -} - -####################################### - -Rotate3pt<- function(...){ - varargin<-list(...) - Eps<-10^(-4) - Nargs<-length(varargin) - P<- varargin[[1]] - W1<- varargin[[2]] - W2<- varargin[[3]] - C<- c(0,0,0) - if(Nargs>=4){ - C<- varargin[[4]] - } - if(mode(W2)=="numeric" && length(W2)==1){ - Ct<- cos(W2) - St<- sin(W2) - V3<- 1/Norm(W1)*W1 - if(V3[1]==0){ - Tmp<- c(1,0,0) - }else{ - Tmp<- c(0,1,0) - } - W1<- c(Tmp[2]*V3[3]-Tmp[3]*V3[2], - Tmp[3]*V3[1]-Tmp[1]*V3[3], - Tmp[1]*V3[2]-Tmp[2]*V3[1]) - V1<- 1/Norm(W1)*W1 - V2<- c(V3[2]*V1[3]-V3[3]*V1[2], - V3[3]*V1[1]-V3[1]*V1[3], - V3[1]*V1[2]-V3[2]*V1[1]) - }else{ - Tmp<- c(W1[2]*W2[3]-W1[3]*W2[2], - W1[3]*W2[1]-W1[1]*W2[3], - W1[1]*W2[2]-W1[2]*W2[1]) - if(Norm(Tmp)<Eps){ - Ans<- P - return(Ans) - } - V1<- 1/Norm(W1)*W1 - Ns<- V1[1]*W2[1]+V1[2]*W2[2]+V1[3]*W2[3] - Tmp<- W2-Ns*V1 - V2<- 1/Norm(Tmp)*Tmp - Tmp<- c(V1[2]*V2[3]-V1[3]*V2[2], - V1[3]*V2[1]-V1[1]*V2[3], - V1[1]*V2[2]-V1[2]*V2[1]) - V3<- 1/Norm(Tmp)*Tmp - Ct<- Ns/Norm(W2) - St<- sqrt(1-Ct^2) - } - if(Norm(Tmp)<Eps){ - Ans<- P - return(Ans) - } - V1x<- V1[1]; V1y<- V1[2]; V1z<- V1[3] - V2x<- V2[1]; V2y<- V2[2]; V2z<- V2[3] - V3x<- V3[1]; V3y<- V3[2]; V3z<- V3[3] - if(Mixtype(P)!=1){ - PtL<- P - }else{ - PtL<- list(P) - } - Ans<- list() - for (N in Looprange(1,Mixlength(PtL))){ - P<- Op(N,PtL) - if(P[1]==Inf){ - Ans<- c(Ans,list(c(Inf,Inf,Inf))) - next - } - x<- P[1]-C[1]; y=P[2]-C[2]; z=P[3]-C[3] - Tmp1<- ((V1x*Ct+V2x*St)*V1x+(-V1x*St+V2x*Ct)*V2x+V3x^2)*x - Tmp2<- ((V1x*Ct+V2x*St)*V1y+(-V1x*St+V2x*Ct)*V2y+V3x*V3y)*y - Tmp3<- ((V1x*Ct+V2x*St)*V1z+(-V1x*St+V2x*Ct)*V2z+V3x*V3z)*z - X<- Tmp1+Tmp2+Tmp3 - Tmp1<- ((V1y*Ct+V2y*St)*V1x+(-V1y*St+V2y*Ct)*V2x+V3x*V3y)*x - Tmp2<- ((V1y*Ct+V2y*St)*V1y+(-V1y*St+V2y*Ct)*V2y+V3y^2)*y - Tmp3<- ((V1y*Ct+V2y*St)*V1z+(-V1y*St+V2y*Ct)*V2z+V3y*V3z)*z - Y<- Tmp1+Tmp2+Tmp3 - Tmp1<- ((V1z*Ct+V2z*St)*V1x+(-V1z*St+V2z*Ct)*V2x+V3x*V3z)*x - Tmp2<- ((V1z*Ct+V2z*St)*V1y+(-V1z*St+V2z*Ct)*V2y+V3y*V3z)*y - Tmp3<- ((V1z*Ct+V2z*St)*V1z+(-V1z*St+V2z*Ct)*V2z+V3z^2)*z - Z<- Tmp1+Tmp2+Tmp3 - Ans<- c(Ans,list(C+c(X,Y,Z))) - } - if(Mixlength(Ans)==1){ - Ans<- Op(1,Ans) - } - return(Ans) -} - -###################################### - -Setangle<- function(...){ - Eps<- 10^(-6) - varargin<-list(...) - Nargs<-length(varargin) - if(Nargs==0) { - } - else if(Nargs==1){ - V<- varargin[[1]] - V<- V/Norm(V) - THETA<<- acos(V[3]) - if(abs(sin(THETA))<Eps){ - PHI<<- 0 - } - else{ - PHI<<- acos(V[1]/sin(THETA)) - if(V[2]< -Eps) PHI<<- -PHI - } - } - else{ - PHI<<- varargin[[2]]*pi/180 - THETA<<- varargin[[1]]*pi/180 - } - Out<- paste("theta=",as.character(THETA*180/pi)," phi=", - as.character(PHI*180/pi),sep="") - return (Out) -} - -################################# - -Setpers<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - } - else{ - FocusPoint<<- varargin[[1]] - EyePoint<<- varargin[[2]] - } - F<- as.character(FocusPoint) - E<- as.character(EyePoint) - Out<- paste("Focus = c(",F[1],",",F[2],",",F[3],") , ", - " Eye = c(", E[1],",",E[2],",",E[3],") ",sep="") - return (Out) -} - -################################# - -SetstereoL<- function(R,T,P,H){ - X<- R*sin(T*pi/180)*cos(P*pi/180) - Y<- R*sin(T*pi/180)*sin(P*pi/180) - Z<- R*cos(T*pi/180) - Eye<- c(X+H/2*Y/(X^2+Y^2),Y-H/2*X/(X^2+Y^2),Z) - Out<- Setpers(c(0,0,0),Eye) - return(Out) -} - -################################# - -SetstereoR<- function(R,T,P,H){ - X<- R*sin(T*pi/180)*cos(P*pi/180) - Y<- R*sin(T*pi/180)*sin(P*pi/180) - Z<- R*cos(T*pi/180) - Eye<- c(X-H/2*Y/(X^2+Y^2),Y+H/2*X/(X^2+Y^2),Z) - Out<- Setpers(c(0,0,0),Eye) - return(Out) -} - -############################### - -Sf3data<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - FdL<- Fullformfunc(varargin[[1]]) - F<- Op(1,FdL) - Xf<- Op(2,FdL) - Yf<- Op(3,FdL) - Zf<- Op(4,FdL) - Urg<- Op(5,FdL) - Vrg<- Op(6,FdL) - Str<- strsplit(Urg,"=",fixed=TRUE)[[1]] - U<- Str[1] - Tmp<- Str[2] - Tmp<- eval(parse(text=Tmp)) - Umin<- Tmp[1]; Umax<- Tmp[2] - Str<- strsplit(Vrg,"=",fixed=TRUE)[[1]] - V<- Str[1] - Tmp<- Str[2] - Tmp<- eval(parse(text=Tmp)) - Vmin<- Tmp[1]; Vmax<- Tmp[2] - Ndu<- 25 ; Ndv<- 25; Np<- c(50,50) - if(Nargs>=3){ - Ndu<- varargin[[2]] - Ndv<- varargin[[3]] - } - if(Nargs>=4){ - Np<- varargin[[4]] - if(mode(Np)=="numeric" && length(Np)==1){ - Np<- c(Np,Np) - } - } - Du<- (Umax-Umin)/Ndu - Dv<- (Vmax-Vmin)/Ndv - PL <- c()#PL <- [] - Assign("Vmin",Vmin,"Vmax",Vmax) - Trgstr<- Assign("t=c(Vmin,Vmax)") - PL <- list() - for (I in Looprange(0,Ndu)){ - U0 <- paste("(",as.character(Umin+I*Du),")",sep="") - Tmp<- gsub(U,U0,Xf,fixed=TRUE) - Tmp1<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- gsub(U,U0,Yf,fixed=TRUE) - Tmp2<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- gsub(U,U0,Zf,fixed=TRUE) - Tmp3<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")",sep="") - PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[2]))) - PL<- c(PL,list(PD)) - } - Assign("Umin",Umin,"Umax",Umax) - Trgstr<- Assign("t=c(Umin,Umax)") - for (J in Looprange(0,Ndv)){ - V0<- paste("(",as.character(Vmin+J*Dv),")",sep="") - Tmp<- gsub(V,V0,Xf,fixed=TRUE) - Tmp1<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- gsub(V,V0,Yf,fixed=TRUE) - Tmp2<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- gsub(V,V0,Zf,fixed=TRUE) - Tmp3<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")") - PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[1]))) - PL<- c(PL,list(PD)) - } - return(PL) -} - -################################### - -Skeletonparadata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if(Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if(Nargs>3){ - Eps2<- varargin[[4]] - } - Obj2L<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Tmp<- ProjcoordCurve(Op(I,ObjL)) - Obj2L<- c(Obj2L,list(Tmp)) - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- ProjcoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- Makeskeletondata(Obj2L,Plt2L,R,Eps2) - return(Out) -} - -################################ - -Skeletonpara3data<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if(Nargs>2){ - R=R*varargin[[3]] - } - Eps2<- 0.05 - if(Nargs>3){ - Eps2<- varargin[[4]] - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- ProjcoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Obj3<- Op(I,ObjL) - Tmp<- ProjcoordCurve(Obj3) - Data<- Makeskeletondata(list(Tmp),Plt2L,R,Eps2) - for (J in Looprange(1,Mixlength(Data))){ - Gd<- Op(J,Data) - PtD<- c() - for (J in Looprange(1,Nrow(Gd))){ - Tmp<- Ptcrv(J,Gd) - Tmp1<- Invparapt(Tmp,Obj3) - Tmp1<- Op(1,Tmp1) - PtD<- c(PtD,Tmp1) - } - PtD<- matrix(PtD,ncol=3,byrow=TRUE) - Out<- c(Out,list(PtD)) - } - } - return(Out) -} - -################################# - -#100815 -Skeletonpersdata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if(Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if(Nargs>3){ - Eps2<- varargin[[4]] - } - Obj2L<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Tmp<- CameracoordCurve(Op(I,ObjL)) - Obj2L<- c(Obj2L,list(Tmp)) - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- CameracoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- Makeskeletonpersdata(Obj2L,Plt2L,R,Eps2) - return(Out) -} - -##################### -#100815 -Skeletonpers3data<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if(Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if(Nargs>3){ - Eps2<- varargin[[4]] - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- CameracoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Obj3<- Op(I,ObjL) - Tmp<- CameracoordCurve(Obj3) - Data<- Makeskeletonpersdata(list(Tmp),Plt2L,R,Eps2) - for (J in Looprange(1,Mixlength(Data))){ - Gd<- Op(J,Data) - PtD<- c() - for (J in Looprange(1,Nrow(Gd))){ - Tmp<- Gd[J,] - Tmp1<- Invperspt(Tmp,Obj3) - Tmp1<- Op(1,Tmp1) - PtD<- rbind(PtD,Tmp1) - } - Out<- c(Out,list(PtD)) - } - } - return(Out) -} - -################################# - -Spacecurve<- function(...){ - Eps<- 10^(-5) - varargin<-list(...) - Nargs<- length(varargin) - Fnstr<- varargin[[1]] - Rgstr<- varargin[[2]] - Range<- c(0,2*pi) - N<- 50 #Numpoints - E<- c() #Exclusions - D<- Inf #Discont (Changed) - for(I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - StrV<- strsplit(Tmp,"=",fixed=TRUE) - StrV<- StrV[[1]] - Tmp1<- toupper(StrV[1]) - Lhs<- substr(Tmp1,1,1) - Str<- paste(Lhs,"=",StrV[2],sep="") - eval(parse(text=Str)) - } - StrV<- strsplit(Rgstr,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Vname<- StrV[1] - Rng<- eval(parse(text=StrV[2])) - } - else{ - Vname<- Rgstr - Rng<- c(XMIN,XMAX) - } - T1<- Rng[1]; T2<- Rng[2] - Dt<- (T2-T1)/N #17.09.22 - Str<- gsub(Vname,"t",Fnstr) - Str=gsub("[","c(",Str,fixed=TRUE) #17.12.22(2lines) - Str=gsub("]",")",Str,fixed=TRUE) - if(abs(Dt)<Eps){ # 16.12.13 - t=T1 - P=eval(parse(text=Str)) - return(P) - } - P<- c() -# E<- sort(E,decreasing=FALSE) - E<- c(E,Inf) - E<- sort(E,decreasing=FALSE) - Ke<- 1 - for(jj in 1:(N+1)){ - t=T1+(jj-1)*Dt - Pa<- c() - if(t-E[Ke]< Eps){ - Pa<- eval(parse(text=Str)) - } - if(abs(t-E[Ke])<=Eps){ - if(length(P)>0 && P[Nrow(P),1]!=Inf){ - Pa<- c(Inf,Inf,Inf) - } - } - if(t-E[Ke]>Eps){ - Pa<- eval(parse(text=Str)) - Ke<- Ke+1 - } - if(length(Pa)>0){ - if(Pa[1]==Inf){ - P<- rbind(P,Pa) - }else if(length(P)==0){ - P<- rbind(c(),c(Pa)) - } - else{ - Tmp<- P[Nrow(P),] - if(Tmp[1]==Inf){ - P<- rbind(P,Pa) - } - else if( Norm(Tmp-Pa)<D){ - P<- rbind(P,Pa) - } - else{ - P<- rbind(P,c(Inf,Inf,Inf)) - P<- rbind(P,Pa) - } - } - } - } - rownames(P)<- 1:Nrow(P) # 10.08.16 - return(P) -} - -######################################## - -Spaceline<- function(...){ - varargin<- list(...) - Z<- c() - for(I in 1:length(varargin)){ - Data<- varargin[[I]] - if(Mixtype(Data)==1){ - J<- 1 - while (J<=Ncol(Data)){ - Tmp<- Data[J:(J+2)] - Z<-c(Z,Tmp) - J<- J+3 - } - next - } - if(Mixtype(Data)==3){ - Tmp<- list() - for(I in 1:Mixlength(Data)){ - Tmp<- c(Tmp,Op(I,Data)) - } - Data<- Tmp - } - for(J in 1:Mixlength(Data)){ - Tmp<- Op(J,Data) - Z<- c(Z,Tmp) - } - } - Z<- matrix(Z,ncol=3,byrow=TRUE) - return(Z) -} - -################################# - -Translate3data<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Pd3<- varargin[[1]] - Mv<- varargin[[2]] - if(mode(Mv)=="numerice" && length(Mv)==1){ - Mv<- c(varargin[[2]],varargin[[3]],varargin[[4]]) - } - if(Mixtype(Pd3)==1){ - Pd3<- list(Pd3) - } - else if(Mixtype(Pd3)==3){ - Tmp<-list() - for(I in Looprange(1,Mixlength(Pd3))){ - Tmp<- c(Tmp, Op(I,Pd3)) - } - Pd3<- Tmp - } - Out<- list() - for(I in Looprange(1,Mixlength(Pd3))){ - PD<- Op(I,Pd3) - PD<- rbind(c(),PD) - Ans<- c() - for(J in Looprange(1,Nrow(PD))){ - P<- PD[J,] - Tmp<- P+Mv - Ans<- rbind(Ans,Tmp) - } - rownames(Ans)<- 1:Nrow(Ans) - Out<- c(Out,list(Ans)) - } - if(Mixlength(Out)==1){ - Out<- Op(1,Out) - } - return(Out) -} - -############################################### - -Xyzax3data<- function(Xrange,Yrange,Zrange){ - StrV<-strsplit(Xrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1) StrV<- StrV[2] - Tmp<- eval(parse(text=StrV)) - Px<- c(Tmp[1],0,0) - Qx<- c(Tmp[2],0,0) - StrV<-strsplit(Yrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1) StrV<- StrV[2] - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1) StrV<- StrV[2] - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - Out<- list(Spaceline(Px,Qx),Spaceline(Py,Qy),Spaceline(Pz,Qz)) - return(Out) -} - -################################### - -Xyzaxparaname<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10.0^(-6) - Dr<- 0.19*1000/2.54/MilliIn - Tmp<- varargin[[Nargs]] - if(Nargs>1 && is.numeric(Tmp)){ - Dr<- Dr*Tmp - Nargs<- Nargs-1 - } - if(mode(varargin[[1]])=="character"){ - Xname<- "x" - Yname<- "y" - Zname<- "z" - Xrange<- varargin[[1]] - Yrange<- varargin[[2]] - Zrange<- varargin[[3]] - StrV<-strsplit(Xrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Xname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Px<- c(Tmp[1],0,0) - Qx<- c(Tmp[2],0,0) - StrV<-strsplit(Yrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Yname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Zname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - }else{ - Data<- varargin[[1]] - Xname<- "x"; Yname<- "y"; Zname<- "z" - if(Nargs>1){ - if(varargin[[2]]!=""){ - Xname<- varargin[[2]] - } - if(varargin[[3]]!=""){ - Yname<- varargin[[3]] - } - if(varargin[[4]]!=""){ - Zname<- varargin[[4]] - } - } - Tmp<- Op(1,Data) - Px<- Tmp[1,]; Qx<- Tmp[2,] - Tmp<- Op(2,Data) - Py<- Tmp[1,] - Qy<- Tmp[2,] - Tmp<- Op(3,Data) - Pz<- Tmp[1,] - Qz<- Tmp[2,] - } - Ph<- Parapt(Px); Qh<- Parapt(Qx); R<-Norm(Ph-Qh) - Kekka<- list() - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Xname) - } - Ph<- Parapt(Py); Qh<- Parapt(Qy); R<- Norm(Ph-Qh) - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Yname) - } - Ph<- Parapt(Pz); Qh<- Parapt(Qz); R<- Norm(Ph-Qh) - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Zname) - } -# return(Kekka) -} - -################################### - -Xyzaxpersname<- function(...){ - varargin<- list(...) - Eps<- 10.0^(-6) - Nargs<- length(varargin) - Dr<- 0.19*1000/2.54/MilliIn - Tmp<- varargin[[Nargs]] - if(Nargs>1 && mode(Tmp)=="numeric"){ - Dr<- Dr*Tmp - Nargs<- Nargs-1 - } - if(mode(varargin[[1]])=="character"){ - Xname<- "x" - Yname<- "y" - Zname<- "z" - Xrange<- varargin[[1]] - Yrange<- varargin[[2]] - Zrange<- varargin[[3]] - StrV<-strsplit(Xrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Xname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Px<- c(Tmp[1],0,0) - Qx<- c(Tmp[2],0,0) - StrV<-strsplit(Yrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Yname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Zname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - }else{ - Data<- varargin[[1]] - Xname<- "x"; Yname<- "y"; Zname<- "z" - if(Nargs>1){ - if(varargin[[2]]!=""){ - Xname<- varargin[[2]] - } - if(varargin[[3]]!=""){ - Yname<- varargin[[3]] - } - if(varargin[[4]]!=""){ - Zname<- varargin[[4]] - } - } - Tmp<- Op(1,Data) - Px<- Tmp[1,]; Qx<- Tmp[2,] - Tmp<- Op(2,Data) - Py<- Tmp[1,] - Qy<- Tmp[2,] - Tmp<- Op(3,Data) - Pz<- Tmp[1,] - Qz<- Tmp[2,] - } - Ph<- Perspt(Px) - Qh<- Perspt(Qx) - R<- Norm(Ph-Qh) - Kekka<- list() - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Xname) - } - Ph<- Perspt(Py) - Qh<- Perspt(Qy) - R<- Norm(Ph-Qh) - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Yname) - } - Ph<- Perspt(Pz) - Qh<- Perspt(Qz) - R<- Norm(Ph-Qh) - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Zname) - } -# return(Kekka) -} - -######################### -#100815 -Zparapt<- function(P){#function Out=Zparapt(P) - x<- P[1]; y<- P[2]; z<- P[3] - Out<- x*cos(PHI)*sin(THETA)+y*sin(PHI)*sin(THETA)+z*cos(THETA) - return(Out) -} - -######################### -#100815 -Zperspt<- function(P){ - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb - return(X3) -} - -########################################## - - - -########################################## - -# Stat Package - -########################################## - -# 2010.04.12 - -# new - -# Htickmarklower, Vtickmarkleft, HtickmarklowerV -# VtickmarkleftV, Insertcom, Replacecom -# Maketexfile, Formatting -# Drwhistframe, Histplotdata, Drwhistplot - -Htickmarklower<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if(mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if(K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if(is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if(J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if(is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if(is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if(mode(Dt)=="numeric" && length(Dt)>1){ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt) - next - } - if(mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt,GENTEN[2]) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y)) - Tmp2<- Unscaling(c(X,Y-2*MARKLEN)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if(Ndt==3){ - Tmp<-Unscaling(c(X,Y-2*MARKLEN)) - Expr(Tmp,"s",Moji) - } - if(Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("s",Houkou) - if(length(Tmp)>0){ - Tmp<-Unscaling(c(X,Y-2*MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -Vtickmarkleft<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if(mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if(K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if(is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if(J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if(is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if(is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if(mode(Dt)=="numeric" && length(Dt)>1){ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt) - next - } - if(mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(GENTEN[1],Dt) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y)) - Tmp2<- Unscaling(c(X-2*MARKLEN,Y)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if(Ndt==3){ - Tmp<-Unscaling(c(X-2*MARKLEN,Y)) - Expr(Tmp,"w",Moji) - } - if(Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("w",Houkou) - if(length(Tmp)>0){ - Tmp<-Unscaling(c(X-2*MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -HtickmarklowerV<- function(Vec,digits=2,nsmall=2) -{ - for (I in 1:length(Vec)){ - Tmp<- Vec[I] - Htickmarklower(Tmp, Formatting(Tmp,digits,nsmall)) - } -} - -HtickLV<- function(...) -{ - HtickmarklowerV(...) -} - -VtickmarkleftV<- function(Vec,digits=2,nsmall=2) -{ - for (I in 1:length(Vec)){ - Tmp<- Vec[I] - Vtickmarkleft(Tmp, Formatting(Tmp,digits,nsmall)) - } -} - -VtickLV<- function(...) -{ - VtickmarkleftV(...) -} - -Insertcom<- function(CmdM,Npos,Str) -{ - if(is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Out<- c(Out,Str) - Tmp<- Cmd[Looprange(Npos,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if(!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Replacecom<- function(CmdM,Npos,Str) -{ - if(is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Out<- c(Out,Str) - Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if(!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Deletecom<- function(CmdM,Npos) -{ - if(is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if(!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Maketexfile<- function(commands="",texfile="") -{ - Openfile(texfile) - Execmd(commands) - Closefile() -} - -Formatting<- function(X,D=2,N=2) -{ - if(D>0){ - Xs <- format(X,digits=D,nsmall=N) - } - else{ - Xs<- as.character(X) - } - return(Xs) -} - -################################ - -Boxplotdata1 <-function(DataF1,CenterX,Width,...) -{ - Xr <- Width - Temp <- boxplot(DataF1[1],plot=FALSE) - Stats <- Temp$stats - rownames(Stats) <- c("Lhige","Q1","Q2","Q3","Uhige") - Out <- Temp$out - Lhige <- Stats["Lhige",1] - Uhige <- Stats["Uhige",1] - Q1 <- Stats["Q1",1] - Q2 <- Stats["Q2",1] - Q3 <- Stats["Q3",1] - CenterY <- (Q1+Q3)/2 - C <- c(CenterX,CenterY) - V <- c(0,(Q3-Q1)/2) - G1 <- Framedata(C,Xr/2,V[2]) # box - Temp1 <- c(0,Q1-Lhige) - Temp2 <- c(0,Uhige-Q3) - G2 <- Listplot(C-V,C-V-Temp1) # - G3 <- Listplot(C+V,C+V+Temp2) # - Temp3 <- c(Xr/4,0) - G4 <- Listplot(C-V-Temp1-Temp3,C-V-Temp1+Temp3) # - G5 <- Listplot(C+V+Temp2-Temp3,C+V+Temp2+Temp3) # - Temp4 <- c(0,Q3-Q2) - Temp5 <- c(Xr/2,0) - G6 <- Listplot(C+V-Temp4-Temp5,C+V-Temp4+Temp5) # - G7 <- list() - for(j in Looprange(1,length(Out))){ - G7 <- c(G7,list(c(CenterX, Out[j]))) - } - G7 <- G7[order(Out,decreasing=TRUE)] - list(median=G6,box=G1,uwhisker=G2,lwhisker=G3,lwp=G4,uwp=G5,outliers=G7) -} - -Boxplotdata2 <- function(Data,Ratio, ...) -{ - DataF<- Flattenlist(Data) # 11.07.21(from) - ymin<- Inf - ymax<- -Inf - for(J in 1:length(DataF)){ - Tmp<- DataF[[J]] - ymin<- min(ymin, min(Tmp)) - ymax<- max(ymax,max(Tmp)) - } # 11.07.21(upto) - dy <- ymax-ymin - Setwindow(c(0,XMAX-XMIN),c(ymin-0.1*dy,ymax+0.1*dy)) - R1<- (YMAX-YMIN)/(XMAX-XMIN) - R<- Ratio/R1 - Setscaling(R) - Delta <- XMAX/length(DataF) - W <- 0.6*Delta - PdL <- list() - for(i in 1:length(DataF)){ # 11.07.21 - X <- (0.5+i-1)*Delta - G <- Boxplotdata1(DataF[i],X,W,...) - PdL <- c(PdL,list(G)) - } - G <- Framedata() - Tmp<- list(frame=G) - PdL <-c(PdL,list(Tmp)) - Epsi <-0 - Setwindow(c(XMIN-Epsi,XMAX+Epsi),c(YMIN-Epsi,YMAX+Epsi)) - return(PdL) -} - -Drwboxframe<-function(BoxDataL) -{ - Setorigin(c(XMIN,YMIN)) - Tmp<- Unscaling(c(0.2,0.2)) - Setwindow(c(XMIN-0.2,XMAX),c(YMIN-Tmp[2],YMAX)) - Hako<- BoxDataL$plotdata - title<- BoxDataL$title - cap<- BoxDataL$cap - ylab<- BoxDataL$ylab - if(mode(title)!="list") title<- list(title) - if(mode(cap)!="list") cap<- list(cap) - if(mode(ylab)!="list") ylab<- list(ylab) - if(length(title)==0) title<- list("") - if(length(title)==1) title<- c(title, list("n")) - if(length(title)==2) title<- c(title, list("")) - if(length(cap)==0) cap<- list("") - if(length(cap)==1) cap<- c(cap, list("n"),0) # 11.11.27 - if(length(cap)==2) cap<- c(cap, 0) # 11.11.27 - if(length(ylab)==0) ylab<- list("") - if(length(ylab)==1) ylab <- c(ylab, list("n")) - if(length(ylab)==2) ylab<- c(ylab, list("")) - Temp <- Hako[[length(Hako)]] - Drwline(Temp$frame) - Fontsize(cap[[2]]) - for(i in Looprange(1,length(Hako)-1)){ - Temp <- Hako[[i]] - attach(Temp) - Dashline(uwhisker,lwhisker) - Drwline(median,2) - Drwline(box,lwp,uwp) - Drwpt(outliers,0) - X <- uwhisker[1,1] - detach(Temp) - Htickmarklower(X) - if(nchar(cap[[1]])<1) next # 2011.03.08 - if(length(cap)==2 || cap[[3]]==0){ - pos<- 1 - if(length(cap)>=4) pos<- cap[[4]] - Tmp<- paste("s",as.character(pos),sep="") - Letter(c(X,YMIN),Tmp, Op(i,cap[[1]])) - } - else{ - rotate<- cap[[3]] - if(length(cap)==3){ - pos<- 0 - } - else{ - pos<- cap[[4]] - } - Temp1 <- rotate*pi/180 - Temp <- c(cos(Temp1),sin(Temp1)) - Letterrot(c(X,YMIN-pos),Temp,Op(i,cap[[1]])) - } - } - if(nchar(ylab[[1]])>0){ - Fontsize(ylab[[2]]) - Tmp1<- ylab[[1]] - Tmp3<- ylab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c(XMIN, YMAX),"n2",Tmp1) - Fontsize("n") - } - if(nchar(title[[1]])>0){ - Fontsize(title[[2]]) - Tmp1<- title[[1]] - Tmp3<- title[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) - } - Fontsize("n") -} - -Drwboxplot<- function(dataf,var,size, - title=list(""), cap=list(colnames(dataf)), - ylab=list(""), ptsize=5,plot=TRUE,...) - #Return : title,cap,ylab,commands,plotdata,info -{ - Tmp <- boxplot(dataf, plot=FALSE, ...) - Stats <- Tmp$stats - DataF<- Flattenlist(dataf) # 11.07.21(from) - ymin<- Inf - ymax<- -Inf - for(J in 1:length(DataF)){ - Tmp<- DataF[[J]] - ymin<- min(ymin, min(Tmp)) - ymax<- max(ymax,max(Tmp)) - } # 11.07.21(upto) - Hako<- Boxplotdata2(dataf, size[2]/size[1], ...) - if(plot){ - Windisp(Hako) - } - Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) - unit<- paste(Tmp,"cm",sep="") - Setunitlen(unit) - Exstr<- c( - "","", - paste("Beginpicture(","'",unit,"')",sep=""), - paste("Setpt(",as.character(ptsize),")",sep=""), - "","", - paste("Drwboxframe(",var,")",sep=""), - paste("VtickLV(c(",as.character(ymin),",", as.character(ymax),"),0,0)",sep=""), - "","","","", - "Setpt(1)", - "Endpicture(0)" - ) - Exstr<- matrix(Exstr) - Xpos<- c() - for(i in Looprange(1,length(Hako)-1)){ - Temp <- Hako[[i]] - Temp1 <- Temp[[5]] - Xpos <- c(Xpos,Temp1[1,1]) - } - Info<- list(stats=Stats,window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2),xpos=Xpos) - Tmp<- paste(var,"<<- ", - "list(title=title,cap=cap,ylab=ylab,", - "commands=Exstr,plotdata=Hako,info=Info)",sep="") - eval(parse(text=Tmp)) -} - - -########################################### - -Histplotdata <- function(DataV,Ratio,freq=TRUE,densplot=FALSE,...) -# 10.12.07 freq -{ - Temp <- hist(DataV,plot=FALSE,...) - Breaks <- Temp$breaks - Counts <- Temp$counts - Density <- Temp$density - Mids <- Temp$mids - if(!freq){ - Data<- Density - } - else{ - Data<- Counts - } - Ghist <- list() - for(i in Looprange(1,length(Breaks)-1)){ - Tmp1 <- c(Breaks[i],Breaks[i+1]) - Tmp2 <- c(0,Data[i]) - G1 <- Framedata(Tmp1,Tmp2) #bar - Ghist <- c(Ghist,list(G1)) - } - Bin <- Breaks[2]-Breaks[1] - Eps <- 0.7*Bin # 0.7 times Bin - Temp1 <- c(min(Breaks)-Eps,max(Breaks)+Eps) # Put Eps at both sides - Temp2 <- c(0,max(Data)*1.02) - Setwindow(Temp1,Temp2) - Setorigin(c(Temp1[1],0)) - R1<- (YMAX-YMIN)/(XMAX-XMIN) - R<- Ratio/R1 - Setscaling(R) - VEps <- 0.05*(XMAX-XMIN)/5 - Temp1<- Temp1-c(VEps,0) - Temp2<- Temp2-1/R*c(VEps,0) - Setwindow(Temp1,Temp2) - Fpt <- c(Mids[1]-Bin,0) - Lpt <- c(Mids[length(Mids)]+Bin,0) - Fp <- matrix(Fpt,nrow=1) - for(i in Looprange(1,length(Mids))){ - Tmp <- c(Mids[i],Data[i]) - Fp <- rbind(Fp,Tmp) - } - Fp <- rbind(Fp,Lpt) - rownames(Fp)<- c(1:nrow(Fp)) - if(densplot){ - Temp <- density(DataV) - X <- matrix(Temp$x) - Y <- matrix(Temp$y) - Gdens <- cbind(X,Y) - } - else{ - Gdens <- list() - } - list(plotdata=list(histplot=Ghist,fpplot=list(Fp),densityplot=list(Gdens)), - breaks=Breaks,counts=Counts,density=Density,mids=Mids) -} - -Drwhistframe<-function(HistDataL) -{ - title<- HistDataL$title - xlab<- HistDataL$xlab - ylab<- HistDataL$ylab - if(mode(title)!="list") title<- list(title) - if(mode(xlab)!="list") cap<- list(xlab) - if(mode(ylab)!="list") cap<- list(ylab) - if(length(title)==0) title<- list("") - if(length(title)==1) title<- c(title, list("n")) - if(length(title)==2) title<- c(title, list("")) - if(length(xlab)==0) xlab<- list("") - if(length(xlab)==1) xlab<- c(xlab, list("n")) - if(length(xlab)==2) xlab<- c(xlab, list("")) - if(length(xlab)==3) xlab<- c(xlab, list(8)) - if(length(ylab)==0) ylab<- list("") - if(length(ylab)==1) ylab<- c(ylab, list("n")) - if(length(ylab)==2) ylab<- c(ylab, list("")) - if(nchar(title[[1]])>0){ - Fontsize(title[[2]]) - Tmp1<- title[[1]] - Tmp3<- title[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) - Fontsize("n") - } - if(nchar(xlab[[1]])>0){ - Fontsize(xlab[[2]]) - Tmp1<- xlab[[1]] - Tmp3<- xlab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Tmp4<- paste("s",as.character(xlab[[4]]),sep="") - Letter(c((XMIN+XMAX)/2,YMIN),Tmp4,Tmp1) - Fontsize("n") - } - if(nchar(ylab[[1]])>0){ - Fontsize(ylab[[2]]) - Tmp1<- ylab[[1]] - Tmp3<- ylab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Tmp<- Setorigin() - Letter(c(Tmp[1], YMAX),"n2",Tmp1) - Fontsize("n") - } - - Setax(2," ") - Setax(4," ") - Setax(6," ") -} - -Drwhistplot<- function(datav,var,size,freq=TRUE, - title=list(""), xlab=list(""), ylab=list(""), - plot=TRUE,densplot=FALSE,fpplot=TRUE,...) - #Output : title,xlab,ylab,commands,plotdata,info -{ - H <- Histplotdata(datav, size[2]/size[1], freq=freq,densplot=densplot,...) - Pd<- H$plotdata - Ghist <- list(histplot=Pd$histplot,densityplot=Pd$densityplot) # 10.12.07 - if(fpplot){ - Ghist<- c(Ghist,list(fpplot=Pd$fpplot)) - } - if(plot){ - Windisp(Ghist) - } - Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) - unit<- paste(Tmp,"cm",sep="") - Setunitlen(unit) - Infostr<- paste(var,"$info",sep="") - Brkstr<- paste(Infostr,"$breaks",sep="") - Midstr<- paste(Infostr,"$mids",sep="") - if(!freq){ - Digits<- ",2,2" - Denstr<- paste(Infostr,"$density",sep="") - } - else{ - Digits<- ",0,0" - Denstr<- paste(Infostr,"$counts",sep="") - } - - if(fpplot) Prefp<- "" else Prefp<- "#" - Exstr<- c( - "","", - paste("Beginpicture(","'",unit,"')",sep=""), - "","", - paste("Drwhistframe(",var,")",sep=""), - paste("HtickLV(",Midstr,",1,1)",sep=""), - paste("VtickLV(max(",Denstr,")",Digits,")",sep=""), - paste("Drwline(",var,"[['plotdata']]","$histplot)",sep=""), - paste(Prefp,"Dashline(",var,"[['plotdata']]","$fpplot)",sep=""), - paste("#Drwline(",var,"[['plotdata']]","$densityplot,2)",sep=""), - "","","","", - "Endpicture(1)" - ) - Exstr<- matrix(Exstr) - Info<- list(breaks=H$breaks,counts=H$counts,density=H$density,mids=H$mids, - window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2)) - Tmp<- paste(var,"<<- ", - "list(title=title,xlab=xlab,ylab=ylab,", - "commands=Exstr,plotdata=Ghist,info=Info)",sep="") - eval(parse(text=Tmp)) -} - -########################## -#17.09.30 - -Bezierpt<- function(t,Ptlist,Ctrlist){ - if(length(Ptlist)==6){ - P0=Ptlist[1:3] - P3=Ptlist[4:6] - P1=Ctrlist[1:3] - if(length(Ctrlist)==3){ - P2=P3 - flg3=0 - }else{ - P2=Ctrlist[4:6] - flg3=1 - } - }else{ - P0=Ptlist[1:2] - P3=Ptlist[3:4] - P1=Ctrlist[1:2] - if(length(Ctrlist)==2){ - P2=P3 - flg3=0 - }else{ - P2=Ctrlist[3:4] - flg3=1 - } - } - P4=(1-t)*P0+t*P1 - P5=(1-t)*P1+t*P2 - P6=(1-t)*P2+t*P3 - P7=(1-t)*P4+t*P5 - P8=(1-t)*P5+t*P6 - P9=(1-t)*P7+t*P8 - if(flg3==0){ - Out=P7 - }else{ - Out=P9 - } - return(Out) -} - -Bezier<- function(...){ - varargin<- list(...) - Nargs=length(varargin) - Ptlist=varargin[[1]] - Ctrlist=varargin[[2]] - Num=10 - for(J in Looprange(3,Nargs)){ - Tmp=varargin[[J]] - K=strsplit(Tmp,'=',fixe=TRUE) - K=K[[1]] - Tmp1=substring(K[1],1,1) - Lhs=toupper(Tmp1) - if(Lhs=="N"){ - Num=eval(parse(text=K[2])) - } - } - if(length(Num)==1){ - Num=rep(Num,length(Ctrlist)) #17.10.08 - } - Out=c() - for(ii in Looprange(1,length(Ctrlist))){ - Tmp1=c(Ptlist[[ii]],Ptlist[[ii+1]]) - Tmp2=Ctrlist[[ii]] - if(ii==1){ - St=0 - }else{ - St=1 - } - for(J in Looprange(St,Num[ii])){ - Tmp=Bezierpt(J/Num[ii],Tmp1,Tmp2) - Out=Appendrow(Out,Tmp) - } - } - return(Out) -} - -####################### -# 17.10.02 - -Connectseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Pdata=varargin[[1]] - Eps=10^(-4) - if(Nargs>=2){ - Eps=varargin[[2]] - } - if(is.matrix(Pdata)){ - Din=Dataindex(Pdata) - tmp1=list() - for(J in 1:nrow(Din)){ - tmp=Pdata[Din[J,1]:Din[J,2],] - tmp1=c(tmp1,list(tmp)) - } - Pdata=tmp1 - } - PlotL=list(Op(1,Pdata)) - VI=Looprange(2,length(Pdata)) - while(length(VI)>0){ - Qd=Op(Length(PlotL),PlotL) - Ah=Op(1,Qd); Ao=Op(Length(Qd),Qd) - Flg=0 - for(J in 1:length(VI)){ - Tmp1=Op(VI[J],Pdata) - P=Op(1,Tmp1); Q=Op(Length(Tmp1),Tmp1) - if(Norm(P-Ao)<Eps){ - Tmp=Tmp1[Looprange(2,Length(Tmp1)),] - if(Length(Tmp)>0){ - Qd=Appendrow(Qd,Tmp) - } - PlotL[[length(PlotL)]]=Qd - VI=VI[-J] - Flg=1 - break - } - if(Norm(Q-Ao)<Eps){ - Tmp=Tmp1[(nrow(Tmp1)-1):1,] - Qd=Appendrow(Qd,Tmp) - PlotL[[length(PlotL)]]=Qd - VI=VI[-J] - Flg=1 - break - } - if(Norm(P-Ah)<Eps){ - Tmp=Tmp1[2:nrow(Tmp1),] - Qd=Appendrow(Tmp,Qd) - PlotL[[length(PlotL)]]=Qd - VI=VI[-J] - Flg=1 - break - } - if(Norm(Q-Ah)<Eps){ - Tmp=Tmp1[(nrow(Tmp1)-1):1,] - Qd=Appendrow(Tmp,Qd) - PlotL[[length(PlotL)]]=Qd - VI=VI[-J] - Flg=1 - break - } - } - if(Flg==0){ - PlotL=c(PlotL,Pdata[VI[1]]) - VI=VI[-1] - } - } - return(PlotL) -} - -Makevaltable<- function(MS){ - Eps=10^(-6) - Nargs=length(MS) - Fstr=Op(1,MS) - Tmp=Op(2,MS) - Tmp1=strsplit(Tmp,"=",fixed=TRUE) - Tmp1=Tmp1[[1]] - Xname=Tmp1[1] - Xrange=eval(parse(text=Tmp1[2])) - Tmp=Op(3,MS) - Tmp1=strsplit(Tmp,"=",fixed=TRUE) - Tmp1=Tmp1[[1]] - Yname=Tmp1[1] - Yrange=eval(parse(text=Tmp1[2])) - Tmp=gsub(Xname,"x",Fstr) - Fstr=gsub(Yname,"y",Tmp) - Tmp=grep(Xname,Fstr) - if(length(Tmp)==0){ - Fstr=paste(Fstr,'+0*x',sep="") - } - Mdv=50 - Ndv=50 - if(Nargs>=4){ - Tmp=Op(4,MS) - if(Length(Tmp)>1){ #18.02.09 - Mdv=Op(1,Tmp) - Ndv=Op(2,Tmp) - }else{ - Mdv=Tmp - if(Nargs==4){ - Ndv=Mdv - }else{ - Tmp1=Op(5,MS) - if((is.numeric(Tmp1))&&(length(Tmp1)==1)){ - Ndv=Tmp1 - }else{ - Ndv=Mdv - } - } - } - } - X1=Xrange[1]; X2=Xrange[2] - Y1=Yrange[1]; Y2=Yrange[2] - Dx=(X2-X1)/Mdv - Dy=(Y2-Y1)/Ndv - Xval=c() - Tmp=X1 - for(ii in 1:(Mdv+1)){ - Tmp=X1+(ii-1)*Dx - Xval=c(Xval,Tmp) - } - Yval=c() - Tmp=Y1 - for(jj in 1:(Ndv+1)){ - Tmp=Y1+(jj-1)*Dy - Yval=c(Yval,Tmp) - } - Zval=matrix(nrow=Ndv+1,ncol=Mdv+1) - I=1 - for(y in Yval){ - J=1 - for(x in Xval){ - Zval[I,J]=eval(parse(text=Fstr)) - J=J+1 - } - I=I+1 - } - return(list(Zval,Xval,Yval)) -} - -Implicitplot<- function(...){ - varargin=list(...) - Eps0=10^(-4) - Nargs=length(varargin) - Fstr=varargin[[1]] - if(is.list(Fstr)){ - MS=Fstr - Tmp=Makevaltable(MS) - Zval=Tmp[[1]]; Xval=Tmp[[2]]; Yval=Tmp[[3]] - }else if(is.character(Fstr)){ -# MS=list() -# for(I in 1:Nargs){ -# MS=c(MS,varargin[I]) -# } -# Tmp=Makevaltable(MS) - Tmp=Makevaltable(varargin) #18.02.24 - Zval=Tmp[[1]]; Xval=Tmp[[2]]; Yval=Tmp[[3]] - }else{ - Zval=varargin[[1]] - Xval=varargin[[2]] - Yval=varargin[[3]] - } - Out=c() - for(J in Looprange(1,length(Yval)-1)){ - for(I in Looprange(1,length(Xval)-1)){ - a1=Xval[I]; b1=Yval[J]; c1=Zval[J,I] - a2=Xval[I+1]; b2=Yval[J]; c2=Zval[J,I+1] - a3=Xval[I+1]; b3=Yval[J+1]; c3=Zval[J+1,I+1] - a4=Xval[I];b4=Yval[J+1];c4=Zval[J+1,I] - PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) - VL=c(c1,c2,c3,c4,c1) - QL=c() - for(K in 1:4){ - if(abs(VL[K])<=Eps0){ - QL=Appendrow(QL,PL[K,]) - }else if(VL[K]>Eps0){ - if(VL[K+1]< -Eps0){ - Tmp=1/(VL[K]-VL[K+1])*(-VL[K+1]*PL[K,]+VL[K]*PL[K+1,]) - QL=Appendrow(QL,Tmp) - } - }else{ - if(VL[K+1]>Eps0){ - Tmp=1/(-VL[K]+VL[K+1])*(VL[K+1]*PL[K,]-VL[K]*PL[K+1,]) - QL=Appendrow(QL,Tmp) - } - } - } - if(Length(QL)==2){ - Out=Appendrow(Out,c(Inf,Inf)) - Out=Appendrow(Out,QL) - } - } - } - Out=Out[2:nrow(Out),] - if(Length(Out)>0){ - Out=Connectseg(Out) - }else{ - Out=c() - } - return(Out) -} - -######################### -# 17.10.06 - -Deqdata=function(deq,rng,initt,initf,Num){ - Eps=10^(-3) - inf=10^3 - tmp=strsplit(deq,"=")[[1]] - tmp1=gsub("`","",tmp[1],fixed=TRUE) - tmp1=substring(tmp1,3,nchar(tmp1)-1) - Xname=strsplit(tmp1,",")[[1]] - func=tmp[2] - for(J in 1:(length(Xname))){ - tmp1=paste("X[",as.character(J),"]",sep="") - func=gsub(Xname[J],tmp1,func,fixed=TRUE) - } - tmp=strsplit(rng,"=")[[1]] - tname=tmp[1] - tmp=eval(parse(text=tmp[2])) - t1=tmp[1] - t2=tmp[2] - tmp=paste("function(",tname,",X){",func,"}",sep="") - funP=eval(parse(text=tmp)) - tmp=paste("function(",tname,",X){-",func,"}",sep="") - funN=eval(parse(text=tmp)) - dt=(t2-t1)/Num - tt=initt - X0=initf - pdL=c(tt,X0) - for(J in Looprange(1,floor((t2-initt)/dt))){ - kl1=dt*funP(tt,X0) - kl2=dt*funP(tt+dt/2,X0+kl1/2) - kl3=dt*funP(tt+dt/2,X0+kl2/2) - kl4=dt*funP(tt+dt,X0+kl3) - X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 - tt=initt+J*dt - tmp=c(tt,X0) - if(Norm(tmp)>inf){break} - pdL=Appendrow(pdL,tmp) - } - tt=initt - X0=initf - for(J in Looprange(1,floor((initt-t1)/dt))){ - kl1=dt*funN(tt,X0) - kl2=dt*funN(tt+dt/2,X0+kl1/2) - kl3=dt*funN(tt+dt/2,X0+kl2/2) - kl4=dt*funN(tt+dt,X0+kl3) - X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 - tt=initt-J*dt - tmp=c(tt,X0) - if(Norm(tmp)>inf){break} - pdL=Appendrow(tmp,pdL) - } - pdL -} - -Deqplot=function(...){ - varargin=list(...) - deq=varargin[[1]] - rng=varargin[[2]] - initt=varargin[[3]] - initf=varargin[[4]] - Num=50 - Sel=c(1,2) - for(J in Looprange(5,length(varargin))){ - tmp1=varargin[[J]] - if(is.character(tmp1)){ - tmp=strsplit(tmp1,"=")[[1]] - Num=eval(parse(text=tmp[2])) - }else{ - SeL=tmp1 - } - } - pdL=Deqdata(deq,rng,initt,initf,Num) - pdL=pdL[,SeL] -} - - -############## obj ############### - -Openobj<- function(Fnm){ - OBJFMT<<- "%7.4f" - NPOINT<<- 0 - NNORM<<- 0 - OBJSCALE<<- 1 - OBJFIGNO<<- 0 - OBJJOIN<<- 0 - Wfile<<- Fnm - Tmp=grep(".obj",Fnm,fixed=TRUE) - if(length(Tmp)==0){ - if(nchar(Fnm)>0){ - Wfile<<- paste(Fnm,".obj",sep="") - } - } - cat("",file=Wfile,sep="") - Wfile -} - -Closeobj<- function(){ - Wfile="" -} - -Writeobjpoint<- function(P){ - X=sprintf(OBJFMT,P[1]*OBJSCALE) - Y=sprintf(OBJFMT,P[2]*OBJSCALE) - Z=sprintf(OBJFMT,P[3]*OBJSCALE) - Str=paste("v",X,Y,Z,sep=" ") - Printobjstr(Str) - NPOINT<<- NPOINT+1 - return(NPOINT) -} - -Printobjstr<- function(Str){ - cat(Str,"\n",sep="",file=Wfile,append=TRUE) -} - -Objname<- function(){ - if(OBJJOIN==0){ - OBJFIGNO<<- OBJFIGNO+1 - Gname=paste("ketfig",as.character(OBJFIGNO),sep="") - Printobjstr(paste("# ",Gname,sep="")) - Printobjstr(paste("g ",Gname,sep="")) - } -} - -Objjoin<- function(...){ - varargin=list() - if(length(varargin)>0){ - OBJJOIN<<- abs(sign(varargin[[1]])) - } - OBJJOIN -} - -Objsurf<- function(...){ #17.12.18 - Args<- list(...) - Nargs<- length(Args) - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Rf=Args[[1]] - N=2 - Mg=0; Ng=0 - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - U=Args[[N]] - Mg=length(U)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - }else{ - Ag=Args[N]; Bg=Args[N+1] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=grep("=",Tmp0,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1=strsplit(Tmp0,"=") - Tmp0=Tmp1[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - } - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - V=Args[[N]] - Ng=length(V)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - }else{ - Cg=Args[[N]]; Dg=Args[[N+1]] - N=N+2 - } - }else{ # the case of is.character(Args[[N]]) - Tmp0=Args[[N]] - Tmp=grep("=",Tmp0,fixed=TRUE) - if(length(Tmp)>0){ - Tmp2=strsplit(Tmp0,"=") - Tmp0=Tmp2[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - } - if(Mg==0){ - Mg=Args[[N]] - N=N+1 - U=c() - for(J in Looprange(1,Mg+1)){ - U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) - } - } - if(Ng==0){ - Ng=Args[[N]] - V=c() - for(K in Looprange(1,Ng+1)){ - V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) - } - } - Objname() - PL=list() - for(J in Looprange(1,Mg+1)){ - for(K in Looprange(1,Ng+1)){ - P=Rf(U[J],V[K]) - Np=Writeobjpoint(P) - PL=c(PL,list(c(P,Np))) - } - } - Idx=1+(Ng+1)*(0:Mg) - Pus=PL[Idx] - Idx=(Ng+1)*(1:(Mg+1)) - Pue=PL[Idx] - Idx=1:(Ng+1) - Pvs=PL[Idx] - Idx=((Ng+1)*Mg+1):((Ng+1)*(Mg+1)) - Pve=PL[Idx] - Printobjstr("vt 0 0") - Printobjstr("vt 1 0") - Printobjstr("vt 1 1") - Printobjstr("vt 0 1") - for(J in Looprange(1,Mg)){ - for(K in Looprange(1,Ng)){ - P1=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K]])) - P2=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K]])) - P3=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K+1]])) - P4=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K+1]])) - N1=""; N2=""; N3=""; N4="" - if(Sel=="+"){ - Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") - }else{ - Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") - } - Printobjstr(Str) - } - } - list(U,V,Pus,Pue,Pvs,Pve) -} - -Objthicksurf<- function(...){ - Args=list(...) - Nargs=length(Args) - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Selsurf=substring(Sel,1,1) - Selside=c("0","0","0","0") - Tmp=grep("w",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[1]="w" - } - Tmp=grep("e",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[2]="e" - } - Tmp=grep("s",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[3]="s" - } - Tmp=grep("n",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[4]="n" - } - Nfth=Args[[Nargs-2]] - Thick1=Args[[Nargs-1]] - Thick2=Args[[Nargs]] - Nargs=Nargs-3 - Rfth=Args[[1]] - N=2 - Mg=0; Ng=0 - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - U=Args[[N]] - Mg=length(U)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - }else{ - Ag=Args[[N]]; Bg=Args[[N+1]] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=strsplit(Tmp0,"=",fixe=TRUE) - if(length(Tmp)>0){ - Tmp0=Tmp[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - } - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - V=Args[[N]] - Ng=length(V)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - }else{ - Cg=Args[[N]]; Dg=Args[[N+1]] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=strsplit(Tmp0,"=",fixed=TRUE) - if(length(Tmp)>0){ - Tmp0=Tmp[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - } - if(Mg==0){ - Mg=Args[[N]] - N=N+1 - U=c() - for(J in Looprange(1,Mg+1)){ - U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) - } - } - if(Ng==0){ - Ng=Args[[N]] - V=c() - for(K in Looprange(1,Ng+1)){ - V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) - } - } - Objname() - Join=OBJJOIN - OBJJOIN<<- 1 - F1=function(u,v){ - Rfth(u,v)+Thick1*Nfth(u,v) - } - F2=function(u,v){ - Rfth(u,v)+Thick2*Nfth(u,v) - } - Dt1=Objsurf(F1,U,V,Selsurf) - if(Selsurf=="+"){ - Tmp="-" - }else{ - Tmp="+" - } - Dt2=Objsurf(F2,U,V,Tmp); - Out=list(Dt1,Dt2); - - if(Selside[1]!="0"){ - Dt=Objrecs(Op(3,Dt1),Op(3,Dt2),Selside[1]) - Out=c(Out,list(Dt)) - } - if(Selside[2]!="0"){ - Dt=Objrecs(Op(4,Dt1),Op(4,Dt2),Selside[2]) - Out=c(Out,list(Dt)) - } - if(Selside[3]!="0"){ - Dt=Objrecs(Op(5,Dt1),Op(5,Dt2),Selside[3]) - Out=c(Out,list(Dt)) - } - if(Selside[4]!="0"){ - Dt=Objrecs(Op(6,Dt1),Op(6,Dt2),Selside[4]) - Out=c(Out,list(Dt)) - } - OBJJOIN<<- Join -} - -Objrecs<- function(...){ - Eps=10^(-6) - Args=list(...) - Nargs=length(Args) - Tmp=Args[[1]] - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23upto - PL1=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL1=c(PL1,list(Tmp[K,])) - } - } - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Objname() - for(J in Looprange(1,length(PL1))){ - P=PL1[[J]] - if((length(P)<4) || (P[4]==0)){ - Np=Writeobjpoint(P) - PL1[[J]]=c(P[1:3],Np) - } - } - Tmp=Args[[2]] - if((is.numeric(Tmp)) && (length(Tmp)==1)){ - Drv=Tmp - Len=Norm(Drv) - PL2=list() - for(J in Looprange(1,length(PL1))){ - Tmp=PL1[[J]] - P=Tmp[1:3]+Drv - Np=Writeobjpoint(P) - PL2=c(PL2,list(c(P[1:3],Np))) - if(J<length(PL1)){ - Vec=PL1[[J+1]]-PL1[[J]] - if(Norm(Vec)>Eps){ - Tmp1=Crossprod(Drv,Vec) - Tmp2=Crossprod(Tmp1,Vec) - Tmp3=Dotprod(Tmp2,Drv) - if(Tmp3<-Eps){ - Tmp2=-Tmp2 - } - Drv=Len/Norm(Tmp2)*Tmp2 - } - } - } - }else{ - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23upto - PL2=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL2=c(PL2,list(Tmp[K,])) - } - } - for(J in Looprange(1,length(PL2))){ - P=PL2[[J]] - if((length(P)<4) || (P[4]==0)){ - Np=Writeobjpoint(P) - PL2[[J]]=c(P[1:3],Np) - } - } - } - Printobjstr("vt 0 0") - Printobjstr("vt 1 0") - Printobjstr("vt 1 1") - Printobjstr("vt 0 1") - for(J in Looprange(2,length(PL1))){ - P1=sprintf("%1d",Op(4,PL1[[J-1]])) - P2=sprintf("%1d",Op(4,PL2[[J-1]])) - P3=sprintf("%1d",Op(4,PL2[[J]])) - P4=sprintf("%1d",Op(4,PL1[[J]])) - N1=""; N2=""; N3=""; N4="" - if(Sel=="+"){ - Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") - }else{ - Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") - } - Printobjstr(Str) - } - list(PL1,PL2) -} - -Objpolygon<- function(...){ - Eps=10^(-6) - Args=list(...) - Nargs=length(Args) - Tmp=Args[[1]] - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23upto - PL=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL=c(PL,list(Tmp[K,])) - } - } - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Objname() - for(J in Looprange(1,length(PL))){ - P=PL[[J]] - if((length(P)<4) || (P(4)==0)){ - Np=Writeobjpoint(P) - PL[[J]]=c(P[1:3],Np) - } - } - if(Nargs==1){ - Tmp=PL[[1]] - Cen=Tmp[1:3] - Nc=Tmp[4] - }else{ - Tmp=Args[[2]] - if(length(Tmp)==1){ - Tmp1=PL[[Tmp]] - Cen=Tmp1[1:3] - Nc=Tmp[4] - }else{ - Cen=Tmp - Nc=Writeobjpoint(Cen) - } - } - for(J in Looprange(1,length(PL))){ - if(J<length(PL)){ - Je=J+1 - }else{ - Je=1 - } - Pt1=Cen - PLj=PL[[J]]; PLje=PL[[Je]] - Pt2=PLj[1:3]; Pt3=PLje[1:3] - if(Norm(Crossprod(Pt2-Pt1,Pt3-Pt1))<Eps){ - next - } - P1=sprintf("%1d",Nc) - P2=sprintf("%1d",PLj[4]) - P3=sprintf("%1d",PLje[4]) - if(Sel=="+"){ - Str=paste("f",P1,P2,P3,"",sep=" ") - }else{ - Str=paste("f",P1,P3,P2,"",sep=" ") - } - Printobjstr(Str) - } - PL -} - -Objpolyhedron<- function(Vertex,Face){ - OBJFIGNO<<- OBJFIGNO+1 - Ninit=NPOINT - Objname() - for(N in Looprange(1,length(Vertex))){ - P=Vertex[[N]] - Np=Writeobjpoint(P) - Vertex[[N]]=c(P[1:3],Np) - } - for(N in Looprange(1,length(Face))){ - F=Face[[N]]+Ninit - Face[[N]]=F - Str="f" - for(J in Looprange(1,length(F))){ - P=sprintf("%1d",F[J]) - Str=paste(Str,P,sep=" ") - } - Printobjstr(Str) - } - list(Vertex,Face) -} - -Objcurve<- function(...){ - Eps=10^(-6) - Args=list(...) - Nargs=length(Args) - Tmp=Args[[1]] - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23upto - PL=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL=c(PL,list(Tmp[K,])) - } - } - Closed=Norm(PL[[length(PL)]]-PL[[1]])<Eps - Pstr="xy" - Tmp=Args[[Nargs]] - if(is.character(Tmp)){ - Pstr=Tmp - Nargs=Nargs-1 - } - Sz=0.1 - Np=4 - if(Nargs>=2){ - Sz=Args[[2]] - } - if(Nargs>=3){ - Np=Args[[3]] - } - Assign("Sz",Sz) - if(Pstr=="xy"){ - Vz=c(0,0,1) - Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)") - } - if(Pstr=="yz"){ - Vz=c(1,0,0) - Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))") - } - if(Pstr=="zx"){ - Vz=c(0,1,0) - Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))") - } - Gc0=Spacecurve(Fs,"t=c(0,2*pi)",paste("Num=",as.character(Np),sep="")) - P=PL[[1]]; Q=PL[[2]]; R=PL[[length(PL)-1]] - PQ1=Q-P - if(!Closed){ - PQ2=PQ1 - }else{ - PQ2=P-R - } - Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2) - Vp1=Vp/Norm(Vp) - Theta=acos(min(Dotprod(Vz,Vp1),1)); - Vj=Crossprod(Vz,Vp1) - if(Norm(Vj)<Eps){ - Vj=Vz - } - Gc1=Rotate3data(Gc0,Vj,Theta) - CL=list(Translate3data(Gc1,P)) - for(J in Looprange(2,length(PL)-1)){ - P=PL[[J]]; Q=PL[[J+1]] - PQ2=Q-P - if(Norm(PQ2)<Eps){ - next - } - Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2) - Vp2=Vp/Norm(Vp) - Theta=acos(min(Dotprod(Vp1,Vp2),1)) - Vj=Crossprod(Vp1,Vp2) - if(Norm(Vj)<Eps){ - Vj=Vp1 - } - Gc2=Rotate3data(Gc1,Vj,Theta) - CL=c(CL,list(Translate3data(Gc2,P))) - PQ1=PQ2 - Vp1=Vp2 - Gc1=Gc2 - } - if(!Closed){ - Vp2=(Q-P)/Norm(Q-P) - Theta=acos(min(Dotprod(Vp1,Vp2),1)) - Vj=Crossprod(Vp1,Vp2) - if(Norm(Vj)<Eps){ - Vj=Vp1 - } - Gc3=Rotate3data(Gc1,Vj,Theta) - CL=c(CL,list(Translate3data(Gc3,Q))) - } - Objname() - Join=Objjoin(); - Objjoin(1) - GL1=CL[[1]] - for(J in Looprange(2,length(CL))){ - GL2=CL[[J]] - Dt=Objrecs(GL1,GL2,"-") - GL1=Dt[[2]] - if(J==2){ - GL0=Dt[[1]] - } - } - if(!Closed){ - Objpolygon(CL[[1]],"-") - N=length(CL) - Objpolygon(CL[[N]],"+") - }else{ - Objrecs(GL1,GL0,"-") - } - Out=CL - OBJJOIN<<- Join -} - -Objsymb<- function(Symb,Thick,Face,Dir){ - for(J in Looprange(1,length(Symb))){ - Objcurve(Op(J,Symb),Thick,Face,Dir) - } -} - -Symb3data<- function(Moji,Size,Kaiten,NV,Pos){ - if(is.character(Moji)){ - #Tmp=Symbdata(Moji) - # GY1=Tmp(2) - }else{ - GY1=Moji - } - GY1=Scaledata(GY1,Size,Size) - GY1=Rotatedata(GY1,Kaiten*pi/180) - A=NV[1]; B=NV[2]; C=NV[3] - if(A^2+B^2==0){ - E1=c(1,0,0) - E2=c(0,1,0) - }else{ - E1=c(B,-A,0) - E2=c(-A*C,-B*C,A^2+B^2) - Tmp=matrix(c(E1,E2,NV),3,3) - D=det(Tmp) - if(D<0){ - E1=-E1 - } - E1=E1/Norm(E1) - E2=E2/Norm(E2) - } - Em<- function(X,Y){ - c(E1[1]*X+E2[1]*Y,E1[2]*X+E2[2]*Y,E1[3]*X+E2[3]*Y) - } - GY1=Embed(GY1,Em) - GY1=Translate3data(GY1,Pos) - Flattenlist(GY1) -} - -############## New Intersect 18.02.01 ############# - -Intersectline<- function(p1,v1,p2,v2){ - Eps0=10^(-5) - tmp=Dotprod(v1,v2) - tmp1=c(tmp,Norm(v1)^2) - tmp2=c(-Norm(v2)^2,-tmp) - tmp3=c(Dotprod(p2-p1,v2),Dotprod(p2-p1,v1)) - d=Crossprod(tmp1,tmp2) - tmp=abs(Crossprod(v1,v2)) - if(tmp>Eps0){ - dt=Crossprod(tmp3,tmp2) - ds=Crossprod(tmp1,tmp3) - t=dt/d - s=ds/d - pt=p1+v1*t - out=list(pt,t,s) - }else{ - tmp1=Crossprod(p2-p1,v1)/Norm(v1) - out=list(abs(tmp1)) - } - return(out) -} - -Intersectseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps0=10^(-4) - Eps1=0.01 - seg1=varargin[[1]] - seg2=varargin[[2]] - if(Nargs>2){Eps1=varargin[[3]]} - p1=Op(1,seg1); q1=Op(2,seg1) - p2=Op(1,seg2); q2=Op(2,seg2) - if((Norm(q1-p1)<Eps0)||(Norm(q2-p2)<Eps0)){ - out=list(-1) - }else{ - tmp=Intersectline(p1,q1-p1,p2,q2-p2) - if(length(Op(1,tmp))>1){ - pt=Op(1,tmp); t=Op(2,tmp); s=Op(3,tmp) - if((t*(t-1)<Eps0)&&(s*(s-1)<Eps0)){ - out=list(0,pt,t,s) - }else{ - t=min(max(t,0),1) - s=min(max(s,0),1) - tmp3=c(Norm(p1-p2),Norm(p1-q2),Norm(p2-p1),Norm(p2-q1)) - tmp1=c(Op(2,q2-p2),-Op(1,q2-p2)) - tmp=Intersectline(p1,tmp1,p2,q2-p2) - if(length(Op(1,tmp))>1){ - if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){ - tmp3=c(tmp3,Norm(Op(1,tmp)-p1)) - } - } - tmp=Intersectline(q1,tmp1,p2,q2-p2) - if(length(Op(1,tmp))>1){ - if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){ - tmp3=c(tmp3,Norm(Op(1,tmp)-q1)) - } - } - tmp1=c(Op(2,q1-p1),-Op(1,q1-p1)) - tmp=Intersectline(p2,tmp1,p1,q1-p1); - if(length(Op(1,tmp))>1){ - if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){ - tmp3=c(tmp3,Norm(Op(1,tmp)-p2)) - } - } - if(length(Op(1,tmp))>1){ - if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){ - tmp3=c(tmp3,Norm(Op(1,tmp)-q2)) - } - } - out=list(min(tmp3),pt,t,s) - } - }else{ - dist=tmp[[1]] - tmp1=q1-p1 - n=c(tmp1[2],-tmp1[1])/Norm(tmp1) - pts=list() - tmp=Intersectline(p1,n,p2,q2-p2) - if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){ - tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2 - pts=c(pts,list(list(tmp1,0,tmp[[3]]))) - } - tmp=Intersectline(q1,n,p2,q2-p2) - if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){ - tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2 - pts=c(pts,list(list(tmp1,1,tmp[[3]]))) - } - tmp=Intersectline(p2,n,p1,q1-p1) - if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){ - tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1 - pts=c(pts,list(list(tmp1,tmp[[3]],0))) - } - if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){ - tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1 - pts=c(pts,list(list(tmp1,tmp[[3]],2))) - } - if(length(pts)==0){ - tmp1=min(Norm(p2-p1),Norm(q2-p1),Norm(p2-q1),Norm(q2-q1)) - out=list(tmp1) - }else{ - if(dist>Eps1){ - out=list(dist) - }else{ - tmp=c(); - for(j in 1:length(pts)){ - tmp=Appendrow(tmp,Op(1,pts[[j]])) - } - tmp1=sum(tmp[,1])/(length(pts)) - tmp2=sum(tmp[,2])/(length(pts)) - tmp3=c(tmp1,tmp2) - tmp=Nearestpt(tmp3,seg1) - tmp1=tmp[[2]] - tmp=Nearestpt(tmp3,seg2) - tmp2=tmp[[2]] - out=list(dist,tmp3,tmp1,tmp2) - } - } - } - } - return(out) -} - -Osplineseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps=10^(-2) - Eps0=10^(-6) - Ptlist=varargin[[1]] - Numstr="Num=20" - if(Nargs>1){ - Numstr=varargin[[2]] - } - p0=Op(1,Ptlist); p1=Op(2,Ptlist); p2=Op(3,Ptlist); p3=Op(4,Ptlist) - tmp=Norm(p2-p0)*Norm(p3-p1) - tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/tmp)/2) - cc=4*Norm(p2-p1)/3/(Norm(p2-p0)+Norm(p3-p1))/tmp - pQ=p1+cc*(p2-p0) - pR=p2+cc*(p1-p3) - ctrL=list(c(pQ,pR)) - out=Bezier(list(p1,p2),ctrL,Numstr) - return(out) -} - -Intersectpartseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - crv1=varargin[[1]] - crv2=varargin[[2]] - ii=varargin[[3]] - jj=varargin[[4]] - Eps1=varargin[[5]] - Eps2=varargin[[6]] - Dist=10*Eps2 - if(Nargs>6){Dist=varargin[[7]]} - Eps0=10^(-4) - out=list() - seg1=Listplot(Op(ii,crv1),Op(ii+1,crv1)) - seg2=Listplot(Op(jj,crv2),Op(jj+1,crv2)) - tmp1=Op(2,seg1)-Op(1,seg1) - tmp2=Op(2,seg2)-Op(1,seg2) - snang=abs(Crossprod(tmp1,tmp2))/(Norm(tmp1)*Norm(tmp2)) - tmp=Intersectseg(seg1,seg2,Eps1) - dst=Op(1,tmp) - if(dst<Eps0){ - out=list(Op(2,tmp),ii+Op(3,tmp),jj+Op(4,tmp),dst,snang) - }else{ - if(dst<Eps2){ - if((Length(crv1)==2)||(Norm(Op(2,seg1)-Op(1,seg1))>Dist-Eps0)){ - os1=seg1 - }else{ - p1=Op(1,seg1); p2=Op(2,seg1) - if(ii==1){ - p3=Op(3,crv1) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p0=Reflectdata(p3,c((p1+p2)/2,tmp)) - }else{ - if(ii==Length(crv1)-1){ - p0=Op(ii-1,crv1) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p3=Reflectdata(p0,c((p1+p2)/2,tmp)) - }else{ - p0=Op(ii-1,crv1); p3=Op(ii+2,crv1) - } - } - os1=Osplineseg(list(p0,p1,p2,p3)) - } - if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps0)){ - os2=seg2 - }else{ - p1=Op(1,seg2); p2=Op(2,seg2) - if(jj==1){ - p3=Op(3,crv2) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p0=Reflectdata(p3,c((p1+p2)/2,tmp)) - }else{ - if(jj==Length(crv2)-1){ - p0=Op(jj-1,crv2) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p3=Reflectdata(p0,c((p1+p2)/2,tmp)) - }else{ - p0=Op(jj-1,crv2); p3=Op(jj+2,crv2) - } - } - os2=Osplineseg(list(p0,p1,p2,p3)) - } - tmp2=list() - for(kk in Looprange(1,Length(os1)-1)){ - for(ll in Looprange(1,Length(os2)-1)){ - seg1=Listplot(Op(kk,os1),Op(kk+1,os1)) - seg2=Listplot(Op(ll,os2),Op(ll+1,os2)) - tmp=Intersectseg(seg1,seg2,Eps1) - if((Op(1,tmp)<Eps1)&&(length(tmp)>1)){ #18.02.05 - if(Op(1,tmp)<dst+Eps0){ - dst=Op(1,tmp) - tmp3=list() - for( nn in Looprange(1,length(tmp2))){ - if(Op(1,tmp2[[nn]])<dst){ - tmp3=c(tmp3,list(tmp2[[nn]])) - } - } - tmp2=c(tmp3,list(list(dst,Op(2,tmp)))) - } - } - } - } - if(length(tmp2)>0){ - tmp1=c() - for(nn in Looprange(1,length(tmp2))){ - tmp1=Appendrow(tmp1,Op(2,tmp2[[nn]])) - } - tmp=sum(tmp1[,1])/length(tmp2) - tmp=c(tmp,sum(tmp1[,2])/length(tmp2)) - out=list(tmp) - p1=Op(ii,crv1); p2=Op(ii+1,crv1) - tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) - tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) - tmp=min(max(Op(3,tmp),0),1) - out=c(out,list(ii+tmp)) - p1=Op(jj,crv2); p2=Op(jj+1,crv2) - tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) - tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) - tmp=min(max(Op(3,tmp),0),1) - out=c(out,list(jj+tmp,dst,snang)) - } - } - } - return(out) -} - -Collectnear<- function(ptdL,Eps2){ - gL=list(Op(1,ptdL)) - rL=ptdL[Looprange(2,length(ptdL))] #18.02.07 - for( ii in Looprange(1,length(ptdL)-1)){ - numL=c() - for(jj in Looprange(1,length(rL))){ - tmp1=100 - for(kk in Looprange(1,length(gL))){ - tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]])) - if(tmp<tmp1){tmp1=tmp} - } - if(tmp1<Eps2){numL=c(numL,jj)} - } - if(length(numL)==0){ - break - }else{ - gL=c(gL,rL[numL]) #18.02.05 - tmp=setdiff(1:(length(rL)),numL) - rL=rL[tmp] - } - } - return(list(gL,rL)) -} - -Groupnearpt<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps=varargin[[Nargs]] - plist=varargin[[1]] - qlist=varargin[[2]] - if(!is.list(qlist)){ - qlist=plist - plist=list() - } - if(length(qlist)==0){ - return(plist) - } - pt=qlist[[1]] - qlist=qlist[Looprange(2,length(qlist))] - if(length(plist)==0){ - plist=list(matrix(pt,nrow=1)) - }else{ - flg=0 - for(ii in Looprange(1,length(plist))){ - gL=plist[[ii]] - for(jj in Looprange(1,Length(gL))){ - if(Norm(Op(jj,gL)-pt)<Eps){ - flg=1 - break - } - } - if(flg==1){ - plist[[ii]]=Appendrow(gL,pt) - break - } - } - if(flg==0){ - plist=c(plist,list(matrix(pt,nrow=1))) - } - } - out=Groupnearpt(plist,qlist,Eps) - return(out) -} - -IntersectcurvesPp<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps0=10^(-4) - Eps1=0.01 - Eps2=0.05 - Dist=10*Eps2 - if(Nargs>2){Eps1=varargin[[3]]} - if(Nargs>3){Eps2=varargin[[4]]} - if(Nargs>4){Dist=varargin[[5]]} - tmp1=varargin[[1]] - crv1=matrix(Op(1,tmp1),nrow=1) - for(ii in Looprange(2,Length(tmp1))){ - tmp=Op(Length(crv1),crv1) - if(Norm(tmp-Op(ii,tmp1))>Eps0){ - crv1=Appendrow(crv1,Op(ii,tmp1)) - } - } - tmp2=varargin[[2]] - crv2=matrix(Op(1,tmp2),nrow=1) - for(ii in Looprange(2,Length(tmp2))){ - tmp=Op(Length(crv2),crv2) - if(Norm(tmp-Op(ii,tmp2))>Eps0){ - crv2=Appendrow(crv2,Op(ii,tmp2)) - } - } - if(Length(crv1)!=Length(crv2)){ - self=0 - }else{ - self=1 - for(ii in Looprange(1,Length(crv1))){ - if(Norm(Op(ii,crv1)-Op(ii,crv2))>0){ - self=0 - break - } - } - } - out=list() - for(ii in Looprange(1,Length(crv1)-1)){ - if(self==0){ - loopL=Looprange(1,Length(crv2)-1) - }else{ - loopL=Looprange(ii+2,Length(crv2)-1) - } - for(jj in loopL){ - tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist) - if(length(tmp)>1){ #18.02.05 - if(length(out)==0){ - out=list(tmp) - }else{ - tmp1=Op(length(out),out) - if(Norm(Op(1,tmp1)-Op(1,tmp))>Eps1){ - out=c(out,list(tmp)) - } - } - if(self==1){ - tmp=list(Op(1,tmp),Op(3,tmp),Op(2,tmp),Op(4,tmp),Op(5,tmp)) - out=c(out,list(tmp)) - } - } - } - } - tmp2=out - out=list() - tmp1=tmp2 - for(ii in Looprange(1,length(tmp2))){ - tmp=Collectnear(tmp1,Eps2) - out=c(out,list(Op(1,tmp))) - if(length(Op(2,tmp))==0){ - break - }else{ - tmp1=Op(2,tmp) - } - } - for(ii in Looprange(1,length(out))){ - tmp1=Op(ii,out) - if(length(tmp1)==1){ - out[[ii]]=Op(1,tmp1) - }else{ - tmp=c() - for(jj in Looprange(1,length(tmp1))){ - tmp=c(tmp,Op(4,tmp1[[jj]])) - } - dst=min(tmp) - tmp=c() - for(jj in Looprange(1,length(tmp1))){ - if(Op(4,tmp1[[jj]])<dst+Eps0){ - tmp=c(tmp,Op(1,tmp1[[jj]])) - } - } - tmp=matrix(tmp,ncol=2,byrow=TRUE) - tmp=c(sum(tmp[,1]),sum(tmp[,2]))/Length(tmp) - tmp2=list(tmp) - tmp=Nearestpt(Op(1,tmp2),crv1) - tmp2=c(tmp2,list(Op(2,tmp))) - tmp=Nearestpt(Op(1,tmp2),crv2) - tmp2=c(tmp2,list(Op(2,tmp))) - tmp2=c(tmp2,list(list(dst,Op(5,tmp1[[1]])))) - out[[ii]]=tmp2 - } - } - return(out) -} - -Intersectcurves<- function(...){ - dtL=IntersectcurvesPp(...) - out=list() - for(jj in Looprange(1,length(dtL))){ - out=c(out,list(Op(1,dtL[[jj]]))) - } - return(out) -} - -############## end of New Intersect ############# - -############## New Enclosing2 ############# - -Enclosing2<- function(...){ - varargin=list(...) - Nargs=length(varargin) - plist=varargin[[1]] - Eps0=10^(-5) - Eps1=0.01 - Eps2=0.1 - Start=c() - flg=0 - for(ii in Looprange(2,Nargs)){ - tmp=varargin[[ii]] - if(length(tmp)>1){ -# Start=tmp - }else{ - if(flg==0){Eps1=tmp} - if(flg==1){Eps2=tmp} - flg=flg+1 - } - } - flg=0 - AnsL=c() - if(length(plist)==1){ - Fdata=plist[[1]] - tmp1=Op(1,Fdata) - tmp2=Op(Length(Fdata),Fdata) - if(Norm(tmp1-tmp2)<Eps0){ - AnsL=Fdata - }else{ - AnsL=Appendrow(Fdata,tmp1) - } - flg=1 - } - if(flg==0){ - Fdata=Op(1,plist) - Gdata=Op(length(plist),plist) - KL=IntersectcurvesPp(Fdata,Gdata) - if(length(KL)==0){ - tmp1=Op(Length(Gdata),Gdata) - tmp2=Op(1,Fdata) - tmp=Listplot(tmp1,tmp2) - plist=c(plist,list(tmp)) - Start=tmp2 - tst=1 -# flg=1 - }else{ - if(length(KL)==1){ - tmp=Op(1,KL) - tst=Op(2,tmp) - Start=crv(tst,Fdata) - } - if(length(KL)>1){ - KL=Quicksort(KL,2) - if(length(Start)==0){ - tmp=Op(1,KL) - tst=Op(2,tmp) - Start=Pointoncurve(tst,Fdata) - }else{ - tmp=c() - for(ii in Looprange(1,length(KL))){ - tmp=c(tmp,Norm(Op(1,KL[[ii]]-Start))) - } - tmp=min(tmp) - tmp1=list() - for(ii in Looprange(1,length(KL))){ - tmp2=Op(1,KL[[ii]]) - if(Norm(tmp2-Start)==tmp){ - tmp1=c(tmp1,list(tmp2)) - } - } - tmp=Op(1,tmp1) - tst=Op(2,tmp) - Start=Pointoncurve(tst,Fdata) - } - } - } - } - if(flg==0){ - t1=tst - for(nn in Looprange(1,length(plist))){ - Fdata=Op(nn,plist) - if(nn==length(plist)){ - nxtno=1 - }else{ - nxtno=nn+1 - } - Gdata=Op(nxtno,plist) - KL=IntersectcurvesPp(Fdata,Gdata) - if(length(KL)==0){ - tmp=matrix(Op(Length(Fdata),Fdata),nrow=1) #18.02.02from - Gdata=Appendrow(tmp,Gdata) - plist[[nxtno]]=Gdata - t2=Length(Fdata) - ss=1 #18.02.02upto - }else{ - tmp=Op(1,KL) - t2=Op(2,tmp) - ss=Op(3,tmp) - if(abs(t2-t1)<Eps0){ - if(length(KL)>1){ - tmp=Op(2,KL) - t2=Op(2,tmp) - ss=Op(3,tmp) - }else{ -# println(text(nn)+" and "+text(nn+1)+" not intersect"); -# flg=1 - } - } - } - if(flg==0){ - tmp=Partcrv(t1,t2,Fdata) - if(nn==1){ - AnsL=tmp - }else{ - tmp=tmp[2:Length(tmp),] - AnsL=Appendrow(AnsL,tmp) - } - t1=ss - } - } - } - return(AnsL) -} - -############## end of Enclosing2 ############# - -############## start of surface drawing ############# - -Fullformfunc<- function(FdL){ - ADDPOINT<<- list() #18.02.19 - Out=list(Op(1,FdL)) - N=length(FdL) - for(Jrg in Looprange(1,N)){ - Tmp=grep("c(",Op(Jrg,FdL),fixed=TRUE) - if(length(Tmp)>0){ - break - } - } - Urg=Stripblanks(Op(Jrg,FdL)) - Tmp=strsplit(Urg,"=",fixed=TRUE) - UNAME<<- Tmp[[1]][1] - URNG<<- eval(parse(text=Tmp[[1]][2])) - Urg=paste(UNAME,"=c(",sprintf("%6.7f",URNG[1]),",", - sprintf("%6.7f",URNG[2]),")",sep="") - Vrg=Stripblanks(Op(Jrg+1,FdL)) - Tmp=strsplit(Vrg,"=",fixed=TRUE) - VNAME<<- Tmp[[1]][1] - VRNG<<- eval(parse(text=Tmp[[1]][2])) - Vrg=paste(VNAME,"=c(",sprintf("%6.7f",VRNG[1]),",", - sprintf("%6.7f",VRNG[2]),")",sep="") - if(Jrg==2){ - Xf=UNAME - Yf=VNAME - Tmp=Stripblanks(Op(1,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Zf=Tmp[[1]][2] - Tmp=list(UNAME,VNAME,Zf,Urg,Vrg) - Out=c(Out,Tmp) - }else if(Jrg==4){ - Tmp=Stripblanks(Op(1,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Zf=Tmp[[1]][2] - Tmp=Stripblanks(Op(2,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Xname=Tmp[[1]][1] - Xf=Tmp[[1]][2] - Tmp=Stripblanks(Op(3,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Yname=Tmp[[1]][1] - Yf=Tmp[[1]][2] - Tmp=gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) - Zf=gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) - Tmp=list(Xf,Yf,Zf,Urg,Vrg) - Out=c(Out,Tmp) - }else{ - Tmp=Stripblanks(Op(2,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Xf=Tmp[[1]][2] - Tmp=Stripblanks(Op(3,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Yf=Tmp[[1]][2] - Tmp=Stripblanks(Op(4,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Zf=Tmp[[1]][2] - Tmp=list(Xf,Yf,Zf,Urg,Vrg) - Out=c(Out,Tmp) - } - tmp=paste("Xfunc<<- function(",UNAME,",",VNAME,"){",Xf,"}",sep='') - eval(parse(text=tmp)) - tmp=paste("Yfunc<<- function(",UNAME,",",VNAME,"){",Yf,"}",sep='') - eval(parse(text=tmp)) - tmp=paste("Zfunc<<- function(",UNAME,",",VNAME,"){",Zf,"}",sep='') - eval(parse(text=tmp)) - tmp=paste("XYZfunc<<- function(",UNAME,",",VNAME,"){",sep='') - tmp=paste(tmp,"c(",Xf,",",Yf,",",Zf,")}",sep='') - eval(parse(text=tmp)) - XYZstr<<- c(Xf,Yf,Zf) - DRWS<<- "enws" - BdyL=list() - for(I in Looprange(Jrg+2,length(FdL))){ - Tmp=Op(I,FdL) - if(is.character(Tmp)){ - if(nchar(Tmp)==0){ - Tmp=" " - } - DRWS<<- list(Tmp) - } - if((is.numeric(Tmp))&&(Length(Tmp)>1)){ - BdyL=list(Tmp) - } - } - BDYL<<- BdyL - Tmp=c(DRWS,BDYL) - Out=c(Out,Tmp) - return(Out) -} - -Addpoints<- function(ptlist){ - ADDPOINT<<- ptlist -} - -Makexybdy<- function(Np){ - Eps0=10^(-4) - Xystr=XYZstr[1:2] - Umin=URNG[1]; Umax=URNG[2] - Vmin=VRNG[1]; Vmax=VRNG[2] - Cflg=0 - EhL=list() - Tmp=grep("e",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:2){ - Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),Xystr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",VRNG) - Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[2])) - Tmp=Paramplot(Tmp1,Tmp2,Tmp3) - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - EhL=c(EhL,list(Tmp)) - } - Tmp=grep("n",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:2){ - Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),Xystr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",URNG) - Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[1])) - Tmp=Paramplot(Tmp1,Tmp2,Tmp3) - if(Cflg>0){ - Tmp1=Op(length(EhL),EhL) - Tmp=Joincrvs(Tmp1,Tmp) - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - Tmp1=EhL[Looprange(1,length(EhL)-1)] - EhL=c(Tmp1,Tmp) - }else{ - Cflg=0 - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - EhL=c(EhL,list(Tmp)) - } - } - Tmp=grep("w",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:2){ - Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),Xystr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",VRNG) - Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[2])) - Tmp=Paramplot(Tmp1,Tmp2,Tmp3) - if(Cflg>0){ - Tmp1=Op(length(EhL),EhL) - Tmp=Joincrvs(Tmp1,Tmp) - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - Tmp1=EhL[Looprange(1,length(EhL)-1)] - EhL=c(Tmp1,list(Tmp)) - }else{ - Cflg=0 - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - EhL=c(EhL,list(Tmp)) - } - } - Tmp=grep("s",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:2){ - Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),Xystr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",URNG) - Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[1])) - Tmp=Paramplot(Tmp1,Tmp2,Tmp3) - if(Cflg>0){ - Tmp1=Op(length(EhL),EhL) - Tmp=Joincrvs(Tmp1,Tmp) - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp1=EhL[Looprange(1,length(EhL)-1)] - } - Tmp1=EhL[Looprange(1,length(EhL)-1)] - EhL=c(Tmp1,list(Tmp)) - }else{ - Cflg=0 - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - EhL=c(EhL,list(Tmp)) - } - } - return(EhL) -} - -Partitionseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Fig=varargin[[1]] - GL=varargin[[2]]; N=3 - if(!is.list(GL)){GL=list(GL)} #18.02.21 - Eps0=10^(-4) - Eps=0.01 - if(Nargs>2){ - Eps=varargin[[3]] - } - Eps2=0.1 - if(Nargs>3){ - Eps2=varargin[[4]] - } - if(Nargs>4){ - Ns=varargin[[5]] - if(Ns>0){#18.02.21from - Other=Op(Ns,OTHERPARTITION) - }else{ - Other=c() - }#18.02.21upto - }else{ - Ns=1 - Other=c() - } - Npt=Length(Fig) - ParL=c(1,Npt,Other) - for(N in Looprange(max(1,Ns),Length(GL))){ #18.02.21 - G=Op(N,GL) - KouL=IntersectcurvesPp(Fig,G,Eps,Eps2) - Tmp1=c(); Tmp2=c() - for(jj in Looprange(1,length(KouL))){ - tmp=Op(2,KouL[[jj]]) - if((tmp>1+Eps0)&&(tmp<Npt-Eps0)){ - Tmp1=c(Tmp1,tmp) - } - tmp=Op(3,KouL[[jj]]) - if((tmp>1+Eps0)&&(tmp<Length(G)-Eps0)){ - Tmp2=c(Tmp2,tmp) - } - } - ParL=c(ParL,Tmp1) - if((Ns>0)&&(N>Ns)&&(length(Tmp2)>0)){ #18.02.21 - tmp=OTHERPARTITION[[N]] - OTHERPARTITION[[N]]<<- c(tmp,Tmp2) - } - } - tmp1=sort(ParL) - ParL=c() - tmp2=-1 - for(jj in Looprange(1,length(tmp1))){ - tmp=Op(jj,tmp1) - if(abs(tmp-tmp2)>Eps){ - ParL=c(ParL,tmp) - tmp2=tmp - } - } - return(ParL) -} - -Evlptablepara<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Tmp=varargin[[1]] - Mdv=50 - Ndv=50 - if(Nargs>=2){ - Tmp=varargin[[2]] - if(is.list(Tmp)){Tmp=Op(1,Tmp)} - if(length(Tmp)>1){ - Mdv=Tmp[1] - Ndv=Tmp[2] - }else{ - Mdv=Tmp - if(Nargs==2){ - Ndv=Mdv - }else{ - Tmp1=varargin[[3]] - if((is.numeric(Tmp1)) && (length(Tmp1)==1)){ - Ndv=Tmp1 - }else{ - Ndv=Mdv - } - } - } - } - U1=URNG[1]; U2=URNG[2] - V1=VRNG[1]; V2=VRNG[2] - Du=(U2-U1)/(Mdv) - Dv=(V2-V1)/(Ndv) - sph=sprintf("%7.7f",sin(PHI)) - cph=sprintf("%7.7f",cos(PHI)) - sth=sprintf("%7.7f",sin(THETA)) - cth=sprintf("%7.7f",cos(THETA)) - xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="") - tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="") - ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="") - dxu=Diff(xstr,UNAME) - dxv=Diff(xstr,VNAME) - dyu=Diff(ystr,UNAME) - dyv=Diff(ystr,VNAME) - I=1 - Zval=c() - for(jj in 1:(Ndv+1)){ - v=V1+(jj-1)*Dv - ZuL=c() - for(ii in 1:(Mdv+1)){ - u=U1+(ii-1)*Du - tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="") - tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="") - Dxu=Funvalue(dxu,tmp1,tmp2) - Dxv=Funvalue(dxv,tmp1,tmp2) - Dyu=Funvalue(dyu,tmp1,tmp2) - Dyv=Funvalue(dyv,tmp1,tmp2) - Tmp=Dxu*Dyv-Dxv*Dyu - ZuL=c(ZuL,Tmp) - } - Zval=Appendrow(Zval,ZuL) - } - Yval=c() - for(jj in 1:(Ndv+1)){ - v=V1+(jj-1)*Dv - Yval=c(Yval,v) - } - Xval=c() - for(ii in 1:(Mdv+1)){ - u=U1+(ii-1)*Du - Xval=c(Xval,u) - } - return(list(Zval,Xval,Yval)) -} - -Dropnumlistcrv<- function(QdL,Eps){ - Eps0=10^(-4) - if(!is.list(QdL)){ - PdL=list(QdL) - }else{ - PdL=QdL - } - OutL=list() - for(I in Looprange(1,length(PdL))){ - Pd=Op(I,PdL) - PtL=c(1) - P=Op(1,Pd) - for(K in Looprange(2,Length(Pd)-1)){ - if(Norm(P-Op(K,Pd))>Eps){ - PtL=c(PtL,K) - P=Op(K,Pd) - } - } - K=Length(Pd) - if(Norm(P-Op(K,Pd))>Eps){ #18.02.12 eps - PtL=c(PtL,K) - } - if(length(PtL)==1){ - PtL=c() - } - OutL=c(OutL,list(PtL)) - } - return(OutL) -} - -Cuspsplitpara<- function(...){ - varargin=list(...) - Nargs=length(varargin); - Gdxy=varargin[[1]] - if(!is.list(Gdxy)){ - Gdxy=list(Gdxy) - } - Eps0=10^(-4) - Eps=0.01 - if(Nargs>2){Eps=varargin[[2]]} - N=2 - CUSPSPLITPT<<- list() - OutkL=list() - for(Ng in Looprange(1,length(Gdxy))){ - PtxyL=Op(Ng,Gdxy) - PtkL=c() - PthL=c() - for(I in Looprange(1,Length(PtxyL))){ - Tmp=Op(I,PtxyL) - Tmp1=paste(UNAME,'=',sprintf("%7.7f",Tmp[1]),sep="") - eval(parse(text=Tmp1)) - Tmp1=paste(VNAME,'=',sprintf("%7.7f",Tmp[2]),sep="") - eval(parse(text=Tmp1)) - Tmp2=c(eval(parse(text=XYZstr[1]))) - Tmp2=c(Tmp2,eval(parse(text=XYZstr[2]))) - Tmp2=c(Tmp2,eval(parse(text=XYZstr[3]))) - Tmp3=Parapt(Tmp2) - if(I==1){ - PtkL=matrix(Tmp2,nrow=1) - PthL=matrix(Tmp3,nrow=1) - }else{ - Tmp4=Op(Length(PthL),PthL) - if(Norm(Tmp3-Tmp4)>Eps0){ - PtkL=Appendrow(PtkL,Tmp2) - PthL=Appendrow(PthL,Tmp3) - } - } - } - if(Length(PthL)==0){ - return(list()) - } - Ps=Op(1,PthL); Pe=Op(Length(PthL),PthL) - Cflg=0 - if(Norm(Ps-Pe)<Eps){Cflg=1} - CuspL=c() - Cva=cos(10*pi/180) - for(I in Looprange(1,Length(PthL)-1)){ - if(Length(PthL)==2){break} - Tmp=Op(I,PthL) - if(I==1){ - if(Cflg==0){next} - Tmp1=Op(Length(PthL)-1,PthL) - }else{ - Tmp1=Op(I-1,PthL) - } - Tmp2=Op(I+1,PthL) - V1=Tmp-Tmp1 - V2=Tmp2-Tmp - Tmp3=Dotprod(V1,V2)/(Norm(V1)*Norm(V2)) - Cuspflg=0 - if(Tmp3<Cva){ - P=Op(I,PthL) - Kaku=acos(Tmp3)*180/pi - if(Crossprod(V1,V2)<0){ - Kaku=-Kaku - } - Cuspflg=0 - for(J in Looprange(I+1,Length(PthL)-1)){ - if(abs(Kaku)>90){ - Cuspflg=1 - break - } - Q=Op(J,PthL) - if(Norm(P-Q)>Eps){ - break - } - V1=Q-Op(J-1,PthL) - V2=Op(J+1,PthL)-Q - Tmp3=Dotprod(V1,V2)/(norm(V1)*norm(V2)) - Tmp=acos(Tmp3)*180/pi - if(Crossprod(V1,V2)<0){ - Tmp=-Tmp - } - Kaku=Kaku+Tmp - } - if(Cuspflg==1){ - Tmp=trunc((I+J)*0.5) - I=J - if(length(CuspL)==0){ - CuspL=c(Tmp) - }else{ - CuspL=c(CuspL,Tmp) - } - } - } - } - if(Cflg==0){ - CuspL=c(1,CuspL,Length(PthL)) - }else if(length(CuspL)==0){ - CuspL=c(1,Length(PthL)) - }else if(Op(1,CuspL)==1){ - CuspL=c(CuspL,Length(PthL)) - }else{ - Tmp=Op(1,CuspL) - Tmp1=PthL[Tmp:Length(PthL),] - Tmp2=PthL[2:Tmp,] - PthL=Appendrow(Tmp1,Tmp2) - Tmp1=PtkL[Tmp:Length(PthL),] - Tmp2=PtkL[2:Tmp,] - PtkL=Appendrow(Tmp1,Tmp2) - CuspL=CuspL-Tmp+1 - CuspL=c(CuspL,Length(PthL)) - } - if(length(CuspL)==2){ - Tmp4=PthL[Length(PthL),] - if(Length(PtkL)>=2){ - CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4)) - OutkL=c(OutkL,list(PtkL)) - } - next - } - Outk=list() - Is=1 - for(I in Looprange(1,length(CuspL)-1)){ - Tmp1=CuspL[Is]; Tmp2=CuspL[I+1] - Tmp3=Op(Tmp1,PthL); Tmp4=Op(Tmp2,PthL) - if(Norm(Tmp3-Tmp4)>Eps){ - Tmpk=PtkL[Tmp1:Tmp2,] - Outk=c(Outk,list(Tmpk)) - CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4)) - Is=I+1 - } - } - OutkL=c(OutkL,Outk) - } - Tmp1=Dropnumlistcrv(Projpara(OutkL),Eps*0.5) - Tmp=list() - for(I in Looprange(1,length(OutkL))){ - Tmp2=Op(I,OutkL) - Tmp3=Op(I,Tmp1) - Tmp4=c() - for(J in Looprange(1,Length(Tmp3))){ - Tmp5=Op(Tmp3[J],Tmp2) - Tmp4=Appendrow(Tmp4,Tmp5) - } - if(Length(Tmp4)>0){ - Tmp=c(Tmp,list(Tmp4)) - } - } - return(Tmp) -} - -PthiddenQ<- function(PtA,Vec,Uveq,Np,Eps,Eps2){ - Eps0=10^(-4) - Out=c() - Vec=1/Norm(Vec)*Vec - if(length(Np)==1){ - Np=c(Np,Np) - } - Tmp=paste("Eqfun<- function(U,V){",sep='') - if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){ - Vstr=sprintf("%6.6f",Vec) - Pstr=sprintf("%6.6f",PtA) - Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='') - Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='') - }else{ - Tmp=paste(Tmp,"Xfunc(U,V)}",sep='') - } - eval(parse(text=Tmp)) - Dx=(URNG[2]-URNG[1])/Np[1] - Dy=(VRNG[2]-VRNG[1])/Np[2] - for(J in Looprange(1,Np[2])){ ##### - Vval1=VRNG[1]+(J-1)*Dy - Vval2=VRNG[1]+J*Dy - for(I in Looprange(1,Np[1])){ ##### - Uval1=URNG[1]+(I-1)*Dx - Uval2=URNG[1]+I*Dx - Eval11=Eqfun(Uval1,Vval1) - Eval12=Eqfun(Uval1,Vval2) - Eval21=Eqfun(Uval2,Vval1) - Eval22=Eqfun(Uval2,Vval2) - a1=Uval1;b1=Vval1;c1=Eval11 - a2=Uval2;b2=Vval1;c2=Eval21 - a3=Uval2;b3=Vval2;c3=Eval22 - a4=Uval1;b4=Vval2;c4=Eval12 - PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) - VL=c(c1,c2,c3,c4,c1) - QL=c() - for(K in 1:4){ - P1=Op(K,PL); P2=Op(K+1,PL) - M1=Op(K,VL); M2=Op(K+1,VL) - if(abs(M1)<Eps0){ - QL=Appendrow(QL,P1) - next - } - if(abs(M2)<Eps0){ -# QL=Appendrow(QL,P2) - next - } - if((M1> 0) && (M2> 0)){ - next - } - if((M1< 0) && (M2< 0)){ - next - } - Tmp=1/(M1-M2)*(-M2*P1+M1*P2) - QL=Appendrow(QL,Tmp) - } - if(Length(QL)==2){ - Puv1=Op(1,QL); Puv2=Op(2,QL) - Tmp1=Op(1,Puv1) - Tmp2=Op(2,Puv1) - Xv=Xfunc(Tmp1,Tmp2) - Yv=Yfunc(Tmp1,Tmp2) - Zv=Zfunc(Tmp1,Tmp2) - P1=c(Xv,Yv,Zv) - Tmp1=Op(1,Puv2) - Tmp2=Op(2,Puv2) - Xv=Xfunc(Tmp1,Tmp2) - Yv=Yfunc(Tmp1,Tmp2) - Zv=Zfunc(Tmp1,Tmp2) - P2=c(Xv,Yv,Zv) - V1=Vec[1]; V2=Vec[2]; V3=Vec[3] - if(abs(V1)>Eps0){ - M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3] - M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3] - }else if(abs(V2)>Eps0){ - M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3] - M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3] - }else{ - M1=PtA[2]-P1[2] - M2=PtA[2]-P2[2] - } - if(M1*M2>= 0){ - if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ - next - } - if(M1==0){ - Pt=P1; Ptuv=Puv1 - }else{ - Pt=P2; Ptuv=Puv2 - } - }else{ - Pt=1/(M1-M2)*(-M2*P1+M1*P2) - Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2) - } - if(is.character(Uveq)){ - Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='') - Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='') - Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE) - Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE) - Tmp=eval(parse(text=Tmp)) - if(Tmp< -Eps0){ - next - } - } - Tmp1=Crossprod(Pt-PtA,Vec) - if(Norm(Tmp1)<Eps){ #18.02.19 - if(Zparapt(Pt)>Zparapt(PtA)+Eps2){ - return(list(1,Pt,Zparapt(Pt),Zparapt(PtA))) - }else{ - Out=Appendrow(Out,Pt) - } - } - } - } - } - if(Length(Out)==0){ - return(list(0,c())) - } - return(c(list(0,Out))) -} - -Nohiddenpara2<- function (Par,Fk,Uveq,Np,Eps,Eps2){ - Eps0=10^(-4) - Fh=Projpara(Fk) - P1=Ptstart(Fh) - P2=Ptend(Fh) - Csp=CUSPPT - if(!is.list(Csp)){Csp=list(Csp)} - Cspflg=1 - for(I in Looprange(1,length(Csp))){ - Tmp=Op(I,Csp) - if(Norm(Tmp-P1)<Eps0){ - if(Cspflg==1){Cspflg=2} - if(Cspflg==3){Cspflg=6} - next - } - if(Norm(Tmp-P2)<Eps0){ - if(Cspflg==1){Cspflg=3} - if(Cspflg==2){Cspflg=6} - next - } - } - PaL=c() - tmp2=-1 - for(jj in Looprange(1,length(Par)-1)){ - tmp1=Op(jj,Par) - if(abs(tmp1-tmp2)>Eps2){ - PaL=c(PaL,tmp1) - tmp2=tmp1 - } - } - tmp1=PaL[length(PaL)] #18.02.26from - tmp2=Par[length(Par)] - if(abs(tmp1-tmp2)<Eps2){ - PaL[length(PaL)]=tmp2 - }else{ - PaL=c(PaL,tmp2) - } #18.02.26upto - SeL=c() - for(N in Looprange(1,length(PaL)-1)){ - S=(PaL[N]+PaL[N+1])/2 - Tmp=Invparapt(S,Fh,Fk) - PtA=Op(1,Tmp) - PtAp=Parapt(PtA) - Vec=c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)) - Flg=PthiddenQ(PtA,Vec,Uveq,Np,Eps,Eps2) - if(Flg[[1]]==0){ - SeL=c(SeL,N) - } - } - FigL=list() - FigkL=list() - for(I in Looprange(1,length(SeL))){ - Tmp1=Pointoncurve(PaL[SeL[I]],Fh) - Tmp2=Pointoncurve(PaL[SeL[I]+1],Fh) - if(I==1){ - P=Tmp1; SP=PaL[SeL[I]] - Q=Tmp2; SQ=PaL[SeL[I]+1] - }else{ - if(Member(SeL[I]-1,SeL)){ - Q=Tmp2; SQ=PaL[SeL[I]+1] - }else{ - FigL=c(FigL,list(Partcrv(SP,SQ,Fh))) - Tmp3=Invparapt(SP,Fh,Fk) - TP=Op(2,Tmp3) - Tmp3=Invparapt(SQ,Fh,Fk) - TQ=Op(2,Tmp3) - Tmp4=Partcrv3(TP,TQ,Fk) - FigkL=c(FigkL,list(Tmp4)) - P=Tmp1; SP=PaL[SeL[I]] - Q=Tmp2; SQ=PaL[SeL[I]+1] - } - } - } - if(length(SeL)>0){ - if(Norm(P-Q)>Eps0){ #18.02.14 - FigL=c(FigL,list(Partcrv(P,Q,Fh))) - Tmp3=Invparapt(SP,Fh,Fk) - TP=Op(2,Tmp3) - Tmp3=Invparapt(SQ,Fh,Fk) - TQ=Op(2,Tmp3) - FigkL=c(FigkL,list(Partcrv3(TP,TQ,Fk))) - }else{ - FigL=c(FigL,list(Fh)) - FigkL=c(FigkL,list(Fk)) - } - } - Tmp=c() - for(I in Looprange(1,length(PaL)-1)){ - if(!Member(I,SeL)){ - Tmp=c(Tmp,I) - } - } - SeL=Tmp - HIDDENDATA<<- list() - for(I in Looprange(1,length(SeL))){ - Tmp=PaL[SeL[I]] - Tmp1=Pointoncurve(Tmp,Fh) - Tmp=PaL[SeL[I]+1] - Tmp2=Pointoncurve(Tmp,Fh) - if(I==1){ - P=Tmp1; SP=PaL[SeL[I]] - Q=Tmp2; SQ=PaL[SeL[I]+1] - }else{ - if(Member(SeL[I]-1,SeL)){ - Q=Tmp2; SQ=PaL[SeL[I]+1] - }else{ - Tmp=Invparapt(SP,Fh,Fk) - TP=Op(2,Tmp) - Tmp=Invparapt(SQ,Fh,Fk) - TQ=Op(2,Tmp) - HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk))) - P=Tmp1; SP=PaL[SeL[I]] - Q=Tmp2; SQ=PaL[SeL[I]+1] - } - } - } - if(length(SeL)>0){ - if(Norm(P-Q)>Eps0){ #18.02.14 - Tmp=Invparapt(SP,Fh,Fk) - TP=Op(2,Tmp) - Tmp=Invparapt(SQ,Fh,Fk) - TQ=Op(2,Tmp) - HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk))) - }else{ - HIDDENDATA<<- c(HIDDENDATA,list(Fk)) - } - } - return(FigkL) -} - -Borderparadata<- function(...){ - varargin=list(...) - Nargs=length(varargin) - FkL=varargin[[1]] - Np=c(50,50) - Eps=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(2,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps=tmp} - if(ctr==2){Eps2=tmp} - } - } - Umin=URNG[1]; Umax=URNG[2] - Vmin=VRNG[1]; Vmax=VRNG[2] - EkL=list() - Tmp=grep("e",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:3){ - Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),XYZstr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",VRNG) - Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[2]),sep="") - Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) - EkL=c(EkL,list(Tmp)) - } - Tmp=grep("n",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:3){ - Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),XYZstr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",URNG) - Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[1]),sep="") - Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) - EkL=c(EkL,list(Tmp)) - } - Tmp=grep("w",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:3){ - Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),XYZstr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",VRNG) - Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[2])) - Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) - EkL=c(EkL,list(Tmp)) - } - Tmp=grep("s",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:3){ - Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),XYZstr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",URNG) - Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[1])) - Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) - EkL=c(EkL,list(Tmp)) - } - if(length(EkL)>0){ - FkL=c(FkL,EkL) - } - Fall=Projpara(FkL) - if(is.numeric(Fall)){ - Fall=list(Fall) - } - Fbdxy=Makexybdy(Np) - BORDERPT<<- list() - Tmp1=list() - for(I in Looprange(1,length(Fall))){ - Tmp1=c(Tmp1,list(c())) - } - OTHERPARTITION<<- Tmp1 - FsL=list() - BORDERHIDDENDATA<<- list() - starttime=proc.time() - for(I in Looprange(1,length(FkL))){ - Tmp=Op(I,FkL) - Tmp=Projpara(Tmp) - Par=Partitionseg(Tmp,Fall,Eps,Eps2,I) - Tmp1=Op(I,FkL) - Tmp=Nohiddenpara2(Par,Tmp1,1,Np,Eps,Eps2) - if(length(HIDDENDATA)>0){ - BORDERHIDDENDATA<<- c(BORDERHIDDENDATA,HIDDENDATA) - } - if(length(Tmp)>0){ - FsL=c(FsL,Tmp) - } - Tmp=paste('Border',formatC(I,width=2,flag="0"),'/',sep='') - Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') - Tmp1=proc.time()-starttime - print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) - } - return(FsL) -} - -Sfbdparadata<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Fd=varargin[[1]] - FdL=Fullformfunc(Fd) - Np=c(50,50) - Eps=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(2,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps=tmp} - if(ctr==2){Eps2=tmp} - } - } - starttime=proc.time() - tmp=Evlptablepara(Np) - Zval=tmp[[1]]; Xval=tmp[[2]]; Yval=tmp[[3]] - Out3=Implicitplot(Zval,Xval,Yval) - tmp3=list() - for(jj in Looprange(1,length(Out3))){ - tmp1=Op(jj,Out3) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) - } - Nlist=Dropnumlistcrv(tmp2,Eps) - Nlist=Nlist[[1]] - tmp=c() - for(kk in Looprange(1,length(Nlist))){ - tmp=Appendrow(tmp,Op(Nlist[kk],tmp1)) #18.02.18 - } - if(Length(tmp)>0){ - tmp3=c(tmp3,list(tmp)) - } - } - Out3=tmp3 - IMPLICITDATA<<- Out3 - Tmp=proc.time()-starttime - print(paste('ImplicitData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep='')) - starttime=proc.time() - Out4=Cuspsplitpara(Out3,Eps) - CUSPDATA<<- Out4 - CUSPPT<<- CUSPSPLITPT - Tmp=proc.time()-starttime - print(paste('CuspData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep='')) - Out5=Borderparadata(Out4,Np,Eps,Eps2) - return(Out5) -} - -Meetpoints<- function(PtA,PtB,Uveq,Np,Eps){ - Eps0=10^(-4) - Vec=PtB-PtA - if(Norm(Vec)<Eps0){return(list())} #18.02.24 - Out=list() - Vec=1/Norm(Vec)*Vec - if(length(Np)==1){ - Np=c(Np,Np) - } - Tmp=paste("Eqfun<- function(U,V){",sep='') - if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){ - Vstr=sprintf("%6.6f",Vec) - Pstr=sprintf("%6.6f",PtA) - Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='') - Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='') - }else{ - Tmp=paste(Tmp,"Xfunc(U,V)}",sep='') - } - eval(parse(text=Tmp)) - Dx=(URNG[2]-URNG[1])/Np[1] - Dy=(VRNG[2]-VRNG[1])/Np[2] - for(J in Looprange(1,Np[2])){ ##### - Vval1=VRNG[1]+(J-1)*Dy - Vval2=VRNG[1]+J*Dy - for(I in Looprange(1,Np[1])){ ##### - Uval1=URNG[1]+(I-1)*Dx - Uval2=URNG[1]+I*Dx - Eval11=Eqfun(Uval1,Vval1) - Eval12=Eqfun(Uval1,Vval2) - Eval21=Eqfun(Uval2,Vval1) - Eval22=Eqfun(Uval2,Vval2) - a1=Uval1;b1=Vval1;c1=Eval11 - a2=Uval2;b2=Vval1;c2=Eval21 - a3=Uval2;b3=Vval2;c3=Eval22 - a4=Uval1;b4=Vval2;c4=Eval12 - PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) - VL=c(c1,c2,c3,c4,c1) - QL=c() - for(K in 1:4){ - P1=Op(K,PL); P2=Op(K+1,PL) - M1=Op(K,VL); M2=Op(K+1,VL) - if(abs(M1)<Eps0){ - QL=Appendrow(QL,P1) - next - } - if(abs(M2)<Eps0){ -# QL=Appendrow(QL,P2) - next - } - if((M1> 0) && (M2> 0)){ - next - } - if((M1< 0) && (M2< 0)){ - next - } - Tmp=1/(M1-M2)*(-M2*P1+M1*P2) - QL=Appendrow(QL,Tmp) - } - if(Length(QL)==2){ - Puv1=Op(1,QL); Puv2=Op(2,QL) - Tmp1=Op(1,Puv1) - Tmp2=Op(2,Puv1) - Xv=Xfunc(Tmp1,Tmp2) - Yv=Yfunc(Tmp1,Tmp2) - Zv=Zfunc(Tmp1,Tmp2) - P1=c(Xv,Yv,Zv) - Tmp1=Op(1,Puv2) - Tmp2=Op(2,Puv2) - Xv=Xfunc(Tmp1,Tmp2) - Yv=Yfunc(Tmp1,Tmp2) - Zv=Zfunc(Tmp1,Tmp2) - P2=c(Xv,Yv,Zv) - V1=Vec[1]; V2=Vec[2]; V3=Vec[3] - if(abs(V1)>Eps0){ - M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3] - M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3] - }else if(abs(V2)>Eps0){ - M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3] - M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3] - }else{ - M1=PtA[2]-P1[2] - M2=PtA[2]-P2[2] - } - if(M1*M2>= 0){ #18.02.21 - if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ - next - } - if(M1==0){ - Pt=P1; Ptuv=Puv1 - }else{ - Pt=P2; Ptuv=Puv2 - } - }else{ - Pt=1/(M1-M2)*(-M2*P1+M1*P2) - Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2) - } - if(is.character(Uveq)){ - Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='') - Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='') - Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE) - Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE) - Tmp=eval(parse(text=Tmp)) - if(Tmp< -Eps0){ - next - } - } - Tmp1=Crossprod(Pt-PtA,Vec) - if(Norm(Tmp1)<Eps){ #18.02.19 - Tmp1=Dotprod(Pt-PtA,Vec) #18.02.21 - if((Tmp1>-Eps0)&&(Tmp1<Norm(PtB-PtA)+Eps0)){ - Out=c(Out,list(Pt)) - } - } - } - } - } - tmp1=Groupnearpt(Out,Eps) - Out=list() - for(jj in Looprange(1,length(tmp1))){ - tmp=Op(jj,tmp1) - tmp=c(sum(tmp[,1]),sum(tmp[,2]),sum(tmp[,3]))/Length(tmp) - Out=c(Out,list(tmp)) - } - return(Out) -} - -Clipindomain<- function(ObjL,FigL){ - Eps0=10^(-4) - Eps1=0.01 - Eps2=0.05 - Bdy=Kyoukai(FigL) - if(length(Bdy)>=2){ - Fbdy=Joincrvs(FigL) - }else{ - Fbdy=Op(1,FigL) - } - if(!is.list(ObjL)){ - ObjL=list(ObjL) - } - if(!is.list(FigL)){ - FigL=list(FigL) - } - OutL=list() - for(Nobj in Looprange(1,length(ObjL))){ - Obj=Op(Nobj,ObjL) - ParL=c(1,Length(Obj)) - Tmp=IntersectcurvesPp(Obj,Fbdy,Eps1,Eps2) - for(J in Looprange(1,length(Tmp))){ - Tmp1=Op(J,Tmp) - ParL=c(ParL,Op(2,Tmp1)) - } - ParL=sort(ParL) - Tmp=c(1) - for(I in Looprange(1,length(ParL))){ - Tmp1=Op(length(Tmp),Tmp) - Tmp2=ParL[I] - if(Tmp2-Tmp1>Eps0){ - Tmp=c(Tmp,Tmp2) - } - } - ParL=Tmp - Tmp1=Op(length(ParL),ParL) - Tmp2=Length(Obj) - if(abs(Tmp1-Tmp2)<Eps){ - ParL=c(ParL[Looprange(1,length(ParL)-1)],Tmp2) - } - Fig=list() - for(N in Looprange(1,length(ParL)-1)){ - Tmp=(ParL[N]+ParL[N+1])*0.5 - Tmp=Pointoncurve(Tmp,Obj) - Tmp=Naigai(Tmp,Bdy) - Tmp1=sum(Tmp)%%2 - if(Tmp1==0){ - next - } - Fig=c(Fig,list(Partcrv(ParL[N],ParL[N+1],Obj))) - } - OutL=c(OutL,Fig) - } - return(OutL) -} - -Crvsfparadata<- function(...){ - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - Sepflg=0 - Tmp=varargin[[Nargs]] - if((is.numeric(Tmp))&&(Tmp<=0)){ - Sepflg=1 - Nargs=Nargs-1 - } - Fk=varargin[[1]] - if(!is.list(Fk)){ - FkL=list(Fk) - }else{ - FkL=Fk - } - Fbdy=Projpara(varargin[[2]]) - Fd=varargin[[3]]; - Fullformfunc(Fd) #18.02.17 - Np=c(50,50) - Eps=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(4,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps=tmp} - if(ctr==2){Eps2=tmp} - } - } - Out=list() - CRVSFHIDDENDATA<<- list() - for(Nn in Looprange(1,length(FkL))){ - Fk=Op(Nn,FkL) - Tmp=Projpara(Fk) - Par=Partitionseg(Tmp,Fbdy,Eps,Eps2,0) - if(Sepflg==0){ - for(I in Looprange(1,Length(Fk)-1)){ - Pa=Op(I,Fk) - Pb=Op(I+1,Fk) - PtL=Meetpoints(Pa,Pb,1,Np,Eps) - for(J in Looprange(1,Length(PtL))){ - Tmp=Op(J,PtL) - Tmp=Parapt(Tmp) - Tmp1=Paramoncurve(Tmp,I,Projpara(Fk)) - Tmp2=min(abs(Par-Tmp1)) - if(Tmp2*Norm(Parapt(Pb-Pa))>Eps) { - Par=c(Par,Tmp1) - } - } - Par=sort(Par) - } - } - for(jj in Looprange(1,length(ADDPOINT))){ #18.02.19from - tmp=Parapt(Op(jj,ADDPOINT)) - tmp=Nearestpt(tmp,Projpara(Fk)) - if(tmp[[3]]<Eps){ - Par=c(Par,tmp[[2]]) - } - } #18.02.19upto - tmp1=sort(Par) - Par=c() - tmp2=-1 - for(jj in Looprange(1,length(tmp1))){ - tmp=Op(jj,tmp1) - if(abs(tmp-tmp2)>Eps){ - Par=c(Par,tmp) - tmp2=tmp - } - } - Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps,Eps2) - Out=c(Out,Tmp1) - CRVSFHIDDENDATA<<- c(CRVSFHIDDENDATA,HIDDENDATA) - Tmp=paste('Crvsfdata',formatC(Nn,width=2,flag="0"),'/',sep='') - Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') - Tmp1=proc.time()-starttime - print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) - } - return(Out) -} - -Crv3onsfparadata<- function(...){ - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - Fk=varargin[[1]] - if(!is.list(Fk)){ - FkL=list(Fk) - }else{ - FkL=Fk - } - Fbdy=Projpara(varargin[[2]]) - Fd=varargin[[3]] - Fullformfunc(Fd) #18.02.17 - Np=c(50,50) - Eps=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(4,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps=tmp} - if(ctr==2){Eps2=tmp} - } - } - Out=list() - CRVONSFHIDDENDATA<<- list() - for(Nn in Looprange(1,length(FkL))){ - Fk=Op(Nn,FkL) - Tmp=Projpara(Fk) - Par=Partitionseg(Tmp,Fbdy,Eps,Eps2,0) - for(jj in Looprange(1,length(ADDPOINT))){ - tmp=Parapt(Op(jj,ADDPOINT)) - tmp=Nearestpt(tmp,Projpara(Fk)) - if(tmp[[3]]<Eps){ - Par=c(Par,tmp[[2]]) - } - } - Par=sort(Par) - Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps,Eps2) - Out=c(Out,Tmp1) - CRVONSFHIDDENDATA<<- c(CRVONSFHIDDENDATA,HIDDENDATA) - Tmp=paste('Crvonsfdata',formatC(Nn,width=2,flag="0"),'/',sep='') - Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') - Tmp1=proc.time()-starttime - print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) - } - return(Out) -} - -Crvonsfparadata<- function(...){ - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - Fuv=varargin[[1]] - Fbdy3=varargin[[2]] - Fd=varargin[[3]] - Fullformfunc(Fd) - if(!is.list(Fuv)){ - Fuv=list(Fuv) - } - FkL=list() - for(jj in Looprange(1,length(Fuv))){ - tmp1=Op(jj,Fuv) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) - } - FkL=c(FkL,list(tmp2)) - } - Np=c(50,50) - Eps=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(4,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps=tmp} - if(ctr==2){Eps2=tmp} - } - } - Out=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2) - return(Out) -} - -Wireparadata<- function(...){ - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - Fbdy3=varargin[[1]] - Fd=varargin[[2]] - FdL=Fullformfunc(Fd) - DuL=varargin[[3]] - DvL=varargin[[4]] - Np=c(50,50) - Eps=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(5,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps=tmp} - if(ctr==2){Eps2=tmp} - } - } - if(is.numeric(DuL)){ - tmp1=DuL - DuL=list() - for(jj in Looprange(1,tmp1)){ - tmp=jj*(URNG[2]-URNG[1])/(tmp1+1) - DuL=c(DuL,list(tmp)) - } - } - if(is.numeric(DvL)){ - tmp1=DvL - DvL=list() - for(jj in Looprange(1,tmp1)){ - tmp=jj*(VRNG[2]-VRNG[1])/(tmp1+1) - DvL=c(DvL,list(tmp)) - } - } - Fuv=list() - for(jj in Looprange(1,length(DuL))){ - tmp1=paste("c(",as.character(Op(jj,DuL)),",",VNAME,")",sep="") - tmp2=paste("N=",as.character(Np[2]),sep="") - tmp1=Paramplot(tmp1,Op(6,FdL),tmp2) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,tmp) - } - Fuv=c(Fuv,list(tmp2)) - } - FkL=list() - for(jj in Looprange(1,length(Fuv))){ - tmp1=Op(jj,Fuv) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) - } - FkL=c(FkL,list(tmp2)) - } - Tmp1=proc.time()-starttime - cat(UNAME,"direction started","\n") - Out1=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2) - WIREHIDDENDATA<<- CRVONSFHIDDENDATA - Fuv=list() - for(jj in Looprange(1,length(DvL))){ - tmp1=paste("c(",UNAME,",",as.character(Op(jj,DvL)),")",sep="") - tmp2=paste("N=",as.character(Np[2]),sep="") - tmp1=Paramplot(tmp1,Op(5,FdL),tmp2) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,tmp) - } - Fuv=c(Fuv,list(tmp2)) - } - FkL=list() - for(jj in Looprange(1,length(Fuv))){ - tmp1=Op(jj,Fuv) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) - } - FkL=c(FkL,list(tmp2)) - } - cat(VNAME,"direction started","\n") - Out2=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2) - WIREHIDDENDATA<<- c(WIREHIDDENDATA, CRVONSFHIDDENDATA) - Out=c(Out1,Out2) - return(Out) -} - -Intersectcrvsf<- function(...){ - # bdyeq is the equation of boundary f(x,y,z) =0 - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - crv=varargin[[1]] - Fd=varargin[[2]] - Fullformfunc(Fd) - bdyflg=0 - bdyeq=varargin[[Nargs]] - if(is.character(bdyeq)){ - Nargs=Nargs-1 - bdyflg=1 - tmp=strsplit(bdyeq,"=",fixed=TRUE) - tmp=tmp[[1]] - if(length(tmp)>1){ - bdyeq=paste("(",tmp[1],")-(",tmp[2],")",sep="") - } - tmp=paste("bdyeq<- function(P){x=P[1];y=P[2];z=P[3];",bdyeq,"}",sep="") - eval(parse(text=tmp)) - } - Eps0=10^(-4) - Np=c(50,50) - Eps=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(3,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps=tmp} - if(ctr==2){Eps2=tmp} - } - } - PtL=list() - for(I in Looprange(1,Length(crv)-1)){ - Pa=Op(I,crv) - Pb=Op(I+1,crv) - if(bdyflg==0){ - tmp=Meetpoints(Pa,Pb,1,Np,Eps) - }else{ - M1=bdyeq(Pa); M2=bdyeq(Pb) - if(M1*M2>= 0){ #18.02.21 - if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ - next - } - if(M1==0){ - tmp=list(Pa) - }else{ - tmp=list(Pb) - } - }else{ - while(Norm(Pb-Pa)>Eps0){ - if(bdyeq(Pa)==0){ - tmp=list(Pa) - break - } - if(bdyeq(Pa)*bdyeq((Pa+Pb)/2)>0){ - Pa=(Pa+Pb)/2 - }else{ - Pb=(Pa+Pb)/2 - } - } - tmp=list(1/(M1-M2)*(-M2*Pa+M1*Pb)) - } - } - PtL=c(PtL,tmp) - } - Tmp=paste('Intersectcrvsf obtained : Time =',sep='') - Tmp1=proc.time()-starttime - print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) - return(PtL) -} - -Sfcutparadata<- function(...){ - varargin=list(...) - Nargs=length(varargin) - CutD=varargin[[1]] - Fbdy3=varargin[[2]] - Fd=varargin[[3]] - FdL=Fullformfunc(Fd) - Np=c(50,50) - Eps0=10^(-4) - Eps=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(4,Nargs)){ - Tmp=varargin[[jj]] - if((length(Tmp)>1)||(Tmp>1)){ - Np=Tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps=Tmp} - if(ctr==2){Eps2=Tmp} - } - } - starttime=proc.time() - Tmp=strsplit(CutD,'=') - Tmp=Tmp[[1]] - if(length(Tmp)==1){ - Eq=CutD - }else{ - Eq=paste("(",Tmp[1],")-(",Tmp[2],")",sep="") - } - Eq=gsub("x","Xfunc(U,V)",Eq,fixed=TRUE) - Eq=gsub("y","Yfunc(U,V)",Eq,fixed=TRUE) - Eq=gsub("z","Zfunc(U,V)",Eq,fixed=TRUE) - Tmp=paste("Eqfun<<- function(U,V){",Eq,"}",sep="") ######## - eval(parse(text=Tmp)) - Du=(URNG[2]-URNG[1])/Np[1] - Dv=(VRNG[2]-VRNG[1])/Np[2] - Out=list();Out2=list() - for(J in Looprange(1,Np[2])){ ##### - Vval1=VRNG[1]+(J-1)*Dv - Vval2=VRNG[1]+J*Dv - for(I in Looprange(1,Np[1])){ ##### - Uval1=URNG[1]+(I-1)*Du - Uval2=URNG[1]+I*Du - Eval11=Eqfun(Uval1,Vval1) - Eval12=Eqfun(Uval1,Vval2) - Eval21=Eqfun(Uval2,Vval1) - Eval22=Eqfun(Uval2,Vval2) - a1=Uval1;b1=Vval1;c1=Eval11 - a2=Uval2;b2=Vval1;c2=Eval21 - a3=Uval2;b3=Vval2;c3=Eval22 - a4=Uval1;b4=Vval2;c4=Eval12 - PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) - VL=c(c1,c2,c3,c4,c1) - QL=c() - for(K in 1:4){ - P1=Op(K,PL); P2=Op(K+1,PL) - M1=Op(K,VL); M2=Op(K+1,VL) - if(abs(M1)<Eps0){ - QL=Appendrow(QL,P1) - next - } - if(abs(M2)<Eps0){ -# QL=Appendrow(QL,P2) - next - } - if((M1> 0) && (M2> 0)){ - next - } - if((M1< 0) && (M2< 0)){ - next - } - Tmp=1/(M1-M2)*(-M2*P1+M1*P2) - QL=Appendrow(QL,Tmp) - } - if(Length(QL)==2){ - q11=QL[1,1];q12=QL[1,2];q21=QL[2,1];q22=QL[2,2] - if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){ - if(((q21==b1)&&(q22==b1))||((q21==b3)&&(q22==b3))){ - Out2=c(Out2,list(QL)) - }else{ - Out=c(Out,list(QL)) - } - next - } - if(((q12==b1)&&(q22==b1))||((q12==b3)&&(q22==b3))){ - if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){ - Out2=c(Out2,list(QL)) - }else{ - Out=c(Out,list(QL)) - } - next - } - Out=c(Out,list(QL)) - } - } - } - while(length(Out2)>0){ - tmp1=Out2[[1]] - Out=c(Out,list(tmp1)) - Out2=Out2[-1] - rmv=c() - for(jj in Looprange(1,length(Out2))){ - tmp2=Out2[[jj]] - diff1=Norm(tmp2[1,]-tmp1[1,])+Norm(tmp2[2,]-tmp1[2,]) - diff2=Norm(tmp2[1,]-tmp1[2,])+Norm(tmp2[2,]-tmp1[1,]) - if((diff1<Eps0)||(diff2<Eps0)){ - rmv=c(rmv,jj) - next - } - } - Out2=Out2[-rmv] - } - Out=Connectseg(Out,Eps) - Tmp1=Out - Out=list() - for(ii in Looprange(1,length(Tmp1))){ - Tmp2=Op(ii,Tmp1) - Tmp3=c() - for(jj in Looprange(1,Length(Tmp2))){ - Tmp=Op(jj,Tmp2) - Tmp=XYZfunc(Tmp[1],Tmp[2]) - if(Length(Tmp3)>0){ - if(Norm(Op(Length(Tmp3),Tmp3)-Tmp)<Eps){next} - } - Tmp3=Appendrow(Tmp3,Tmp) - } - Out=c(Out,list(Tmp3)) - } - Out=Crv3onsfparadata(Out,Fbdy3,Fd,Np,Eps,Eps2) - return(Out) -} diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4_rep2e.r b/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4_rep2e.r deleted file mode 100644 index 37033948..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4_rep2e.r +++ /dev/null @@ -1,580 +0,0 @@ -# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -# -#This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/> - - -######################################### - -ThisVersion<- "2ev5_2_3(17.10.28)" - -# 2017.10.28 -# Drwpt debugged ( Flattenlist ) -# 2017.10.07 -# - -############################################# - -Dottedline<- function(...) -{ - varargin <- list(...) - Nall <- length(varargin) - Nagasa <- 0.1 - Ookisa <- PenThick*2 #17.10.07 - I <- Nall - Tmp <- varargin[[I]] - while (mode(Tmp)=="numeric" && length(Tmp)==1 ) { - I <- I-1 - Tmp <- varargin[[I]] - } - if (I==Nall-1) { - Nagasa<-Nagasa*varargin[[Nall]] - Nall <- Nall-1 - } - if (I==Nall-2) { - Nagasa <- Nagasa*varargin[[Nall-1]] - Ookisa <- round(Ookisa*varargin[[Nall]]) - Nall <- Nall-2 - } - Nagasa <- 1000/2.54/MilliIn*Nagasa - Ra=Ookisa/MilliIn - for (N in 1:Nall) { - Pdata <- varargin[[N]] - if (mode(Pdata)=="numeric") { - Pdata <- list(Pdata) - } - for (II in 1:length(Pdata)) { - Clist <- MakeCurves(Op(II,Pdata)) - DinM <- Dataindex(Clist) - Mojisu=0 - for (n in Looprange(1,Nrow(DinM))) { - Tmp <- DinM[n,] - Data <- Clist[Tmp[1]:Tmp[2],] - Len <- 0 - Lenlist <- c(0) - for (I in Looprange(2,Nrow(Data))) { - Len <- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist <- c(Lenlist,Len) - } - Lenall <- Lenlist[length(Lenlist)] - if (Lenall==0) { - next - } - Naga <- Nagasa - Nten <- round(Lenall/Naga)+1 - if (Nten > 1) { - Seg <- Lenall/(Nten-1) - } - else { - Seg <- Lenall - } - Eps <- 10^(-6)*Seg - PPd<-c() - Hajime <- 1 - for (I in Looprange(0,Nten-1)) { - Len <- Seg*I - if (I>0) { - J <- Hajime - while( Len>=Lenlist[J]+Eps) { - J <- J+1 - } - Hajime <- J-1 - } - T <- (Len-Lenlist[Hajime])/ - (Lenlist[Hajime+1]-Lenlist[Hajime]) - P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - PPd<-Appendrow(PPd,P) - if (I==Nten-1) { - if (Norm(P-Data[1,])<Eps) { - next - } - } - } - for (I in Looprange(1,Nrow(PPd))){ - P<- Op(I,PPd) - if (Nrow(PPd)==1){ - V<- c(1,0) - } - else if (I==1){ - Tmp<- Op(I+1,PPd)-P - V<- 1/Norm(Tmp)*Tmp - } - else if (I==Nrow(PPd)){ - Tmp<- P-Op(I-1,PPd) - V<- 1/Norm(Tmp)*Tmp - } - else{ - Tmp1<- Op(I+1,PPd)-P - Tmp2<- P-Op(I-1,PPd) - Tmp3<-1/Norm(Tmp1)*Tmp1+1/Norm(Tmp2)*Tmp2 - V<- 1/Norm(Tmp3)*Tmp3 - } - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu=Mojisu+nchar(Str) - if(Mojisu>80){ - cat("\n",file=Wfile,append=TRUE) - Mojisu=0 - } - } - } - } - if(Mojisu>0){ - cat("\n",file=Wfile,append=TRUE) - } - } - Tmp<-PenThick/PenThickInit - Setpen(Tmp) -} - - -########################################### - -Drwline<-function(...) -{ - varargin<-list(...) - Nall<-length(varargin) - Thick<-0 - Tmp<-varargin[[Nall]] - if (mode(Tmp)=="numeric" && length(Tmp)==1){ - Setpen(Tmp) - Nall<-Nall-1 - } - for (N in 1:Nall){ - Pdata<-varargin[[N]] - if (length(Pdata)==0) next - if (mode(Pdata)!="list") Pdata<-list(Pdata) - while(Mixtype(Pdata)==3){ - Tmp1<- list() - for(II in Looprange(1,length(Pdata))){ - Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) - } - Pdata<- Tmp1 - } - for (II in Looprange(1,length(Pdata))){ - Clist<-MakeCurves(Pdata[[II]]) - DinM<-Dataindex(Clist) - for (n in Looprange(1,Nrow(DinM))){ - Tmp<-DinM[n,] - Data<-Clist[Tmp[1]:Tmp[2],] - Mojisu<-0 - for (I in Looprange(1,Nrow(Data))){ - Tmp<-Data[I,] - X=sprintf('%5.5f',Tmp[1]) - Y=sprintf('%5.5f',Tmp[2]) - Pt=paste('(',X,',',Y,')',sep="") - if(I==1){ - Str=paste('\\polyline',Pt,sep="") - }else{ - Str=Pt - } - cat(Str,file=Wfile,append=TRUE) - Mojisu<-Mojisu+nchar(Str) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<-0 - } - } - if (Mojisu!=0){ - cat("%\n",file=Wfile,append=TRUE) - } - cat("%\n",file=Wfile,append=TRUE) - } - } - } - if (Thick>0){ - Tmp<-PenThick/PenThickInit - Setpen(Tmp) - } -} - -########################################### - -Drwpt<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - All=Nargs - if (TenSize>TenSizeInit){ - N<- round(6*sqrt(TenSize/TenSizeInit)) - } - else{ - N<-4 - } - Tmp<- varargin[[All]] - Iro=c(0,0,0,1) - Iroflg=0 - if(is.character(Tmp)){ - Iro=Ratiocmyk(Tmp) - Iroflg=1 - All=All-1 - } - Tmp<- varargin[[All]] - if (mode(Tmp)=="numeric"){ - if (length(Tmp)>1){ - Kosa<- 1; All<- Nargs - } - else{ - Kosa<- Tmp; All<- All-1 - } - } - else if (mode(Tmp)=="list"){ - Kosa<- 1; All<- Nargs - } - Ra=TenSize*1000/2.54/MilliIn - if(Iroflg>0){ - Str='{\\color[cmyk]{' - for(J in 1:4){ - Str=paste(Str,as.character(Kosa*Iro[J]),sep="") - if(J<4){ - Str=paste(Str,',',sep="") - } - } - Str=paste(Str,'}%',sep="") - cat(Str,file=Wfile,append=TRUE) - } - -# CL<-c() -# for (J in 0:N){ -# Tmp<- TenSize*0.5*1000/2.54/MilliIn -# Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) -# CL<- append(CL,Tmp) -# } -# CL<- matrix(CL,nrow=2) -# CL<- t(CL) - Mojisu=0 - for (II in Looprange(1,All)){ - MS<- varargin[[II]] - MS=Flattenlist(MS) #17.10.28 - if (mode(MS)=="numeric"){ - MS<- list(MS) - } - for (I in Looprange(1,length(MS))){ - P<- MS[[I]] - if (InWindow(P)!="i") next - P<- Doscaling(P) - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu=Mojisu+nchar(Str) - if(Mojisu>80){ - cat("\n",file=Wfile,append=TRUE) - Mojisu=0 - } - } - } - Str="%" - if(Iroflg>0){ - Str='}%' - } - if(Mojisu>0){ - Str=paste('\n',Str,'\n',sep="") - }else{ - Fmt=paste(Str,'\n',sep="") - } - cat(Str,file=Wfile,append=TRUE) -} - -# PL<-c() -# for (J in 0:N){ -# PL<- c(PL,P+CL[J+1,]) -# } -# PL<-matrix(PL,nrow=2) -# PL<-t(PL) -# Mojisu<-0 -# for (J in 1:Nrow(PL)){ -# Q<- PL[J,] -# X<- as.character(round(MilliIn*Q[1])) -# Y<- as.character(-round(MilliIn*Q[2])) -# Str<- paste("\\special{pa ",X," ",Y,"}",sep="") -# cat(Str,file=Wfile,append=TRUE) -# Mojisu<- Mojisu+nchar(Str) -# if (Mojisu>80){ -# cat("#\n",file=Wfile,append=TRUE) -# } -# Mojisu=0 -# } -# Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") -# Str2<- "\\special{fp}%\n" -# cat(Str1,file=Wfile,append=TRUE) -# cat(Str2,file=Wfile,append=TRUE) -# } -# } -#} - -###################################### - -Makehasen<- function(Figdata,Sen,Gap,Ptn) -{ - Eps<- 10.0^(-6) - Clist<- MakeCurves(Figdata) - DinM<- Dataindex(Clist) - for (N in Looprange(1,Nrow(DinM))){ - Tmp<- DinM[N,] - Data<- Clist[Tmp[1]:Tmp[2],] - Dtall<- Nrow(Data) - Len<- 0 - Lenlist<- c(0) - for (I in Looprange(2,Dtall)){ - Len<- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist<- c(Lenlist,Len) - } - Lenall<- Lenlist[Dtall] - if (Lenall==0){ - next - } - Kari<- (Sen+Gap)*0.1 - Naga<- Sen*0.1 - Tobi<- Gap*0.1 - if (Norm(Data[1,]-Data[Dtall,])<Eps){ - Nsen<- max(ceiling(Lenall/Kari),3) - SegUnit<- Lenall/Nsen - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit)) - } - else{ - if (Ptn==0){ - Nsen<- max(ceiling((Lenall+Tobi)/Kari),3) - SegUnit<- Lenall*(Sen+Gap)/(Nsen*Sen+(Nsen-1)*Gap) - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit)) - } - else{ - Nsen<- max(ceiling((Lenall+Naga)/Kari),3) - SegUnit<- Lenall*(Sen+Gap)/((Nsen-1)*Sen+Nsen*Gap) - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(Tobi,Tobi+(Nsen-2)*SegUnit,by=SegUnit)) - } - } - Hajime<- 1; Owari<- 1 - Mojisu<- 0 - for (I in Looprange(1,length(SegList))){ - Len<- SegList[I] - J<- Owari - while (Len>=Lenlist[J]-Eps){ - if (J==Dtall){ - break - } - J<- J+1 - } - Hajime<- J-1 - J<- Hajime - while (Len+Naga>Lenlist[J]-Eps){ - if (J==Dtall){ - break - } - J<- J+1 - } - Owari<- J-1 - T<- (Len-Lenlist[Hajime]) - T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) - P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - X0=sprintf('%5.5f',P[1]) - Y0=sprintf('%5.5f',P[2]) - Pt0=paste('(',X0,',',Y0,')',sep="") - Str=paste('\\polyline',Pt0,sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - for (J in Looprange(Hajime+1,Owari)){ - P=Data[J,] - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Pt=paste('(',X,',',Y,')',sep="") - Str=Pt - cat(Str,file=Wfile,append=TRUE) - Pt0=Pt - Mojisu=Mojisu+nchar(Str) - } - T<- (Len+Naga-Lenlist[Owari]) - T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) - P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Pt=paste('(',X,',',Y,')',sep="") - Str=Pt - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - cat("%\n%\n",file=Wfile,append=TRUE); -} - -######################################### - -Beginpicture<-function(ul) -{ ## Scaling is implemented - Tmp<- Doscaling(c(XMIN,YMIN)) - Xm<- Tmp[1] - Ym<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - XM<- Tmp[1] - YM<- Tmp[2] - Dx<- XM-Xm - Dy<- YM-Ym - Sym<-".0123456789 +-*/" - SL<-Sym - OL<-"+-*/" - if (ul!=""){ - ULEN<<-ul; - } - Is<-1; - VL<-""; - Ucode<-ULEN - for (I in Looprange(1,nchar(Ucode))){ - C<-substring(Ucode,I,I); - if (length(grep(C,SL,fixed=TRUE))>0){ - if (length(grep(C,OL,fixed=TRUE))>0){ - Tmp<-substring(Ucode,Is,I-1); - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1; - } - } - else{ - Unit<-substring(Ucode,I,I+1); - Str<-substring(Ucode,Is,I-1); - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)); - Str<-as.character(Valu); - ULEN<<- paste(Str,Unit,sep=""); - if (Unit=="cm") MilliIn<<-1000/2.54*Valu - if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if (Unit=="in") MilliIn<<-1000*Valu - if (Unit=="pt") MilliIn<<-1000/72.27*Valu - if (Unit=="pc") MilliIn<<-1000/6.022*Valu - if (Unit=="bp") MilliIn<<-1000/72*Valu - if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; - if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; - Str<-paste("{\\unitlength=",ULEN,"%\n",sep=""); - cat(Str,file=Wfile,append=TRUE); - cat("\\begin{picture}%\n",file=Wfile,append=TRUE); - Str<-"("; - Tmp<-as.character(round(Dx,digits=6)); - Str<-paste(Str,Tmp,",",sep=""); - Tmp<-as.character(round(Dy,digits=6)); - Str<-paste(Str,Tmp,")(",sep=""); - Tmp<-as.character(round(Xm,digits=6)); - Str<-paste(Str,Tmp,",",sep=""); - Tmp<-as.character(round(Ym,digits=6)); - Str<-paste(Str,Tmp,")%\n",sep=""); - cat(Str,file=Wfile,append=TRUE); - Str=paste('\\linethickness{',as.character(PenThickInit/1000),'in}%',sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################################### - -Setpen<-function(Width) -{ - PenThick<<-round(PenThickInit*Width) - Str=paste('\\linethickness{',as.character(PenThick/1000),'in}%',sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################################### - -Shade<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg=0 - if(Nargs>1){ - Iro=varargin[[Nargs]] - if(is.character(Iro)){ - Iroflg=1 - if(length(grep("{",Iro,fixed=TRUE))>0){ - Str=paste("{\\color",Iro,sep="") - } - else{ - Str=paste("{\\color{",Iro,"}",sep="") - } - } - else{ - if(length(Iro)==1){ - Kosa=Iro - } - else{ - Iroflg=1 - if(length(Iro)==4){ - Str="{\\color[cmyk]{" - } - else{ - if(length(Iro)==3){ - Str="{\\color[rgb]{" - } - } - for(J in 1:length(Iro)){ - Str=paste(Str,as.character(Iro[J]),sep="") - if(J<length(Iro)){ - Str=paste(Str,",") - } - } - Str=paste(Str,"}") - } - } - if(Iroflg==1){ - Str=paste(Str,"%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - } - } - Mojisu=0 - Tmp=varargin[[1]] - Data=Kyoukai(Tmp) - for (I in Looprange(1, length(Data))){ - PL<- Op(I,Data) - Mojisu<- 0 - for (J in 1:Nrow(PL)){ - P<- Doscaling(Op(J,PL)) - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Pt=paste('(',X,',',Y,')',sep="") - if(J==1){ - Str=paste('\\polygon*',Pt,sep="") - }else{ - Str=Pt - } - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - if(Iroflg==1){ - Str='}%' - if(Mojisu>0){ - Str=paste('\n',Str,'\n',sep="") - }else{ - Str=paste(Str,'\n') - } - cat(Str,file=Wfile,append=TRUE) - } -} diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r b/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r deleted file mode 100644 index dc54682b..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r +++ /dev/null @@ -1,14614 +0,0 @@ -# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -# -#This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/> - - -######################################### - -ThisVersion<- "KeTpic for R v5_2_4(20180327)" - -print(ThisVersion) - -# 20180402 -# Implicitplot greatly changed -# 20180327 -# Kyoukai debugged -# 20180317 -# IntersectcurvesPp changed and debugged -# Intersectpartseg changed (Eps00 ) -# Collectsameseg added, Collectnear commented out -# 20180306 -# PthiddenQ,Meetpoints,Sfcutparadata changed (to avoid duplications ) -# Sfbdparadata changed ( for near points in Implicitdata ) -# Envelopedata, Evlpfun added -# 20180305 -# (for surface drwaings ) Eps => Eps1 -# 2018.02.27 -# Nohiddenpara2,Crvsfparadara debugged (Eps=>Eps0) -# 2018.02.26 -# Sfcutparadata changed -# Partcrv3 debugged -# Projcurve rewritten -# Nohiddenparadata debugged -# PthiddenQ debugged -# 2018.02.24 -# Sfcutdata added ( for functions ) -# Meetpoints debugged (case Norm(PtB-PtA)<Eps0) -# 2018.02.23 -# Makevaltable2 added ( for functions ) -# 2018.02.23 -# Crvonsfparadata,Crv3onsfparadata added -# Wireparadata added -# 2018.02.22 -# PthiddenQ,Nohiddenpara2 changed (Eps2) -# 2018.02.21 -# PthiddenQ,Meetpoints debugged -# Crvsfparadata debugged (OTHERPARTITION) -# Partitionseg debugged (for non-list) and changed (Ns=0) -# Intersectcrvsf added -# 2018.02.19 -# Groupnearpt added -# Collectnear debugged -# Meetpoints,PthiddenQ debugged and changed (Groupnearpt used ) -# Parapt changed (for point list ) -# Partitionseg changed (remove close value ) -# Fullformfunc changed (Initialization of ADDPOINT) -# Addpoints added -# 2018.02.18 -# Projpara debugged ( for empty data, Mix replace ) -# WriteOutData debugged (for emply data ) -# Sfbdparadata,Cuspparadata debugged -# Meetpoints replaced -# 2018.02.17 -# PthiddenQ replaced -# 2018.02.15 -# Cancoordpara debugged (X=-... ) -# 2018.02.14 -# Paramoncrv,Pointoncrv renamed to ...curve -# 2018.02.12 -# Nohiddenpara2 debugged ( CUSPPT should be a list ) -# Dropnumlistcrv changed (Eps) -# 2018.02.11 -# Paramocrv debugged ( case N=Length(PtL) ) -# Sfbdparadata, Borderparadata, Makexybdy, Partitionseg, -# Evlptablepara, Fullformfunc, Dropnumlistcrv, Cuspsplitpara, -# PthiddenQ, Nohiddenpara2 added -# Crvsfparadata, Meetpoints, Clipdomain added -# 2018.02.10 -# Partcrv3 debugged -# 2018.02.09 -# Ptstart,Ptend changed ( for the case fig is empty) -# Norm changed (Dotprod used ) -# 2018.02.07 -# Collectnear debugged (Looprange ) -# Intersectcurves debugged (sum) -# 2018.02.06 -# Kukeiiwake debugged ( ParamonCurve -> Paramoncrv ) -# 2018.02.05 -# Dotprod changed ( crossprod not used ) -# Intersectpartseg changed ( case of length of result =1) -# 2018.02.04 -# Diff added ( func, withvar, (varnamevalue1,... )) -# Funvalue added ( for an expression ) -# 2018.02.02 -# Enclosing2 changed ( for distant curves, startpt option removed ) -# 2018.02.01 -# Intersectline,Intersectseg,...,Intersectcuves added -# Quicksort added -# Enclosing2 added (incomplete) -# 2018.01.29 -# Length added -# 2017.12.24 -# Objpolyhedron added -# 2017.12.23 -# Objsymb, symb3data added -# Objrecs, Objpolygon debugged -# Objthicksurf added -# 2017.12.22 -# Openobj,Closeobj,Writeobjpoint,Printobjstr,Objname,Objsurf added -# Crossprod added -# Objjoin, Objcurve, Objrecs, Objpolygon, Objsymb added -# Spacecurve debugged -# 2017.12.17 -# Setunitlen debugged ( MEMORI ) -# 2017.12.13 -# ReadOutData debugged -# 2017.12.11 -# Enclosing debugged ( appendrow -> Appendrow ) -# 2017.11.29 -# Anglemark, Arrowhead, Ovaldata debugged ( Circldeta included ) -# 2017.11.27 -# Anglemark changed ( Scilab 16.12.29) -# Plotdata,Paramplot,Spacecurve changed ( Scilab 16.12.13) -# Enclosing changed ( Scilab 16.10.09) -# Arrowhead,Arrowline changed ( Scilab 15.06.11) -# Definecolor added ( Scilab 15.05.04) -# 2017.11.26 -# Exprrot, Letterrot debugged ( `) -# 2017.11.24 -# Deqplot debugged (Looprange) -# 2017.11.20 -# InWindow debugged (for length=1) -# 2017.10.28 -# Openfile changed (Creator) -# 2017.10.23 -# ReadOutData greatly changed -# 2017.10.11 -# Drwpt debugged (Flattenlist ) -# 2017.10.08 -# Bezier debugged ( Num ) -# 2017.10.07 -# ReadOutData debugged ( for null data ) -# 2017.10.06 -# Deqdata, Deqplot added -# Connectseg remade(bug) -# 2017.09.30 -# Bezierpt, Bezier added -# 2017.09.29 -# Ptcrv debugged -# 2017.09.28 -# Openfile changed -# 2017.09.24 -# Circledata debugged -# Kyoukai changed (Eps) -# Shade updated -# 2017.09.22 -# Setcolor changed -# Plotdata,Paramplot,Spacecurve changed (N-1 -> N) -# 2017.09.21 -# Shade changed (Sci 17.01.09) -# 2017.09.17 -# Ovaldata,Assignadd changed -# Dist added -# Cicledata changed -# Bowdata debugged (Circledata,etc) - -# 2015.11.05 -# WriteOutData changed - -# 2015.10.29 -# WriteOutData changed ( endmark //// ) - -# 2015.10.24 -# ReadOutData changed ( in case of listlength=1 ) - -# 2014.12.23 -# ReadOutData added - -# 2014.12.17 -# WriteOutData added - -# 2014.0905 -# Unscaling debugged MARKLENI => MARKLEN -# 2014.03.31 -# PhHiddenData added -# 2014.03.30 -# Facesdata changed ( for Hiddendata ) -# 2014.03.23 -# MARKLEN separated, Rotate3data debugged - -# 2013.12.19 -# Openfile, Closefile, Bowname, Bownamerot - -# 2013.11.13 -# Arrowhead, Arrowheaddata - -# 2013.08.07 -# Cancoordpara added - -# 2013.08.07 -# Integrate added - -# 2013.05.20 -# Openfile changed - -# 2013.05.03 -# Tabledata, Pointdata changed -# Dividetable, Partframe added - -# 2013.02.10 -# Ketinit added - -# 2012.01.07 -# Arrowline, Arrowhead ( Cut implemented ) - -# 2011.12.18 -# Framedata ( compliant for list ) - -# 2011.12.12 -# Skeletonparadata... ( Flattellist used) - -# 2011.11.27 -# drwboxframe - -# 2011.11.07 -# metacommands added - -# 2011.11.02 -# Joingraphics ( for list structure ) - -# 2011.08.24 -# Setcolor ( c(1,0,0,0.5) etc ) -# Rotate3data ( Point is available ) - -# 2011.07.19 -# Drwline, Letter, Expr -# Drwboxplot( etc ) min,max => outliners -# Drwline ( unfinished in the case of "integer" ) - -# 2011.06.25 -# joincrvs debugged - -# synchro with ketpict2e - -# 2011.06.01 -# Bowdata debugged - -#2011.05.28 -# Ratiocmyk, Setcolor ( new ) - -#2011.04.28 -# Htickmark, Vtickmark debugged - -#2011.03.08 -# Drwboxframe debugged -# Putrow, Putrowexpr debugged (Dpos ) - -#2011.03.02 -# Tabledata ( index of hline ), PutcoL, PutcoLexpr ( "r",...) debugged -# Texcom changed ( // => backslash ) - -#2011.01.07 -# Dividegraphics, Splinedat are changed significantly -# Readtextdata is changed - -#2011.01.04 -# Derivative, Integrate are added - -#2010.12.07 -# Translatedata, Scaledata, Reflectdata changed ( efficient for vector ) -# Rotatedata changed ( deg : logical ) -# HIstplotdata, Drwhistplot ( type => freq , fpplot (added) ) - -# 2010.12.04 -# WindispT changed ( tickmark ) -# Lineplot changed ( mag=> length ) -# Plotdata debugged ( 'E=fun', 'D=') -# Enclosing changed (return PD) - -# 2010.12.02 -# WindispT changed -# Makecurves debugged - -# 2010.11.27 -# Pointdata changed ( efficient for matrix and data.frame ) -# WindispT -# Setwindow ( decide from data ) -# Assign debugged ( strsplit => gsub(fixed=T)) - -# 2010.11.20 -# Flattenlist, WindispT -# Splinedata changed( efficient for data.frame ) - -#2010.08.19 ( Maybe not finished ) -# Stripblanks -# Fullformfunc, Sf3data - -#2010.08.17 -# Phparadata, Phpersdata, Phspersdata, Phsparadata -# Facesdata, MakeveLfaceL, Menkakusi2 -# Rotate3data -# Skeletonpersdata, Skeletonpers3data, Makeskeletonpersdata -# Embed - -#2010.08.16 -# Spacecurve changed -# CameracoordCurve, Partcrv3, Projpers, CameraCurve, -# Perspt, Xyzaxpersname, Invperspt, Zparapt, Zperspt - -# 2010.08.15 -# Phcutoffdata added - -# 2010.08.13 -# Phcutdata, Spacecurve debugged -# Setangle changed - -# 2010.08.09 -# Spacecurve -# Rotate3data, Rotate3pt -# Phcutdata - -# 2010.08.08 -# Implementing 3d -# Initangle, Setangle, Setpers, SetstereoL, SetstereoR -# Mixlength -# Spaceline, Projpara, ProjCurve, Parapt -# Xyzax3data, Xyzaxparaname -# Cancoordpers, Invparapt, ProjcoordCurve -# Skeletonparadata, Skeletonpara3data, Makeskeletondata, Kukannozoki - -# 2010.07.25 -# Rotatedata changed -# Drwline changed (list of list) - -# 2010.04.09 -# Stat package added - -# 2010.04.02 -# Putcolexpr, Putrowexpr - -# 2010.04.02 - -# Windisp, Op changed -# Execmd added -# Texnewcmd, Texrenewcmd, Texend, -# Texctr, Texnewctr, Texsetctr -# Kyoukai debugged - -# 2010.01.20 -# Partcrv, Makeshasen : debugged - -# 2010.01.23 -# Ovaldata, Ovalbox added - -# 2010.01.27 -# Readtextdata changed -# Putrow, PutcoL debugged ( Putcol is OK) - -# 2010.01.31 -# Writetextdata added - -# 2010.02.12 -# Texvalctr, Texthectr added - -# 2010.02.22 -# Execmd changed - -# 2010.02.23 -# Op, Windisp changed - -# 2010.02.24 -# Execmd changed - -# 2010.03.07 -# Dotfilldata (Kosa>1) - -# 2010.03.21 -# Mixjoin -# Koutenlist (bug) - - -# 2010.03.24 -# Arrowhead ( bug in the case of "l" ) - -# 2010.03.28 -# Tabledata -# Diagcelldata ( New ) - -# 2010.03.30 -# Tabledata - -########################################### - -XMIN<- -5 -XMAX<- 5 -YMIN<- -5 ; YMAX<- 5 -ZIKU<- "line" -ARROWSIZE<- 1 -XNAME<- "$x$" -XPOS<- "e" -YNAME<- "$y$" -YPOS<- "n" -ONAME<- "O" -OPOS<- "sw" -ULEN<- "1cm" -MilliIn<- 1/2.54*1000 -PenThick<- round(MilliIn*0.02) -PenThickInit<- PenThick -TenSizeInit<<- 0.02*2 #17.10.07 -TenSize<- TenSizeInit -Wfile<-"" -MEMORI<- 0.05 -MEMORIInit<- MEMORI -MEMORINow<- MEMORI -MARKLEN<- 0.05 -MARKLENInit<- MARKLEN -MARKLENNow<- MARKLEN -GENTEN<- c(0,0) -YaSize<- 1 -YaAngle<- 18 -YaPosition<- 1 -YaThick<- 1 -YaStyle<- "tf" -PHI<- 30*pi/180 -THETA<- 60*pi/180 -FocusPoint<- c(0,0,0) -EyePoint<- c(5,5,5) -ASSIGNLIST<- list("`","'") - -SCALEX<- 1 -SCALEY<- 1 -LOGX<- 0 -LOGY<- 0 - -TEXFORLEVEL<- 0 -TEXFORLAST<- list() - -####################### - -Ketinit<- function(){ -XMIN<<- -5 -XMAX<<- 5 -YMIN<<- -5 ; YMAX<<- 5 -ZIKU<<- "line" -ARROWSIZE<<- 1 -XNAME<<- "$x$" -XPOS<<- "e" -YNAME<<- "$y$" -YPOS<<- "n" -ONAME<<- "O" -OPOS<<- "sw" -ULEN<<- "1cm" -MilliIn<<- 1/2.54*1000 -PenThick<<- round(MilliIn*0.02) -PenThickInit<<- PenThick -TenSizeInit<<- 0.02*2 #17.10.07 -TenSize<<- TenSizeInit -Wfile<<-"" -MEMORI<<- 0.05 -MEMORIInit<<- MEMORI -MEMORINow<<- MEMORI -MARKLEN<<- 0.05 -MARKLENInit<<- MARKLEN -MARKLENNow<<- MARKLEN -GENTEN<<- c(0,0) -YaSize<<- 1 -YaAngle<<- 18 -YaPosition<<- 1 -YaThick<<- 1 -YaStyle<<- "tf" -PHI<<- 30*pi/180 -THETA<<- 60*pi/180 -FocusPoint<<- c(0,0,0) -EyePoint<<- c(5,5,5) -ASSIGNLIST<<- list("`","'") - -SCALEX<<- 1 -SCALEY<<- 1 -LOGX<<- 0 -LOGY<<- 0 - -TEXFORLEVEL<<- 0 -TEXFORLAST<<- list() -} - -#------------------------------------------------------- - -Appendrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Out<-c() - Nc<- 0 - for (I in 1:Nargs) - { - Dt<- varargin[[I]] - Nc<- max(Nc,Ncol(Dt)) - if(class(Dt)=="matrix") Dt<-as.numeric(t(Dt)) - Out<- c(Out,Dt) - } - if(Nc>0) - { - Out<-matrix(Out, nrow=Nc) - Out<-t(Out) - } - else - { - Out<-c() - } - return(Out) -} - -Datalength<-function(Data) -{ - if(length(Data)==0) return(0) - if(mode(Data)=="numeric") return(Nrow(Data)) - if(mode(Data)=="character") return(nchar(Data)) - if(mode(Data)=="list") return(length(Data)) -} - -Crossprod<- function (a,b){ # 17.12.22 - if(length(a)==3){ - Tmp1=a[2]*b[3]-a[3]*b[2] - Tmp2=a[3]*b[1]-a[1]*b[3] - Tmp3=a[1]*b[2]-a[2]*b[1] - Out=c(Tmp1,Tmp2,Tmp3) - }else{ - Out=a[1]*b[2]-a[2]*b[1] - } - return(Out) -} - -Dotprod<-function(a,b){ # 18.02.05 - nn=min(length(a),length(b)) - out=0 - for(jj in Looprange(1,nn)){ - out=out+a[jj]*b[jj] - } - return(out) -} - -Dist<- function(...) # 17.09.17 -{ - varargin<- list(...) - a=varargin[[1]] - if(length(varargin)==1){ - tmp=sqrt(Dotprod(a,a)) - return(as.vector(tmp)) - } - else{ - b=varargin[[2]] - tmp=sqrt(Dotprod(b-a,b-a)) - retun(as.vector(tmp)) - } -} - -Member<-function(A,L) -{ - N<-length(L); - if(length(N)==0) return(FALSE) - for (I in 1:N) - { - if(class(L)=="list") - { - Tmp<-L[[I]] - } - else - { - Tmp<-L[I] - } - if(mode(A)=="numeric") - { - if(Norm(A-Tmp)==0) return(TRUE) - } - else - { - if(A==Tmp) return(TRUE) - } - } - return(FALSE) -} - -Norm<-function(V) -{ - Tmp=Dotprod(V,V) #18.02.09 -# Tmp<-as.vector(V); -# Tmp<-crossprod(Tmp,Tmp) - Tmp<-sqrt(Tmp) -# as.numeric(Tmp) -} - -Ncol<-function(P) -{ - if(class(P)=="matrix") return(ncol(P)) - else return(length(P)) -} - -Nrow<-function(P) -{ - if(length(P)==0) return(0) - if(class(P)=="matrix") return(nrow(P)) - else return(1) -} - -Looprange<- function(a,b) -{ -if(a<=b) return(a:b) -return(c()) -} - -Stripblanks<- function(Ch){ - Tmp<- gsub(" ","",Ch,fixed=TRUE) - return(Tmp) -} - -Quicksort<- function(seqL,key){ #18.02.01 - if(length(seqL)<2){ - out=seqL - }else{ - tmp1=Op(1,seqL) - tmp2=Op(2,seqL) - if(Op(key,tmp1)>=Op(key,tmp2)){ - pivot = tmp1 - }else{ - pivot=tmp2 - } - left = list() - right = list() - for(ii in 1:length(seqL)){ - tmp=Op(ii,seqL) - if(Op(key,tmp)< Op(key,pivot)){ - left=c(left,list(tmp)) - }else{ - right=c(right,list(tmp)) - } - } - left = Quicksort(left,key) - right = Quicksort(right,key) - out=c(left,right) - } - return(out) -} - -Derivative<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Fstr<- varargin[[1]] - Vstr<- varargin[[2]] - NvaL<- length(Vstr) - Flg<- 0 - if(Nargs>=3){ - VaL<- varargin[[3]] - Flg<- 1 - } - Str<- paste("deriv(~",Fstr,",c('",Vstr[1],"'",sep="") - for(J in Looprange(2,NvaL)){ - Str<- paste(Str,",'",Vstr[J],"'",sep="") - } - Str<- paste(Str,")",sep="") - if(NvaL<=3){ - Str<- paste(Str,",func=TRUE)",sep="") - } - else{ - Str<- paste(Str,")",sep="") - } - f<- eval(parse(text=Str)) - if(Flg==1){ - if(NvaL<=3){ - if(NvaL==1){V<- f(VaL[1])} - if(NvaL==2){V<- f(VaL[1],VaL[2])} - if(NvaL==3){V<- f(VaL[1],VaL[2],VaL[3])} - } - else{ - for(J in 1:NvaL){ - Tmp<- paste(Vstr[J],'<-',as.character(VaL[J])) - eval(parse(text=Tmp)) - } - V<- eval(f) - } - Out<- attr(V,'gradient') - Out<- Out[1,] - } - else{ - Out<- f - } - return(Out) -} - -Diff<- function(...){ #18.02.04 - varargin=list(...) - Nargs=length(varargin) - fun=varargin[[1]] - withvar=varargin[[2]] - tmp=paste("f<- expression(",fun,")",sep="") - eval(parse(text=tmp)) - nn=nchar(withvar) - for(jj in Looprange(1,nn)){ - tmp=substring(withvar,jj,jj) - f=D(f,tmp) - } - var=c() - val="" - for(jj in Looprange(3,Nargs)){ - tmp=strsplit(varargin[[jj]],"=") - var=c(var,tmp[[1]][1]) - val=paste(val,tmp[[1]][2],",",sep="") - } - if(Length(val)>1){ - val=substring(val,1,Length(val)-1) - f=deriv(f,var,func=TRUE) - tmp=paste("out=f(",val,")",sep="") - out=eval(parse(text=tmp)) - return(out[1]) - }else{ - return(f) - } -} - -Funvalue<- function(...){ - varargin=list(...) - Nargs=length(varargin) - df=varargin[[1]] - var=c() - val="" - for(jj in Looprange(2,Nargs)){ - tmp=strsplit(varargin[[jj]],"=") - var=c(var,tmp[[1]][1]) - val=paste(val,tmp[[1]][2],",",sep="") - } - val=substring(val,1,Length(val)-1) - dfun=deriv(df,var,func=TRUE) - tmp=paste("out=dfun(",val,")",sep="") - eval(parse(text=tmp)) - return(out[1]) -} - -Integrate<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Fstr<- varargin[[1]] - Vstr<- varargin[[2]] - IntvL<- varargin[[3]] - Str<- 'Tmpfun<- function(' - Str<- paste(Str,Vstr,'){',sep='') - Str<- paste(Str,Fstr,'}',sep='') - eval(parse(text=Str)) - Tmpfunv<- function(x){sapply(x,Tmpfun)} - Out<- 0 - for (J in 1:(length(IntvL)-1)){ - Tmp<- integrate(Tmpfunv,IntvL[J],IntvL[J+1]) - Out<- Out+Tmp[[1]] - } - return(Out) -} - -#-------------------------------------- - -######################### - -Anglemark<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-3) - PA<- varargin[[1]] - PB<- varargin[[2]] - PC=varargin[[3]] - r <- 0.5 - if(Nargs>=4){ - r<- varargin[[4]]*r - } - Out=c() - if(r>min(Norm(PA-PB),Norm(PC-PB))){ - return(Out) - } - Cir<- Circledata(c(PB,r)) #17.11.29 - Tmp<- IntersectcrvsPp(Cir,Listplot(PA,PB)) - P1<- Op(2,Op(1,Tmp)) - Tmp<- IntersectcrvsPp(Cir,Listplot(PC,PB)) - P2<- Op(2,Op(1,Tmp)) - if(abs(P1-P2)<Eps){ - Out<-c() - return(Out) - } - if(P1<P2-Eps){ - Out<- Partcrv(P1,P2,Cir) - } - else{ - Tmp<- Numptcrv(Cir) - Tmp1<- Partcrv(P1,Tmp,Cir) - Tmp2<- Partcrv(1,P2,Cir) - Out<- Joincrvs(Tmp1,Tmp2) - } -} - -############################################## - -Arrowdata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - Q<- varargin[[2]] - R<- Q - Futosa<- YaThick - Ookisa<- YaSize - Thickness<- 1 - Hiraki<- YaAngle - Yapos<- YaPosition - Position<- 1 - Str<- YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - if(length(Tmp)>1){ - R<- Tmp - } - else{ - if(Flg==0){ - Ookisa<- Ookisa*Tmp - } - if(Flg==1){ - if(Tmp<5){ - Hiraki<- Tmp*Hiraki - } - else{ - Hiraki<- Tmp - } - } - if(Flg==2){ - R<- P+Tmp*(Q-P) - } - else{ - R<- P+Yapos*(Q-P) - } - if(Flg==3){ - Futosa<- Tmp - } - Flg<- Flg+1 - } - } - if(mode(Tmp)=="character"){ - Tmp<- grep("=", Tmp) - if(length(Tmp)>0){ - eval(parse(text=Tmp)) - Futosa<- Futosa*Thickness - R<- P+Position*(Q-P) - } - else{ - Str<- Tmp - } - } - } - Tmp1<- Listplot(c(P,Q)) - Tmp2<- Arrowheaddata(R,Q-P,Ookisa,Hiraki,Futosa,Str) - Out<- Joingraphics(Tmp1,Tmp2) -} - -###################################### - -# 2013.11.13 No Intersect debugged - -Arrowhead<-function(...) -{ ## Scaling is implemented - ## 12.01.08 Kirikomi - varargin<-list(...) - Nargs<-length(varargin) - P<-varargin[[1]] - Houkou<-varargin[[2]] - Ookisa<-0.2*YaSize - Hiraki<-YaAngle - Futosa<-0.5*YaThick - Cut<- 0 - Str<-YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<-varargin[[I]] - if(is.character(Tmp)){ - Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from - if(length(Equal)>0){ - Tmp1<- strsplit(Tmp,"=",fixed=TRUE) - Tmp2<- Tmp1[[1]] - if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ - Tmp<- paste("Cut=",Tmp2[2],sep="") - eval(parse(text=Tmp)) - } - }else{ - Str<- Tmp - } # 12.01.07 until - } - if(is.numeric(Tmp) && length(Tmp)==1){ - if(Flg==0) Ookisa<-Ookisa*Tmp - if(Flg==1){ - if(Tmp<5) Hiraki<-Tmp*Hiraki - else Hiraki<-Tmp - } - if(Flg==2) Futosa<-Tmp - Flg<-Flg+1 - } - } - Ookisa<-1000/2.54/MilliIn*Ookisa - Theta<-Hiraki*pi/180 - if(Nrow(Houkou)>1){ - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Tmp<-Nearestpt(P,Houkou) - A<-Tmp[[1]] - I<-floor(Tmp[[2]]) - G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 - Flg<- 0 # 13.11.13 - JL<-seq(I,1,by=-1) - for (J in JL){ - B<-Ptcrv(J,Houkou) - Tmp<-IntersectcrvsPp(Listplot(list(A,B)),G) - if(length(Tmp)>0){ - Flg<- 1 - break - } - A<-B - } - if(Flg==0){ # 13.11.13 - print("Arrowhead may be too large (no intersect)") - return(P) - } - Houkou<-P-Op(1,Tmp[[1]]) - Houkou<- Unscaling(Houkou) - P<- Unscaling(P) - } - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Ev<--1/Norm(Houkou)*Houkou - Nv<-c(-Ev[2],Ev[1]) - if(length(grep("c",Str))>0){ - P<-P-0.5*Ookisa*cos(Theta)*Ev - } - if(length(grep("b",Str))>0){ - P<-P-Ookisa*cos(Theta)*Ev - } - A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv - B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv - if(length(grep("l",Str))>0){ - Tmp<-Listplot(list(A,P,B)) - Tmp1<- Unscaling(Tmp) - Drwline(Tmp1,Futosa) - } - else{ - C<- P+(1-Cut)*((A+B)/2-P) # 12.01.07 - Tmp<- Listplot(list(A,P,B,C,A)) # 12.01.07 - Tmp1<- Unscaling(Tmp) - Shade(Tmp1) - Tmp=Listplot(c(A,P,B,C,A,P)) # 15.6.20 - Tmp1=Unscaling(Tmp) - Drwline(Tmp1,0.1) # 15.06.11, 15.06.14 - } -} - -############################################ - -# 2013.11.13 No intersect debugged - -Arrowheaddata<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - Houkou<- varargin[[2]] - Ookisa<- 0.2*YaSize - Hiraki<- YaAngle - Futosa<- 0 - Thickness<- 1 - Str<- YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<-varargin[[I]] - if(mode(Tmp)=="character"){ - Tmp1<-grep("=",Tmp) - if(length(Tmp1)>0){ - eval(parse(text=Tmp)) - Futosa<- Thickness - } - else{ - Str<- Tmp - } - } - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - if(Flg==0) Ookisa<-Ookisa*Tmp - if(Flg==1){ - if(Tmp<5) Hiraki<-Tmp*Hiraki - else Hiraki<-Tmp - } - if(Flg==2) Futosa<-Tmp - Flg<-Flg+1 - } - } - Theta<- Hiraki*pi/180 - if(Nrow(Houkou)>1){ - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Tmp<-Nearestpt(P,Houkou) - A<-Tmp[[1]] - I<-floor(Tmp[[2]]) - G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 - Flg<- 0 # 13.11.13 - JL<-seq(I,1,by=-1) - for (J in JL){ - B<- Ptcrv(J,Houkou) - Tmp<- IntersectcrvsPp(Listplot(list(A,B)),G) - if(length(Tmp)>0){ - Flg<- 1 - break - } - A<-B - } - if(Flg==0){ # 13.11.13 - print("Arrowhead may be too large (no intersect)") - return(P) - } - Houkou<-P-Op(1,Tmp[[1]]) - Houkou<- Unscaling(Houkou) - P<- Unscaling(P) - } - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Ev<- -1/Norm(Houkou)*Houkou - Nv<- c(-Ev[2],Ev[1]) - if(length(grep("c",Str))>0){ - P<-P-0.5*Ookisa*cos(Theta)*Ev - } - if(length(grep("b",Str))>0){ - P<-P-Ookisa*cos(Theta)*Ev - } - A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv - B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv - Tmp<- Listplot(A,P,B) - Out<- Unscaling(Tmp) - return(Out) -} - -########################################## - -Arrowline<- function(...) -{ # 12.01.07 kirikomi - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - Q<- varargin[[2]] - Futosa<- YaThick - Ookisa<- YaSize - Hiraki<- YaAngle - Yapos<- YaPosition - Cutstr<- "Cut=0" - Str<- YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - if(is.character(Tmp)){ - Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from - if(length(Equal)>0){ - Tmp1<- strsplit(Tmp,"=") - Tmp2<- Tmp1[[1]] - if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ - Tmp<- paste("Cut=", Tmp2[2],sep="") - Cutstr<- Tmp - } - } - else{ - Str<- Tmp - } # 12.01.07 until - } - if(is.numeric(Tmp) && length(Tmp)==1){ - if(Flg==0) Ookisa<- Ookisa*Tmp - if(Flg==1){ - if(Tmp<5) Hiraki<- Tmp*Hiraki - else Hiraki<- Tmp - } - if(Flg==2) Yapos<- Tmp - if(Flg==3) Futosa<- Tmp - Flg<- Flg+1 - } - } - R<- P+Yapos*(Q-P) - Tmp=Q-Unscaling(0.2*Ookisa/2*(Q-P)/Norm(Q-P)) # 15.10.24 - Drwline(Listplot(c(P,Tmp)),Futosa) - Arrowhead(R,Q-P,Ookisa,Hiraki,Futosa,Cutstr,Str) -} - -######################################### - -Assign<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - ASSIGNLIST<<- list("`",Prime()) - Out<- ASSIGNLIST - return() -# return("Assign reset done"); - } - L<- list("`","'") - if(Nargs%%2==0){ - L<- Mixjoin(L,varargin) - ASSIGNLIST<<- L - Out<- L - return() -# return("Assign set done"); - } - if(Nargs==1){ - Fnstr<- varargin[[1]] - if(nchar(Fnstr)==0){ # case of "" - L<- ASSIGNLIST - Out<- c() - for (I in seq(1,length(L),by=2)){ - Tmp1<- L[[I]] - Tmp2<- L[[I+1]] - if(length(Tmp2)==1){ - Tmp3<- as.character(Tmp2) - } - else{ - if(mode(Tmp2)=="character"){ - Tmp3<- Tmp2 - } - else if(mode(Tmp2)=="list"){ - Tmp3<- makeliststr(Tmp2) - } - else if(mode(Tmp2)=="numeric"){ - Tmp3<- "c(" - for (J in Looprange(1,length(Tmp2))){ - Tmp3<- paste(Tmp3,as.character(Tmp2[J]),sep="") - if(J<length(Tmp2)){ - Tmp3<- paste(Tmp3,",",sep="") - } - } - Tmp3<- paste(Tmp3,")",sep="") - if(class(Tmp2)=="matrix"){ - Nr<- as.character(nrow(Tmp2)) - Tmp3<- paste("matrix(",Tmp3,"nrow=",Nr,")",sep="") - } - } - } - Tmp<- paste(Tmp1,"=",Tmp3,sep="") - Out<- c(Out,Tmp) - } - return(Out); - } - if(substr(Fnstr,1,1)=="?"){ - Fnstr<- substr(Fnstr,2,nchar(Fnstr)) - for (I in seq(1,length(ASSIGNLIST),by=2)){ - Tmp<- ASSIGNLIST[[I]] - if(Tmp==Fnstr){ - Out<- Mixjoin(list(I),ASSIGNLIST[I+1]) - return(Out) - } - } - Out<- "Not found" - return(Out); - } - L<- ASSIGNLIST - } - else{ - if(mode(varargin[[2]])=="numeric"){ - Fnstr<- varargin[[Nargs]] - for (I in Looprange(1,Nargs-1)){ - L[[I]]=varargin[[I]] - } - } - else{ - Fnstr<- varargin[[1]] - for (I in Looprange(2,Nargs)){ - L[[I-1]]<- varargin[[I]] - } - } - } - for (I in seq(1,length(L),by=2)){ - Vname<- L[[I]] - Val<- L[[I+1]] - if(mode(Val)=="numeric"){ - if(Nrow(Val)==1){ - for (K in Looprange(1,length(Val))){ - Tmp<- paste(Vname,"[", as.character(K),"]",sep="") - if(mode(Val[K])=="numeric"){ - Tmp1<- paste("(",as.character(Val[K]),")",sep="") - } - else{ - Tmp1<- Val[K] - } - Fnstr<- gsub(Tmp,Tmp1,Fnstr,fixed=TRUE) - } - } - else{ - for (J in Looprange(1,Nrow(Val))){ - for (K in Looprange(1,Ncol(Val))){ - Tmp<- paste(Vname,"(",as.character(J),",",as.character(K),")",sep="") - if(mode(Val[J,K])=="numeric"){ - Tmp1<- paste("(",as.character(Val[J,K]),")",sep="") - } - else{ - Tmp1<- Val[J,K] - } - Fnstr<- gsub(Tmp,Tmp1,Fnstr,fixed=TRUE) - } - } - } - if(length(Val)==1){ - Rep<- as.character(Val) - } - else{ - Rep<-"" - if(class(Val)=="matrix"){ - Rep<- "matrix(" - } - Rep<- paste(Rep,"c(",sep="") - for (J in Looprange(1,length(Val))){ - Rep<- paste(Rep,as.character(Val[J]),sep="") - if(J<length(Val)){ - Rep<- paste(Rep,",",sep="") - } - else{ - Rep<- paste(Rep,")",sep="") - } - } - if(class(Val)=="matrix"){ - Rep<- paste(Rep,",nrow=",as.character(nrow(Val)),")",sep="") - } - } - Tmp1<- paste("(",Rep,")",sep="") - } - if(mode(Val)=="character"){ - Tmp1<- Val - } - if(mode(Val)=="list"){ - Tmp1<- Makeliststr(Val) - } - Fnstr<- gsub(Vname,Tmp1,Fnstr,fixed=TRUE) # 10.11.20 - } - return(Fnstr) -} - -######################################### - -Assignadd<- function(...) -{ - varargin<- list(...) - L<- ASSIGNLIST - L<- Mixjoin(L,varargin) - ASSIGNLIST<<- L -# return("assign add done"); #17.09.17 -} - -######################################### - -Assignrep<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - L<- ASSIGNLIST - for (I in seq(1,Nargs,by=2)){ - Vname<- varargin[[I]] - Val<- varargin[[I+1]] - Tmp1<- paste("?",Vname,sep="") - Tmp<- Assign(Tmp) - if(mode(Tmp)=="character"){ - next - } - I<- Tmp[[1]] - L<- Mixjoin(L,list(Val)) - } - ASSIGNLIST<<- L -} - -######################################### - - Assignset<- function(...) -{ - Assign(...) -} - -######################################### - -Beginpicture<-function(ul) -{ ## Scaling is implemented - Tmp<- Doscaling(c(XMIN,YMIN)) - Xm<- Tmp[1] - Ym<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - XM<- Tmp[1] - YM<- Tmp[2] - Dx<- XM-Xm - Dy<- YM-Ym - Sym<-".0123456789 +-*/" - SL<-Sym - OL<-"+-*/" - if(ul!=""){ - ULEN<<-ul; - } - Is<-1; - VL<-""; - Ucode<-ULEN - for (I in Looprange(1,nchar(Ucode))){ - C<-substring(Ucode,I,I); - if(length(grep(C,SL))>0){ - if(length(grep(C,OL))>0){ - Tmp<-substring(Ucode,Is,I-1); - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1; - } - } - else{ - Unit<-substring(Ucode,I,I+1) - Str<-substring(Ucode,Is,I-1) - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)) - Str<-as.character(Valu); - ULEN<<- paste(Str,Unit,sep="") - if(Unit=="cm") MilliIn<<-1000/2.54*Valu - if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if(Unit=="in") MilliIn<<-1000*Valu - if(Unit=="pt") MilliIn<<-1000/72.27*Valu - if(Unit=="pc") MilliIn<<-1000/6.022*Valu - if(Unit=="bp") MilliIn<<-1000/72*Valu - if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; - if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; - Str<-paste("{\\unitlength=",ULEN,"%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("\\begin{picture}%\n",file=Wfile,append=TRUE) - Str<-"(" - Tmp<-as.character(round(Dx,digits=6)) - Str<-paste(Str,Tmp,",",sep="") - Tmp<-as.character(round(Dy,digits=6)) - Str<-paste(Str,Tmp,")(",sep="") - Tmp<-as.character(round(Xm,digits=6)) - Str<-paste(Str,Tmp,",",sep="") - Tmp<-as.character(round(Ym,digits=6)) - Str<-paste(Str,Tmp,")%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - Str<-paste("\\special{pn ",as.character(PenThickInit),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -################################################# - -Bowdata<- function(...) #17.09.17 -{ - varargin <- list(...) - Nargs <- length(varargin) - PA <- varargin[[1]] - PB <- varargin[[2]] - Cut <- 0 - D <- 1/2*Norm(PB-PA) - if(Nargs>=3) { - H <- varargin[[3]]*D*0.2 - } - else { - H <- D*0.2 - } - H <- min(H,D) - if(Nargs>=4){ - Cut <- varargin[[4]] - } - Ydata <- MakeBowdata(PA,PB,H) - C <- Op(1,Ydata) - r <- Op(2,Ydata) - R1 <- Op(3,Ydata) - R2 <- Op(4,Ydata) - Rng <- paste("R=c(",as.character(R1),",",as.character(R2),")",sep="") - Theta <- (R1+R2)*0.5 - BOWMIDDLE <<- list(c(C[1]+r*cos(Theta),C[2]+r*sin(Theta)),Theta) - M <- Op(1,BOWMIDDLE) - ThetaM <- Op(2,BOWMIDDLE) - BOWSTART <<- PA - BOWEND <<- PB - if(Cut==0){ - Pd<- Circledata(c(C,r),Rng) - } - else{ - Alpha <- R1; Beta <- ThetaM-Cut/(2*r) - Rng <- paste("Rng=c(",as.character(Alpha),",",as.character(Beta),")",sep="") - Pd <- Circledata(c(C,r),Rng) - Alpha <- ThetaM+Cut/(2*r); Beta <- R2 - Rng <- paste("R=c(",as.character(Alpha),",",as.character(Beta),")",sep="") - Tmp <- Circledata(c(C,r),Rng) - Pd <- Appendrow(Pd,c(Inf,Inf),Tmp) - } -} - -Bowmiddle <- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - if( Nargs==0) { - M <- BOWMIDDLE - return(M) - } - if(Nargs==1) { - Bdata <- varargin[[1]] - A <- Bdata[1,] - Dind <- Dataindex(Bdata) - Dc <- Nrow(Dind) - Tmp <- Dind[Dc,2] - B <- Bdata[Tmp,] - if(Dc==1) { - Tmp1 <- round(Tmp/2) - } - else { - Tmp1 <- Dind[1,2] - } - D <- Bdata[Tmp1,] - B <- B-A - D <- D-A - Tmp1 <- B[1]*D[2]-D[1]*B[2] - Tmp2 <- (Norm(B)^2*D[2]-B[2]*Norm(D)^2)/2 - Tmp3 <- -(Norm(B)^2*D[1]-B[1]*Norm(D)^2)/2 - C <- c(Tmp2,Tmp3)/Tmp1+A - R <- Norm(C-A) - B <- B+A - V <- (A+B)/2-C - V <- V/Norm(V) - M <- C+R*V - } - else { - A <- varargin[[1]]; B <- varargin[[2]] - D <- 1/2*Norm(B-A) - H <- 0.2*D; - if(length(varargin)>=3) { - Tmp <- varargin[[3]] - H <- Tmp*D*0.2 - } - H <- min(H,D) - Ydata <- MakeBowdata(A,B,H) - C <- Op(1,Ydata) - R <- Op(2,Ydata) - T <- (Op(3,Ydata)+Op(4,Ydata))/2 - P <- C+R*c(cos(T),sin(T)) - #M <- list(P,T) - M <- P - } - return(M) -} - -########################## -# 13.12.19 small movement supported - -Bowname<- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - Siki <- varargin[[Nargs]] - Nargs<- Nargs-1 - Dr<- "c" - if(Nargs>=1){ - Tmp<- varargin[[Nargs]] - if(is.character(Tmp)){ - Dr<- Tmp - Nargs<- Nargs-1 - } - } - if(Nargs==0){ - Siki <- varargin[[1]] - P <- Op(1,BOWMIDDLE) - } - else if(Nargs==1){ - Bdata <- varargin[[1]] - P <- Bowmiddle(Bdata) - } - else{ - A <- varargin[[1]]; B <- varargin[[2]] - D <- 1/2*Norm(B-A) - Tmp <- varargin[[3]] - if(is.character(Tmp)){ - H <- D*0.2 - } - else { - H <- Tmp*D*0.2 - } - H <- min(H,D) - Ydata <- MakeBowdata(A,B,H) - Tmp <- Bowmiddle(Ydata) - P <- Op(1,Tmp) - } - Expr(P,Dr,Siki) -} - -########################## -# 13.12.19 small movement supported -# A,B, ... no longer supported - -Bownamerot <- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - Eps <- 10^(-6) - Flg <- 1 - Tmp <- varargin[[Nargs]] - if(is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){ - Flg <- Tmp - Nargs <- Nargs-1 - } - Siki <- varargin[[Nargs]] - Nargs<- Nargs-1 - Dr<- "c" - if(Nargs>=1){ - Tmp<- varargin[[Nargs]] - if(is.character(Tmp)){ - Dr<- Tmp - Nargs<- Nargs-1 - } - } - if(Nargs==0) { - P <- Op(1,BOWMIDDLE) - A <- BOWSTART - B <- BOWEND - } - else{ - Bdata<- varargin[[1]] - P<- Bowmiddle(Bdata) - A=Bdata[1,] - B=Bdata[nrow(Bdata),] - Tm<- 0; Tv<- 0 - if(Nargs>1){ - Tm<- varargin[[2]] - if(Nargs>2){ - Tv<- varargin[[3]] - } - } - } -# else if(Nargs==2) { -# Bdata <- varargin[[1]] -# P <- Bowmiddle(Bdata) -# A <- Bdata[1,] -# B <- Bdata[Nrow(Bdata),] -# Siki <- varargin[[2]] -# } -# else { -# A <- varargin[[1]]; B <- varargin[[2]] -# D <- 1/2*Norm(B-A) -# Tmp <- varargin[[3]] -# if(mode(Tmp)=="character") { -# H <- 0.2*D; Siki <- Tmp -# } -# else { -# H <- Tmp*D*0.2; Siki <- varargin[[4]] -# } -# H <- min(H,D) -# Ydata <- MakeBowdata(A,B,H) -# C <- Op(1,Ydata) -# R <- Op(2,Ydata) -# T <- (Op(3,Ydata)+Op(4,Ydata))/2 -# P <- C+R*c(cos(T),sin(T)) -# } - if(A[1]>B[1]+Eps){ - Tmp <- A - A <- B - B <- Tmp - } - if(Flg>0) { - Tmp <- B-A - } - else{ - Tmp <- A-B - } - Exprrot(P,Tmp,Tm,Tv,Siki) -} - -CalcHeight<-function(Hoko,Moji) -{ - D<-0 - H<-substring(Hoko,1,1) - Tmp<-paste("\\settoheight{\\Height}{",Moji,"}",sep="") - Str<-c(Tmp) - Tmp=paste("\\settodepth{\\Depth}{",Moji,"}",sep="") - Str<-c(Str,Tmp) - if(H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}") - if(H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}") - if(H=="c") - { - Str<-c(Str,"\\setlength{\\Height}{-0.5\\Height}") - Str<-c(Str,"\\setlength{\\Depth}{0.5\\Depth}") - Str<-c(Str,"\\addtolength{\\Height}{\\Depth}") - } - for (I in 1:length(Str)) cat(Str[I],file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################### - -CalcWidth<-function(Hoko,Moji) -{ - D<-0; - H<-substring(Hoko,2,2) - if(H=="e") D<-0 - if(H=="w") D<--1.0 - if(H=="c") D<--0.5 - Str1<-paste("\\settowidth{\\Width}{",Moji,"}",sep="") - Tmp<-as.character(D) - Str2<-paste("\\setlength{\\Width}{",Tmp,"\\Width}",sep="") - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################### -# 17.09.17 -# 17.09.24 - -Circledata<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Cr<- varargin[[1]] - C=Cr[1:2] - if(length(Cr)==4){ - ra=Norm(C-Cr[3:4]) - Nop=2 - } - else{ - ra=Cr[3] - Nop=2 - } - R=c(0,2*pi) - N=50 - for (I in Looprange(Nop,Nargs)){ - Tmp<- varargin[[I]] - if(is.character(Tmp)){ - Tmp1=regexpr("=",Tmp) #17.09.24from - Tmp2=substring(Tmp,Tmp1+1,nchar(Tmp)) - Tmp1=substring(Tmp,1,Tmp1) - Tmp1=gsub("NUM", "N", toupper(Tmp1)) - Tmp1=gsub("RNG", "R", Tmp1) - Tmp=paste(Tmp1,Tmp2,sep="") #17.09.24until - eval(parse(text=Tmp)) - } - } - Dt<- (R[2]-R[1])/N - T <- seq(R[1],R[2],by=Dt) - X <- C[1]+ra*cos(T) - Y <- C[2]+ra*sin(T) - XY<- c(X,Y) - P<- matrix(XY,ncol=2) - return(P) -} - -######################### -# 13.12.19 - -Closefile<-function(...) -{ - varargin<- list(...) - if(length(varargin)>=1){ - Pa<- varargin[[1]] - if(is.character(Pa)){ - if(Pa=="1") Endpicture(1) - if(Pa=="0") Endpicture(0) - } - } - Wfile<<-"" -} - -######################### - -Closepar<- function() -{ - S<- "%\n\\end{minipage}" - cat(S,file=Wfile,append=TRUE) - Closephr() -} - - -#################################### - -Closephr<- function() -{ - cat("%\n}%\n",file=Wfile,append=TRUE) -} - -##################################### - -Dataindex<-function(P) -{ - # Inf;Inf : Terminator - Ndm<-c() - if(length(P)==0) return(Ndm) - N1<-1 - Flg<-0 - for (J in 1:Nrow(P)) - { - if(P[J,1]==Inf) - { - Ndm<-Appendrow(Ndm,c(N1,J-1)) - N1<-J+1; - if(P[N1,1]==Inf) - { - Flg<-1; - break; - } - } - } - if(Flg==0) - { - Ndm<-Appendrow(Ndm,c(N1,Nrow(P))) - } - if(class(Ndm)=="numeric") - { - Tmp<-matrix(Ndm,nrow=1) - Ndm<- Tmp - } - return(Ndm) -} - -################################ - -Dashline<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Nall<- Nargs; Sen<- 1 ; Gap<- 1 - Tmp<- varargin[[Nall]] - if(mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){ - Tmp1<- varargin[[Nall-1]] - if(mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){ - Sen<- Tmp1; Gap<- Tmp - Nall<- Nall-2 - } - else{ - Sen<- Tmp; Gap<- Sen - Nall<- Nall-1 - } - } - Sen<- 1000/2.54/MilliIn*Sen - Gap<- 1000/2.54/MilliIn*Gap - for (N in Looprange(1,Nall)){ - Pdata<- varargin[[N]] - if(is.numeric(Pdata)==1){ - Pdata<- list(Pdata) - } - for (II in 1:length(Pdata)){ - Figdata<- Op(II,Pdata) - Makehasen(Figdata,Sen,Gap,0) - } - } -} - -############################################## -# 17.11.27 - -Definecolor<- function(Name,Data){ - Tmp1=length(Data) - if((Tmp1<3) || (Tmp1>4)){ - cat("Size of data should be 3 or 4.") - return() - } - if(Tmp1==4){ - Tp="cmyk" - }else{ - Tp="rgb" - } - Tmp="" - for(J in 1:Tmp1){ - Tmp=paste(Tmp, as.character(Data[J]),sep="") - if(J<Tmp1){ - Tmp=paste(Tmp,",",sep="") - } - } - Tmp=paste("\\definecolor{",Name,"}{",Tp,"}{",Tmp,"}",sep="") - Texcom(Tmp) -} - -############################################## - -Diagcelldata<- function(Tb,Nc,Nr) -{ - Tmp<- Findcell(Tb,Nc,Nr) - C<- Tmp[[1]] - Dx<- Tmp[[2]] - Dy<- Tmp[[3]] - Pne<- C+c(Dx,Dy) - Pnw<- C+c(-Dx,Dy) - Psw<- C+c(-Dx,-Dy) - Pse<- C+c(Dx,-Dy) - Tmp1<- Listplot(Pnw,Pse) - Tmp2<- Listplot(Pne,Psw) - list(Tmp1,Tmp2) -} - -############################################## -# 11.01.07 - -Dividegraphics<- function(Pd) -{ - if(length(Pd)==0){ - return(Pd) - } - DtL<- Flattenlist(Pd) - OutL<- list() - for (J in 1:length(DtL)){ - Dt<- as.matrix(DtL[[J]]) - Ndm<- Dataindex(Dt) - for (I in Looprange(1,Nrow(Ndm))){ - Fd<- Dt[Ndm[I,1]:Ndm[I,2],] - OutL<- c(OutL,list(Fd)) - } - } - return(OutL) -} - -############################################## -# 13.05.03 - -Dividetable<- function(Tb) -{ - G<- Tb[[1]] - Gw<- G[[1]] - Gt<- G[Tb[[2]]] - Gy<- G[Tb[[3]]] - list(Gw,Gt,Gy) -} - -################################################ - -Doscaling<- function(G) -{ - GLg<- G - if(class(GLg)=="numeric") - { - if(LOGX==1) GLg[1]<- log(G[1], base=10) - if(LOGY==1) GLg[2]<- log(G[2], base=10) - Tmp<-c(SCALEX*GLg[1],SCALEY*GLg[2]) - return(Tmp) - } - else - { - if(LOGX==1) GLg[,1]<- log(G[,1],base=10) - if(LOGY==1) GLg[,2]<- log(G[,2],base=10) - Tmp1<-matrix(c(SCALEX,0,0,SCALEY),nrow=2) - Tmp<-GLg %*% Tmp1 - return(Tmp) - } -} - -######################################## - -Dotfilldata<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ShaL<- list() - Eps<- 0.01 - Kakudo<- 45 - Kosa<- 0.5 - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - for (N in seq(Nargs,1,by=-1)){ - Tmp<- varargin[[N]] - if(Mixtype(Tmp)!=1){ - break - } - } - if(N<Nargs){ - Kosa<- varargin[[N+1]] - } -# Kosa<- min(Kosa,1) - Tmp<- 1/(2*Kosa) - Kankaku<- Tmp*0.100*1000/2.54/MilliIn - NaitenL<- varargin[[1]] - if(Mixtype(NaitenL)==1){ - NaitenL<- list(NaitenL) - } - Ns<- 2 - StartP<- Op(1,NaitenL) - if(mode(StartP)=="character"){ - StartP<- c((Xmn+Xmx)/2,(Ymn+Ymx)/2) - } - else{ - StartP<- Doscaling(StartP) - } - Tmp<- varargin[[2]] - if(Mixtype(Tmp)==1){ - StartP<- Doscaling(Tmp) - Ns<- 3 - } - Tmp<- list() - for (I in Looprange(Ns,N)){ - Tmp<- Mixjoin(Tmp,list(varargin[[I]])) - } - Bdy<- Kyoukai(Tmp) - Bdys<-list() - for (I in 1:length(Bdy)){ - Tmp1<- Bdy[[I]] - Tmp2<- Doscaling(Tmp1) - Bdys<- Mixjoin(Bdys,list(Tmp2)) - } - Bdy<- Bdys - PtnL<- list() - for (I in Looprange(1,length(NaitenL))){ - Tmp<- Op(I,NaitenL) - if(mode(Tmp)=="numeric"){ - Tmp1<- Naigai(Tmp,Bdy) - PtnL<- Mixjoin(PtnL,list(Tmp1)) - } - else{ - if(mode(Tmp)!="character"){ - return("Mode Error") - } - Ptn<- c() - for (J in Looprange(1,nchar(Tmp))){ - if(substr(Tmp,J,J)=="i"){ - Ptn<- c(Ptn,1) - } - else{ - Ptn<- c(Ptn,0) - } - } - PtnL<- Mixjoin(PtnL,list(Ptn)) - } - } - Call<- length(Bdy) - Ptn<- c(seq(0, 0, length=Call)) - if(Member(Ptn,PtnL)){ - Wn<- Doscaling(Framedata()) - Bdy<- Mixjoin(Bdy,list(Wn)) - Tmp<- list() - for (I in Looprange(1,length(PtnL))){ - Tmp1<- c(Op(I,PtnL),1) - Tmp<- Mixjoin(Tmp,list(Tmp1)) - } - PtnL<- Tmp - } - V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180)) - Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180)) - Tmp<- Op(1,NaitenL) - if(mode(Tmp)=="numeric" && length(Tmp)==2){ - Tmp<- Doscaling(Tmp) - Delta<- Tmp-StartP - K<- trunc(Dotprod(Delta,Vm)/Kankaku) - PA<- StartP+K*Kankaku*Vm - P<- PA - Sha<- Makeshasen(PtnL,P,V,Bdy) - Sha<- Dividegraphics(Sha) - I<- 1 - while (length(Sha)>0){ - for (J in Looprange(1,length(Sha))){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if(abs(K1-Tmp)<Eps) K1=K1+1 - Tmp<- Dotprod(R-P,V)/Kankaku - K2<- floor(Tmp) - if(abs(Tmp-K2)<Eps) K2=K2-1 - for (K in Looprange(K1,K2)){ - Tmp1<- Pointdata(P+K*Kankaku*V) - ShaL<- Mixjoin(ShaL, list(Tmp1)) - } - } - P<- PA+I*Kankaku*Vm - Sha<- Makeshasen(PtnL,P,V,Bdy) - Sha<- Dividegraphics(Sha) - I<- I+1 - } - P<- PA-Kankaku*Vm - Sha<- Makeshasen(PtnL,P,V,Bdy) - I<- 2 - while (length(Sha)>0){ - for (J in 1:length(Sha)){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if(abs(K1-Tmp)<Eps) K1<- K1+1 - Tmp<- Dotprod(R-P,V)/Kankaku - K2<- floor(Tmp) - if(abs(Tmp-K2)<Eps) K2<- K2-1 - for (K in Looprange(K1,K2)){ - Tmp1<- Pointdata(P+K*Kankaku*V) - ShaL<- Mixjoin(ShaL, list(Tmp1)) - } - } - P<- PA-I*Kankaku*Vm - Sha<- Makeshasen(PtnL,P,V,Bdy) - I<- I+1 - } - } - else{ - Delta<- c(Xmn,Ymn)-StartP - K1<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymn)-StartP - K2<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymx)-StartP - K3<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmn,Ymx)-StartP - K4<- trunc(Dotprod(Delta,Vm)/Kankaku) - IM<- max(K1,K2,K3,K4) - Im<- min(K1,K2,K3,K4) - for (I in Im:IM){ - P<- StartP+I*Kankaku*Vm - Sha<- Makeshasen(PtnL,P,V,Bdy) - Sha<- Dividegraphics(Sha) - if(length(Sha)>0){ - for (J in 1:length(Sha)){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if(abs(K1-Tmp)<Eps) K1=K1+1 - Tmp<- Dotprod(R-P,V)/Kankaku - K2<- floor(Tmp) - if(abs(Tmp-K2)<Eps) K2=K2-1 - for (K in Looprange(K1,K2)){ - Tmp1<- Pointdata(P+K*Kankaku*V) - ShaL<- Mixjoin(ShaL, list(Tmp1)) - } - } - } - } - } - ShaLs<-list() - for (I in Looprange(1,length(ShaL))) - { - Tmp<- ShaL[[I]] - Tmp1<- Unscaling(Tmp) - ShaLs<- Mixjoin(ShaLs,Tmp1) - } - ShaL<- ShaLs - return(ShaL) -} - -############################################# - -Dottedline<- function(...) -{ - varargin <- list(...) - Nall <- length(varargin) - Nagasa <- 0.1 - Ookisa <- PenThick - I <- Nall - Tmp <- varargin[[I]] - while (mode(Tmp)=="numeric" && length(Tmp)==1 ) { - I <- I-1 - Tmp <- varargin[[I]] - } - if(I==Nall-1) { - Nagasa<-Nagasa*varargin[[Nall]] - Nall <- Nall-1 - } - if(I==Nall-2) { - Nagasa <- Nagasa*varargin[[Nall-1]] - Ookisa <- round(Ookisa*varargin[[Nall]]) - Nall <- Nall-2 - } - Nagasa <- 1000/2.54/MilliIn*Nagasa - for (N in 1:Nall) { - Pdata <- varargin[[N]] - if(mode(Pdata)=="numeric") { - Pdata <- list(Pdata) - } - for (II in 1:length(Pdata)) { - Clist <- MakeCurves(Op(II,Pdata)) - DinM <- Dataindex(Clist) - for (n in Looprange(1,Nrow(DinM))) { - Tmp <- DinM[n,] - Data <- Clist[Tmp[1]:Tmp[2],] - Len <- 0 - Lenlist <- c(0) - for (I in Looprange(2,Nrow(Data))) { - Len <- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist <- c(Lenlist,Len) - } - Lenall <- Lenlist[length(Lenlist)] - if(Lenall==0) { - next - } - Naga <- Nagasa - Nten <- round(Lenall/Naga)+1 - if(Nten > 1) { - Seg <- Lenall/(Nten-1) - } - else { - Seg <- Lenall - } - Eps <- 10^(-6)*Seg - PPd<-c() - Hajime <- 1 - for (I in Looprange(0,Nten-1)) { - Len <- Seg*I - if(I>0) { - J <- Hajime - while( Len>=Lenlist[J]+Eps) { - J <- J+1 - } - Hajime <- J-1 - } - T <- (Len-Lenlist[Hajime])/ - (Lenlist[Hajime+1]-Lenlist[Hajime]) - P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - PPd<-Appendrow(PPd,P) - if(I==Nten-1) { - if(Norm(P-Data[1,])<Eps) { - next - } - } - } - Str<-paste("\\special{pn ", as.character(Ookisa),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - for (I in Looprange(1,Nrow(PPd))){ - P<- Op(I,PPd) - if(Nrow(PPd)==1){ - V<- c(1,0) - } - else if(I==1){ - Tmp<- Op(I+1,PPd)-P - V<- 1/Norm(Tmp)*Tmp - } - else if(I==Nrow(PPd)){ - Tmp<- P-Op(I-1,PPd) - V<- 1/Norm(Tmp)*Tmp - } - else{ - Tmp1<- Op(I+1,PPd)-P - Tmp2<- P-Op(I-1,PPd) - Tmp3<-1/Norm(Tmp1)*Tmp1+1/Norm(Tmp2)*Tmp2 - V<- 1/Norm(Tmp3)*Tmp3 - } - Tmp<- round(MilliIn*P[1]-1/2*Ookisa*V[1]) - X<- as.character(Tmp) - Tmp<- -round(MilliIn*P[2]-1/2*Ookisa*V[2]) - Y<- as.character(Tmp) - Str<-paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Tmp<- round(MilliIn*P[1]+1/2*Ookisa*V[1]) - X<- as.character(Tmp) - Tmp<- -round(MilliIn*P[2]+1/2*Ookisa*V[2]) - Y<- as.character(Tmp) - Str<-paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("\\special{fp}",file=Wfile,append=TRUE) - if(I%%2==0){ - cat("%\n",file=Wfile,append=TRUE) - } - } - } - } - } - Tmp<-PenThick/PenThickInit - Setpen(Tmp); -} - -########################################### - -Drwline<-function(...) -{ - varargin<-list(...) - Nall<-length(varargin) - Thick<-0 - Tmp<-varargin[[Nall]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - Thick<-round(Tmp*PenThickInit) - Str<-paste("\\special{pn ", as.character(Thick),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - Nall<-Nall-1 - } - for (N in 1:Nall){ - Pdata<-varargin[[N]] - if(length(Pdata)==0) next - if(mode(Pdata)!="list") Pdata<-list(Pdata) - while(Mixtype(Pdata)==3){ # 10.07.25 - Tmp1<- list() - for(II in Looprange(1,length(Pdata))){ - Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) - } - Pdata<- Tmp1 - } # 10.07.25 - for (II in Looprange(1,length(Pdata))){ - Clist<-MakeCurves(Pdata[[II]]) - DinM<-Dataindex(Clist) - for (n in Looprange(1,Nrow(DinM))){ - Tmp<-DinM[n,] - Data<-Clist[Tmp[1]:Tmp[2],] - Mojisu<-0 - for (I in Looprange(1,Nrow(Data))){ - Tmp<-Data[I,] - X<- sprintf("%5.0f",MilliIn*Tmp[1]) # 11.07.19 - Y<- sprintf("%5.0f",-MilliIn*Tmp[2]) # 11.07.19 - Str<-paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<-Mojisu+nchar(Str) - if(Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<-0 - } - } - if(Mojisu!=0){ - cat("%\n",file=Wfile,append=TRUE) - } - cat("\\special{fp}%\n",file=Wfile,append=TRUE) - } - } - } - Str<-"%" - if(Thick>0){ - Tmp<-PenThick/PenThickInit - Setpen(Tmp) - } -} - -########################################### - -Drwpt<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - if(TenSize>TenSizeInit){ - N<- round(6*sqrt(TenSize/TenSizeInit)) - } - else{ - N<-4 - } - Tmp<- varargin[[Nargs]] - if(mode(Tmp)=="numeric"){ - if(length(Tmp)>1){ - Kosa<- 1; All<- Nargs - } - else{ - Kosa<- Tmp; All<- Nargs-1 - } - } - else if(mode(Tmp)=="list"){ - Kosa<- 1; All<- Nargs - } - CL<-c() - for (J in 0:N){ - Tmp<- TenSize*0.5*1000/2.54/MilliIn - Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) - CL<- append(CL,Tmp) - } - CL<- matrix(CL,nrow=2) - CL<- t(CL) - for (II in Looprange(1,All)){ - MS<- varargin[[II]] - MS=Flattenlist(MS) #17.10.11 - if(mode(MS)=="numeric"){ - MS<- list(MS) - } - for (I in Looprange(1,length(MS))){ - P<- MS[[I]] - if(InWindow(P)!="i") next - P<- Doscaling(P) - PL<-c() - for (J in 0:N){ - PL<- c(PL,P+CL[J+1,]) - } - PL<-matrix(PL,nrow=2) - PL<-t(PL) - Mojisu<-0 - for (J in 1:Nrow(PL)){ - Q<- PL[J,] - X<- as.character(round(MilliIn*Q[1])) - Y<- as.character(-round(MilliIn*Q[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if(Mojisu>80){ - cat("#\n",file=Wfile,append=TRUE) - } - Mojisu=0 - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- "\\special{fp}%\n" - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - } - } -} - -###################################################### - -Drwxy<-function(...) -{ - varargin<-list(...) - Nargs <- length(varargin) - Tmp<-grep("arrow", ZIKU) - if(length(Tmp)>0) - { - Arrowline(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]),ARROWSIZE) - Arrowline(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX),ARROWSIZE) - } - else - { - Drwline(Listplot(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]))) - Drwline(Listplot(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX))) - } - Letter(c(XMAX,GENTEN[2]),XPOS,XNAME) - Letter(c(GENTEN[1],YMAX),YPOS,YNAME) - Letter(GENTEN,OPOS,ONAME); -} - -########################################## -# 10.12.04 - -Enclosing<- function(...) -{ - Eps=10^(-7) # Scilab 16.12.05 - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - if(Mixtype(P)==2){ - Tmp<- Op(1,P) - if(mode(Tmp)!="numeric" || length(Tmp)>1){ - AnsL<- EnclosingS(...) - AnsL<- Joincrvs(AnsL) # 10.12.04 - } - } - Tmp1=Op(1,AnsL) # Scilab 16.12.05from - Tmp2=Op(nrow(AnsL),AnsL) - if(Norm(Tmp2-Tmp1)>Eps){ - AnsL=Appendrow(AnsL,Tmp1) - } - return(AnsL) -} - -######################################### - -EnclosingS<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - AnsL<- list() - PdataL<- varargin[[1]] - Nall<-length(PdataL) - Eps<- 10^(-3) - EEps<- 0.1 - S<- c() - Flg<- 0 - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ - S<- Tmp - } - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - if(Flg==0){ - Eps<- Tmp - Flg=Flg+1 - } - else{ - EEps<- Tmp - } - } - } - F<- Op(1,PdataL); G<- Op(Nall,PdataL) - KL<- IntersectcrvsPp(F,G) - if(length(KL)==1){ - Tmp<- Op(1,KL) - P<- Op(1,Tmp) - T1<- Op(2,Tmp) - } - if(length(KL)==0){ - if(Numptcrv(F)>Numptcrv(G)){ - Tmp<- Nearestpt(F,G) - P<- Op(1,Tmp) - T1=Op(2,Tmp) - } - else{ - Tmp<- Nearestpt(G,F) - P<- Op(3,Tmp) - T1<- Op(4,Tmp) - } - } - if(length(KL)>=2){ - if(length(S)==0){ - return("No Start Point") - } - Tmp<- Op(1,KL) - P<- Op(1,Tmp) - T1<- Op(2,Tmp) - Tmp<- Norm(P-S) - for (I in Looprange(2,length(KL))){ - Tmp1<- Op(1,Op(I,KL)) - Tmp2<- Norm(Tmp1-S) - if(Tmp2<Tmp){ - P<- Tmp1 - T1<- Op(2,Op(I,KL)) - Tmp<- Tmp2 - } - } - } - S<- P - AnsL<- list() - for (N in Looprange(1,Nall)){ - F<- Op(N,PdataL) - if(N>1) P<- Q - if(N==Nall){ - Q=S - } - else{ - Flg<- 0 - G<- Op(N+1,PdataL) - KL<- IntersectcrvsPp(G,F) - if(length(KL)==1){ - Tmp<- Op(1,KL) - Q<- Op(1,Tmp) - T3<- Op(2,Tmp) - Flg<- 10 - } - if(length(KL)==0) Flg<- 1 - if(length(KL)>=2){ # Maple bug? - Tmp1<- Op(1,Op(1,KL)) - Tmp2<- Op(1,Op(2,KL)) - Tmp<- Norm(Tmp1-Tmp2) - if(Tmp<Eps*10) Flg<- 1 - } - if(Flg==1){ - if(Numptcrv(F)>Numptcrv(G)){ - Tmp<- Nearestpt(F,G) - Q<- Op(1,Tmp) - T3<- Op(4,Tmp) - Flg<- 10 - } - else{ - Tmp<- Nearestpt(G,F) - Q<- Op(3,Tmp) - T3<- Op(2,Tmp) - Flg<- 10 - } - } - if(Flg<10){ - T2<- Inf - for (I in Looprange(1,length(KL))){ - Dt<- Op(I,KL) - Tmp1<- Op(1,Dt) - Tmp<- Op(3,Dt) - Tmp2<- Paramoncurve(Tmp1,Tmp,F) - Tmp3<- Op(2,Dt) - if(Tmp2>T1+Eps && Tmp2<T2-Eps){ - Q<- Tmp1 - T2<- Tmp2 - T3<- Tmp3 - } - } - } - } - Tmp<- Partcrv(P,Q,F) - T1<- T3 - AnsL<- Mixjoin(AnsL,list(Tmp)) - } - return(AnsL) -} - -######################################## - -Endpicture<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - if(Nargs==0) - { - Drwxy() - } - else - { - if(varargin[[1]]==1) Drwxy() - } - cat("\\end{picture}}%",file=Wfile,append=TRUE) -# MEMORI<<-MEMORINow*1000/2.54/MilliIn - Setunitlen("1cm") -} - -######################################### - -Execmd<- function(StrL) -{ - if(mode(StrL)=="character" && length(StrL)==1){ - StrL<- list(StrL) - } - for (I in Looprange(1,length(StrL))){ - if(!is.na(Op(I,StrL)) && nchar(Op(I,StrL))>0){ - eval(parse(text=Op(I,StrL))) - } - } -} - -######################################### - -Expr<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - Irng<-c(seq(from=1,to=Nargs,by=3)) - for (I in Irng) - { - Tmp<-varargin[[I]] - P<- Doscaling(Tmp) - X<-P[1] - Y<-P[2] - Houkou<-varargin[[I+1]] - Mojiretu<-paste("$",varargin[[I+2]],"$",sep="") - Hset<-Houkou - Vhoko<-"c" - if(length(grep("n",Hset))>0) - { - Vhoko<-"n"; Y<-Y+MEMORI - } - if(length(grep("s",Hset))>0) - { - Vhoko<-"s"; Y<-Y-MEMORI - } - Hhoko<-"c" - if(length(grep("e",Hset))>0) - { - Hhoko<-"e"; X<-X+MEMORI - } - if(length(grep("w",Hset))>0) - { - Hhoko<-"w"; X<-X-MEMORI - } - Hoko<-paste(Vhoko,Hhoko,sep="") - Suu<-"+-.0123456789" - SuuL<-Suu - J<-1; Dstr<-"" - while (J<=nchar(Houkou)) - { - Tmp<-substring(Houkou,J,J) - if(length(grep(Tmp,Suu))>0) - { - if(Dstr=="") Hk<-substring(Houkou,J-1,J-1) - Dstr<-paste(Dstr,Tmp,sep="") - } - else - { - if(Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI - if(Hk=="n") Y<-Y+D - if(Hk=="s") Y<-Y-D - if(Hk=="e") X<-X+D - if(Hk=="w") X<-X-D - Dstr<-"" - } - } - J<-J+1 - } - if(Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI; - if(Hk=="n") Y<-Y+D - if(Hk=="s") Y<-Y-D - if(Hk=="e") X<-X+D - if(Hk=="w") X<-X-D - } - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - cat("\\put(",file=Wfile,append=TRUE) - Tmp1<- sprintf("%7.7f",X) # 11.07.19 - Tmp2<- sprintf("%7.7f",Y) # 11.07.19 - Str<-paste(Tmp1,",",Tmp2,sep="") - cat(Str,file=Wfile,append=TRUE) - Tmp<-"){\\hspace*{\\Width}" - Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) - } -} - -########################################## - -Exprrot<- function(...) -{ - varargin<- list(...) - P<- varargin[[1]] - V<- varargin[[2]]; N<- 3 - P<- Doscaling(P) - V<- Doscaling(V) - Tmov<- 0 - Tmp<- varargin[[N]] - if(mode(Tmp)=="numeric"){ - Tmov<- Tmp; N<- N+1 - } - Nmov<- 0 - Tmp<- varargin[[N]] - if(mode(Tmp)=="numeric"){ - Nmov<- Tmp; N<- N+1 - } - Mojiretu<- paste("$",Assign(varargin[[N]]),"$",sep="") # 2017.11.26 - Tv<- 1/Norm(V)*V - Nv<- c(-Tv[2],Tv[1]) - P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv - Tmp<- acos(V[1]/Norm(V)) - Theta<- round(Tmp*180/pi) - if(V[2]>=0){ - Units<- "" - } - else{ - Units<- "units=-360," - } - Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") - Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") - Letter(P,"c",Tmp) -} - -###################################################### - -Findcell<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - Ag<- varargin[[2]] - Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" - if(mode(Ag)=="character"){ - Clm<- c() - Rstr<- "" - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,I,I) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - else{ - Rstr<- paste(Rstr,C,sep="") - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - Mrg<- eval(parse(text=Rstr)) - if(Nargs>=3){ - Ag<- varargin[[3]] - Clm<- c() - Rstr<- "" - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,1,1) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - if(length(Tmp)>1){ - Clm<- c(Clm,Tmp+1) - } - else{ - Rstr<- paste(Rstr,C,sep="") - } - } - Nrg2<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length[Clm]-I - Nrg2<- Nrg2+Tmp*26^Tmp1 - } - Nrg<- c(Nrg,Nrg2) - Tmp=eval(parse(text=Rstr)) - Mrg<- c(Mrg,Tmp) - } - } - else{ - Nrg<- varargin[[2]] - Mrg<- varargin[[3]] - } - if(length(Mrg)==1){ - m1<- Mrg; m2<- m1+1 - } - else{ - m1<- Mrg[1]; m2<- Mrg[2] # 10.12.12 - } - if(length(Nrg)==1){ - n1<- Nrg; n2<- n1+1 - } - else{ - n1<- Nrg[1]; n2<- Nrg[2] - } - n1<- n1+1; n2<- n2+1 - m1<- m1+1; m2<- m2+1 - Hind<- TbL[[2]] - Vind<- TbL[[3]] - Tmp<- TbL[[1]] - HL<- Tmp[Hind] - Tmp1<- Op(1,TbL[[4]]) - Tmp2<- Op(2,TbL[[4]]) - HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) - VL<- Tmp[Vind] - Tmp1<- Op(1,TbL[[5]]) - Tmp2<- Op(2,TbL[[5]]) - VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) - Tmp<- TbL[[6]] - Tmp1<- Listplot(c(Ptsw(Tmp),Ptnw(Tmp))) - Tmp2<- Listplot(c(Ptse(Tmp),Ptne(Tmp))) - HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) - Tmp1<- Listplot(c(Ptnw(Tmp),Ptne(Tmp))) - Tmp2<- Listplot(c(Ptsw(Tmp),Ptse(Tmp))) - VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) - Tmp<- HL[[n1]] - if(mode(Tmp)=="numeric"){ - H1<- Tmp[1,1] - } - else{ - Tmp1<- Tmp[[1]] - H1<- Tmp1[1,1] - } - Tmp<- HL[[n2]] - if(mode(Tmp)=="numeric"){ - H2<- Tmp[1,1] - } - else{ - Tmp1<- Tmp[[1]] - H2<- Tmp1[1,1] - } - Tmp<- VL[[m1]] - if(mode(Tmp)=="numeric"){ - V1<- Tmp[1,2] - } - else{ - Tmp1<- Tmp[[1]] - V1<- Tmp1[1,2] - } - Tmp<- VL[[m2]] - if(mode(Tmp)=="numeric"){ - V2<- Tmp[1,2] - } - else{ - Tmp1<- Tmp[[1]] - V2<- Tmp1[1,2] - } - Pt<- c((H1+H2)/2,(V1+V2)/2) - High<- (V1-V2)/2 - Wide<- (H2-H1)/2 - Out<- list(Pt,Wide,High) - return(Out) -} - -############################################ - -Flattenlist<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Out<- list() - for(N in Looprange(1,Nargs)){ - D<- varargin[[N]] - if(is.data.frame(D) || !is.list(D)){ # modify - Out<- c(Out,list(D)) - } - else{ - for(I in Looprange(1,length(D))){ - Ds<- D[[I]] - Tmp<- Flattenlist(Ds) - Out<- c(Out,Tmp) - } - } - } - return(Out) -} - -############################################ - -Fontsize<- function(Ookisa) -{ - Str<- "%" - S<- substr(Ookisa,1,1) - if(S=="n"){ - Str<- "\\normalsize%" - } - if(S=="s"){ - if(nchar(Ookisa)==1){ - Tmp<- "n" - } - else{ - Tmp<- substr(Ookisa,2,2) - } - if(Tmp=="s"){ - Str<- "\\scriptsize%" - } - else{ - Str<- "\\small%" - } - } - if(S=="f"){ - Str<- "\\footnotesize%" - } - if(S=="t"){ - Str<- "\\tiny%" - } - if(S=="l"){ - Str<- "\\large%" - } - if(S=="L"){ - if(nchar(Ookisa)==1){ - Tmp<- "a" - } - else{ - Tmp<- substr(Ookisa,2,2) - } - if(Tmp=="a"){ - Str<- "\\Large%" - } - else{ - Str<- "\\LARGE%" - } - } - if(S=="h"){ - Str<- "\\huge%" - } - if(S=="H"){ - Str<- "\\Huge%" - } - cat(Str,file=Wfile,append=TRUE) - cat("\n",file=Wfile,append=TRUE) -} - -########################################## - -Fracform<- function(...) -{ - varargin<- list(...) - Eps<- 10^(-10) - Nmax<- 1/Eps - Nargs<- length(varargin) - X<- varargin[[1]] - Nr<- Nrow(X) - X<- as.matrix(X,nrow=Nr) - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)!="numeric"){ - next - } - if(Tmp>1){ - Nmax<- Tmp - } - else if(Tmp>0){ - Eps<- Tmp - } - } - Tmp<- rep("",length(X)) - Out<- matrix(Tmp,nrow=nrow(X)) - for (I in Looprange(1,nrow(X))){ - for (J in Looprange(1,ncol(X))){ - Dt<- X[I,J] - if(mode(Dt)=="character"){ - Dt<- eval(parse(text=Dt)) - } - R<- 1 - N<- 0 - Rmin<- R - Nr<- N - while (R>Eps && N<Nmax){ - N<- N+1 - M<- round(Dt*N) - R<- abs(Dt-M/N) - if(R<Rmin){ - Rmin<- R - Nr<- N - } - } - if(N==Nmax){ - N<- Nr - M<- round(Dt*N) - } - Tmp<- as.character(M) - if(N!=1){ - Tmp<- paste(Tmp,"/",as.character(N),sep="") - } - Out[I,J]<- Tmp - } - } - if(nrow(Out)==1){ - Out<- as.character(Out) - } - return(Out) -} - -############################################## -# 2011.12.17 ( list ) - -Framedata<-function(...) -{ - varargin<- Flattenlist(list(...)) - N<-length(varargin) - if(N<= 1){ - H<- 1.0*10^(-4); - PA<-c(XMIN+H,YMIN+H) - PB<-c(XMAX-H,YMIN+H) - PC<-c(XMAX-H,YMAX-H) - PD<-c(XMIN+H,YMAX-H) - } - else{ - Tmp<-varargin[[N]] - if(is.numeric(Tmp) && length(Tmp)==1){ - Dy<-Tmp; Dx<-Dy - Tmp<-varargin[[N-1]] - if(is.numeric(Tmp) && length(Tmp)==1){ - Dx<-Tmp - } - Tmp<-varargin[[1]] - X<-Tmp[1]; Y<-Tmp[2] - X1<-X-Dx; X2<-X+Dx; Y1<-Y-Dy; Y2<-Y+Dy - } - else{ - Tmp<-varargin[[1]] - X1<-Tmp[1]; X2<-Tmp[2] - Tmp<-varargin[[2]] - Y1<-Tmp[1]; Y2<-Tmp[2] - } - PA<-c(X1,Y1); PB<-c(X2,Y1) - PC<-c(X2,Y2); PD<-c(X1,Y2) - } - Out<- Listplot(c(PA,PB,PC,PD,PA)) - return(Out) -} - -################################### - -Hatchdata<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - ShaL<- list() - Nargs<- length(varargin) - Kakudo<- 45 - Kankaku<- 0.125*1000/2.54/MilliIn - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - for (N in seq(Nargs,1, by=-1)) - { - Tmp<- varargin[[N]] - if(mode(Tmp)=="list") - { - break - } - } - if(N<Nargs) - { - Kakudo<- varargin[[N+1]] - if(N==Nargs-2) - { - Kankaku<- 0.125*varargin[[Nargs]] - } - } - NaitenL<- varargin[[1]] - if(mode(NaitenL)!="list") - { - NaitenL<- list(NaitenL) - } - Ns<- 2 - StartP<- Op(1,NaitenL) - if(mode(StartP)=="character") - { - StartP<- c((Xmn+Xmx)/2, (Ymn+Ymx)/2) - } - if(mode(varargin[[2]])=="numeric") - { - StartP<- varargin[[2]] - StartP<- Doscaling(StartP) - Ns<- 3 - } - Tmp<- list() - for ( I in Looprange(Ns,N)) - { - Tmp1<- list(varargin[[I]]) - Tmp2<- Mixjoin(Tmp, Tmp1) - Tmp<- Tmp2 - } - Bdy<- Kyoukai(Tmp) - Bdys<-list() - for (I in 1:length(Bdy)) - { - Tmp1<- Bdy[[I]] - Tmp2<- Doscaling(Tmp1) - Bdys<- Mixjoin(Bdys,list(Tmp2)) - } - Bdy<- Bdys - PtnL<- list() - for (I in Looprange(1,length(NaitenL))) - { - Tmp<- Op(I, NaitenL) - if(mode(Tmp)=="numeric") - { - Tmp1<- Naigai(Tmp,Bdy) - Tmp2<- Mixjoin(PtnL, list(Tmp1)) - PtnL<- Tmp2 - } - else - { - if(mode(Tmp)!="character") - { - return("Mode Error") - } - Ptn<-c() - for (J in 1:nchar(Tmp)) - { - if(Op(J,Tmp)=="i") - { - Ptn<- c(Ptn,1) - } - else - { - Ptn<- c(Ptn,0) - } - } - PtnL<- Mixjoin(PtnL, list(Ptn)) - } - } - Call<- length(Bdy) - Ptn<- c(seq(0, 0, length=Call)) - if(Member(Ptn,PtnL)) - { - Wn<- Doscaling(Framedata()) - Tmp<- Mixjoin(Bdy,list(Wn)) - Bdy<- Tmp - Tmp<- list() - for (I in Looprange(1, length(PtnL))) - { - Tmp1<- c(Op(I,PtnL),1) - Tmp2<- Mixjoin(Tmp,list(Tmp1)) - Tmp<- Tmp2 - } - PtnL<- Tmp - } - V<- c(cos(Kakudo*pi/180),sin(Kakudo*pi/180)) - Vm<- c(-sin(Kakudo*pi/180),cos(Kakudo*pi/180)) - Tmp<- Op(1,NaitenL) - if(mode(Tmp)=="numeric" && length(Tmp)==2) - { - Tmp<- Doscaling(Tmp) - Delta<- Tmp-StartP - K<- trunc(Dotprod(Delta,Vm)/Kankaku) - PA<- StartP+K*Kankaku*Vm - Sha<- Makeshasen(PtnL,PA,V,Bdy) - I <- 1 - while (length(Sha)>0) - { - Tmp<- Mixjoin(ShaL, list(Sha)) - ShaL <- Tmp - Sha<- Makeshasen(PtnL,PA+I*Kankaku*Vm,V,Bdy) - I <- I+1 - } - Sha<- Makeshasen(PtnL,PA-Kankaku*Vm,V,Bdy) - I<- 2 - while (length(Sha)>0) - { - for (J in 1:length(Sha)) - { - Tmp<- Mixjoin(ShaL,list(Sha[[J]])) - ShaL<- Tmp - } - Sha<- Makeshasen(PtnL,PA-I*Kankaku*Vm,V,Bdy) - I<- I+1 - } - } - else - { - Delta<- c(Xmn,Ymn)-StartP - K1<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymn)-StartP - K2<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymx)-StartP - K3<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmn,Ymx)-StartP - K4<- trunc(Dotprod(Delta,Vm)/Kankaku) - IM<- max(K1,K2,K3,K4) - Im<- min(K1,K2,K3,K4) - for (I in Im:IM) - { - Sha<- Makeshasen(PtnL,StartP+I*Kankaku*Vm,V,Bdy) - for (J in Looprange(1,length(Sha))) - { - Tmp<- Mixjoin(ShaL, list(Sha[[J]])) - ShaL<- Tmp - } - } - } - ShaLs<-list() - for (I in Looprange(1,length(ShaL))) - { - Tmp<- ShaL[[I]] - Tmp1<- Unscaling(Tmp) - Tmp2<- Mixjoin(ShaLs, list(Tmp1)) - ShaLs<- Tmp2 - } - ShaL<- ShaLs - return(ShaL) -} - -###################################### - -Htickmark<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if(mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if(K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if(is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if(J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if(is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if(is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if(mode(Dt)=="numeric" && length(Dt)>1){ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt[1],Dt[2]) - next - } - if(mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt,GENTEN[2]) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y+MARKLEN)) - Tmp2<- Unscaling(c(X,Y-MARKLEN)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if(Ndt==3){ - Tmp<-Unscaling(c(X,Y-MARKLEN)) - Expr(Tmp,"s",Moji) - } - if(Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("s",Houkou) - if(length(Tmp)>0){ - Tmp<-Unscaling(c(X,Y-MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y+MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -############################################# -# 2013.08.07 - -Integrate<- function(Fs,Vs, Intv){ - if(is.function(Fs)){ - Fn<- Fs - } - else{ - Str<- paste("Fn<- function(",Vs, ") ", Fs, sep="") - eval(parse(text=Str)) - } - Tmp<- integrate(Fn, Intv[[1]], Intv[[2]]) - Out<- Tmp[[1]] - return(Out) -} - -############################################# - -Intersectcrvs<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - Eps<-10^(-4) - Tmp<-varargin[[Nargs]] - if(mode(Tmp)=="numeric" && length(Tmp)==1) - { - Eps<-Tmp - } - G1<-varargin[[1]] - if(mode(G1)=="numeric") - { - G1<-list(G1) - } - G2<-varargin[[2]] - if(mode(G2)=="numeric") - { - G2<-list(G2) - } - PL<-list() - for (N in 1:length(G1)) - { - for (M in 1:length(G2)) - { - KL<-IntersectcrvsPp(G1[[N]],G2[[M]],Eps) - for (I in Looprange(1,length(KL))) - { - Tmp<-KL[[I]] - P<-Tmp[1] - PL<-append(PL,P) - } - } - } - return(PL) -} - -########################################### - -IntersectcrvsPp<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - G1<-varargin[[1]]; G2<-varargin[[2]] - Eps<- 10.0^(-4) - if(Nargs>2) Eps<-varargin[[3]] - SqEps<- 10.0^(-10) - Eps2<- 0.1 - if(Nargs>3) Eps2<-varargin[[4]] - Data1<-G1 - Data2<-G2 - if(Nrow(Data1)==Nrow(Data2)) - { - Tmp<-seq(Nrow(Data2),1, by=-1) - Tmp1<-Data2[Tmp,] - Eps0<-10^(-6) - Tmp2<-Norm(Data1-Data2) - Tmp3<-Norm(Data1-Tmp1) - if(Tmp2<Eps0||Tmp3<Eps0) - { - KL<-list() - return(KL) - } - } - KL1<-list() - KL2<-list() - for (I in Looprange(1,Nrow(Data1)-1)) - { - A<-Data1[I,] - B<-Data1[I+1,] - for (J in Looprange(1,Nrow(Data2)-1)) - { - P<-Data2[J,]; Q<-Data2[J+1,] - Tmp<-Koutenseg(A,B,P,Q,Eps,Eps2) - if(mode(Tmp)=="list") - { - if(Tmp[[3]]==0) - { - Tmp1<-list(Tmp[[1]],Tmp[[2]],I,J) - KL1<-append(KL1,list(Tmp1)) - } - else - { - Tmp2<-list(Tmp[[1]],Tmp[[2]],I,J) - KL2<-append(KL2, list(Tmp2)) - } - } - } - } - KL<-list() - if(length(KL1)>0) - { - Tmp<-KL1[[1]] - P<-Tmp[[1]] - T<-Tmp[[2]] - I<-Tmp[[3]] - J<-Tmp[[4]] - Tmp<-list(P,I+T,J) - KL<-list(Tmp) - } - for (N in Looprange(2,length(KL1))) - { - Tmp<-KL1[[N]] - P<-Tmp[[1]] - Flg<-0 - for (K in 1:length(KL)) - { - if(1>length(KL)) break - Tmp<-KL[[K]] - if(Norm(P-Tmp[[1]])^2<SqEps) - { - Flg<-1 - break - } - } - if(Flg==0) - { - Tmp<-KL1[[N]] - T<-Tmp[[2]] - I<-Tmp[[3]] - J<-Tmp[[4]] - Tmp<-list(P,I+T,J) - KL<-append(KL,list(Tmp)) - } - } - for (N in Looprange(1,length(KL2))) - { - Tmp<-KL2[[N]] - P<-Tmp[[1]] - Flg<-0 - for (K in Looprange(1,length(KL))) - { - Tmp<-KL[[K]] - if(Norm(P-Tmp[[1]])^2<SqEps) - { - Flg<-1 - break - } - } - if(Flg==0) - { - Tmp<-KL2[[N]] - T<-Tmp[[2]] - T<-min(max(T,0),1) - I<-Tmp[[3]] - J<-Tmp[[4]] - Tmp<-list(P,I+T,J) - KL<-append(KL,list(Tmp)) - } - } - return(KL) -} - -########################################### -# 13.12.20 debugged - -Invdashline<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Nall<- Nargs; Sen<- 1 ; Gap<- 1 - Tmp<- varargin[[Nall]] - if(is.numeric(Tmp) && length(Tmp)==1 && Tmp>0){ # 13.12.20 - Tmp1<- varargin[[Nall-1]] - if(is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20 - Sen<- Tmp1; Gap<- Tmp - Nall<- Nall-2 - } - else{ - Sen<- Tmp; Gap<- Sen - Nall<- Nall-1 - } - } - Sen<- 1000/2.54/MilliIn*Sen - Gap<- 1000/2.54/MilliIn*Gap - for (N in Looprange(1,Nall)){ - Figdata<- varargin[[N]] - Makehasen(Figdata,Sen,Gap,1) - } -} - -######################################### - -Invert<- function(Pd) -{ - OutL=Pd[nrow(Pd):1,] - return(OutL) -} - -############################################ - -InWindow<-function(PA) -{ - Eps<-10.0^(-6); - if((length(PA)==2)&(is.numeric(PA))){ # 17.11.20 - X<-PA[1]; Y<-PA[2]; - if(X>XMIN-Eps && X<XMAX+Eps && Y>YMIN-Eps && Y<YMAX+Eps) - Rx<-"i" - else - Rx<-"o" - return(Rx) - }else{ - return("o") - } -} - -####################################### - -Joincrvs<- function(...) -{ - varargin<- list(...) - Nall<- length(varargin) - Eps<- 10^(-4) - Tmp<- varargin[[Nall]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - Eps<- Tmp - Nall<- Nall-1 - } - QdL<- Flattenlist(varargin[1:Nall]) # 11.06.25 - if(length(QdL)==0){ - PtL<-c() - return(PtL) - } - PtL<- Op(1,QdL) - for (I in Looprange(2,length(QdL))){ - Qd<- Op(I,QdL) - if(Numptcrv(Qd)<=1){next} # 11.06.25 - P<- Ptend(PtL) - S<- Ptstart(PtL) - Q<- Ptstart(Qd) - R<- Ptend(Qd) - MN<- min(Norm(P-Q),Norm(P-R),Norm(S-Q),Norm(S-R)) - if(MN==Norm(P-R)){ - Qd<- Invert(Qd) - } - else if(MN==Norm(S-Q)){ - PtL=Invert(PtL) - } - else if(MN==Norm(S-R)){ - PtL<- Invert(PtL) - Qd<- Invert(Qd) - } - if(MN>Eps){ - PtL<- Appendrow(PtL,Qd) - } - else{ - if(is.null(nrow(Qd))){ Qd<- as.matrix(Qd,nrow=1)} - PtL<- Appendrow(PtL,Qd[2:nrow(Qd),]) # 11.06.25 - } - } - return(PtL) -} - -######################################## -# 2011.11.02 - -Joingraphics<- function(...) -{ - varargin<- list(...) - Ls<- Flattenlist(varargin) - N<- length(Ls) - Tp<- Ls[[N]] - Listflg<- 0 - if( is.character(Tp)){ - Tmp<- toupper(substr(Tp,1,1)) - if(Tmp=="L"){ - Listflg<- 1 - } - N<- N-1 - Ls<- Ls[1:N] - } - if(Listflg==1){ - P<- Ls - } - else{ - P<- c() - for (I in 1:N){ - Tmp<- Ls[[I]] - P<- Appendrow(P,c(Inf,Inf)) - P<- Appendrow(P,Tmp) - } - P<- P[2:nrow(P),] - } - return(P) -} - -######################################## - -Kouten<- function(PA,V,P,Q) -{ - Eps<- 10.0^(-6) - A1<- PA[1]; A2<- PA[2] - V1<- V[1]; V2<- V[2] - P1<- P[1]; P2<- P[2] - U1<- Q[1]-P1; U2<- Q[2]-P2 - Tmp<- Norm(P-Q)*Norm(V) - if(Tmp==0) - { - Out<- list(Inf,-Inf) - return(Out) - } - D<- U1*V2-U2*V1 - if(abs(D)/Tmp<Eps) - { - Out<- list(Inf,-Inf) - return(Out) - } - S<- ((-A2+P2)*V1+(A1-P1)*V2)/D - if(S>1+Eps || S<Eps) - { - Out<-list(Inf,-Inf) - return(Out) - } - T<- ((-A2+P2)*U1+(A1-P1)*U2)/D - Tmp<- PA+T*V - Out<- list(T,Tmp,sign(D)) - return(Out) -} - -########################################## - -KoutenList<- function(PA,V,Bdy) -{ - Eps<-10.0^(-6) - TenL<-list() - for (N in 1:length(Bdy)) - { - KL<- Op(N,Bdy) - for (K in Looprange(1, Nrow(KL)-1)) - { - P<- Op(K,KL); Q<- Op(K+1,KL) - if(P!="/" && Q!="/") - { - Tmp<- Kouten(PA,V,P,Q); - if(Tmp[[1]]!=Inf) - { - Ten<- append(Tmp,N) - Flg<- 0 - NN<- length(TenL) - I<- 1 - while (Flg==0 && I<=NN) - { - Tmp<- Op(I,TenL) - if(Op(1,Ten)<Op(1,Tmp)-Eps) - { - Tmp1<- TenL[Looprange(1,I-1)] - Tmp2<- TenL[Looprange(I,length(TenL))] - TenL<- Mixjoin(Tmp1,list(Ten),Tmp2) - Flg<-1 - } - else - if(Op(1,Ten)<Op(1,Tmp)+Eps) - { - if(Op(4,Ten)!=Op(4,Tmp)) - { - Tmp1<- TenL[Looprange(1,I-1)] - Tmp2<- TenL[Looprange(I,length(TenL))] - TenL<- Mixjoin(Tmp1,list(Ten),Tmp2) - Flg<-1 - } - else - if(Op(3,Ten)!=Op(3,Tmp)) - { - Tmp1<- TenL[Looprange(I,I-1)] - Tmp2<- TenL[Looprange(I+1,length(TenL))] - TenL<- Mixjoin(Tmp1,Tmp2) - } - Flg<- 1 - } - I<- I+1 - } - if(Flg==0) - { - TenL<- Mixjoin(TenL,list(Ten)) - } - } - } - } - } - return(TenL) -} - -########################################## - -Koutenseg<-function(...) -{ - #pointdata on AB at which AB intersects CD - varargin<-list(...) - Nargs<-length(varargin) - Eps0 <- 10^(-4) - A<-varargin[[1]]; V<-varargin[[2]]-A - Sv2 <- V[1]^2+V[2]^2 - if(Sv2<10^(-6)) - { - Out<-Inf - return(Out) - } - P<-varargin[[3]]-A; Q<-varargin[[4]]-A - Eps <- 10.0^(-3) - if(Nargs>=5) - { - Eps<-varargin[[5]] - } - Eps2 <- 0.2 - if(Nargs>=6) - { - Eps2<-varargin[[6]] - } - Eps<-min(Eps2,Eps/sqrt(Sv2)) - P1<-(P[1]*V[1]+P[2]*V[2])/Sv2 - P2<-(-P[1]*V[2]+P[2]*V[1])/Sv2 - Q1<-(Q[1]*V[1]+Q[2]*V[2])/Sv2 - Q2<-(-Q[1]*V[2]+Q[2]*V[1])/Sv2 - m1 <- -Eps; M1 <- 1+Eps - m2 <- -Eps; M2 <- Eps - if(max(P1,Q1)<m1 || min(P1,Q1)>M1) - { - Out<-Inf - return(Out) - } - if(max(P2,Q2)<m2 || min(P2,Q2)>M2) - { - Out<-Inf - return(Out) - } - if(P2*Q2<0) - { - T<- P1-(Q1-P1)/(Q2-P2)*P2 - if(T>m1 && T<M1) - { - if(T > -Eps0 && T<1+Eps0) - { - Tmp1<-A+T*V - Tmp2<-min(max(T,0),1) - Out<-list(Tmp1,Tmp2,0) - } - else - { - Tmp1<-A+T*V - Tmp2<-min(max(T,0),1) - Out<-list(Tmp1,Tmp2,1) - } - return(Out) - } - if(P1<m1 || P1>M1 || P2<m2 || P2>M2) - { - if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2) - { - Out<-Inf - return(Out) - } - T<-min(max(Q1,0),1) - Tmp=A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - T<-min(max(P1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if(P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0) - { - T<- P1 - Tmp<- A+T*V - Out<- list(Tmp, T, 0) - return(Out) - } - if(Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2<Eps0) - { - T<- Q1 - Tmp<-A+T*V - Out<- list(Tmp,T,0) - return(Out) - } - if(P1<m1 || P1>M1 || P2<m2 || P2>M2) - { - if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2) - { - Out<-Inf - return(Out) - } - T<-min(max(Q1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if(Q1<m1 || Q1>M1 || Q2<m2 || Q2>M2) - { - T<-min(max(P1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if(abs(P2)<abs(Q2)) - { - T<-min(max(P1,0),1) - } - else - { - T<-min(max(Q1,0),1) - } - Tmp<A+T*V - Out<-list(Tmp,T,1) - return(Out) -} - -########################################## - -Kukeiwake<- function(PL) -{ - Eps<-10.0^(-6) - NW<- c(XMIN,YMAX); SW<-c(XMIN,YMIN) - SE<- c(XMAX,YMIN); NE<-c(XMAX,YMAX) - Tmp<-matrix(c(NW,SW,SE,NE,NW),nrow=2) - Sikaku<- t(Tmp) - Kt<- IntersectcrvsPp(PL,Sikaku) - if(length(Kt)!=2) - { - print("not two points") - return(c()) - } - Tmp<- Op(1,Kt) - Pt1<- Op(1,Tmp) - N1<- trunc(Op(2,Tmp)) - M1<- Op(3,Tmp) - Tmp<- Op(2,Kt) - Pt2<- Op(1,Tmp) - N2<- trunc(Op(2,Tmp)) - M2<- Op(3,Tmp) - T1<- Paramoncurve(Pt1,M1,Sikaku) #18.02.06 - T2<- Paramoncurve(Pt2,M2,Sikaku) - QL<c() - if(Norm(Pt1-Op(N1+1,PL))>Eps) - { - QL<-Pt1 - } - Tmp<-Appendrow(QL,PL[(N1+1):N2,]) - QL<- Tmp - if(Norm(Pt2-Op(N2,PL))>Eps) - { - Tmp<-Appendrow(QL,Pt2) - QL<- Tmp - } - HidariL<- QL - Ms<- M2+1; Me<- M1 - if(T1<T2+Eps) Me<- M1+4 - for (M in Looprange(Ms,Me)) - { - Tmp<- Op(Nrow(HidariL),HidariL) - P<-Op(((M-1) %% 4)+1,Sikaku) - if(Norm(Tmp-P)>Eps) - { - Tmp<-Append(HidariL,P) - HidariL<-Tmp - } - } - Tmp<- Op(Nrow(HidariL),HidariL) - if(Norm(Tmp-Pt1)>Eps) - { - Tmp<-Append(HidariL,Pt1) - HidariL<-Tmp - } - MigiL<- QL - Ms<- M2; Me<- M1+1 - if(T1>T2-Eps) Me<- Me-4 - for (Mm in Looprange(Me,Ms)) - { - M<- Me+Ms-Mm - Tmp<- Op(Nrow(MigiL),MigiL) - P<- Op(((M-1) %% 4)+1,Sikaku) - if(Norm(Tmp-P)>Eps) - { - Tmp<-Appendrow(MigiL,P) - MigiL<-Tmp - } - } - Tmp<- Op(Nrow(MigiL),MigiL) - if(Norm(Tmp-Pt1)>Eps) - { - Tmp<-Appendrow(MigiL,Pt1) - MigiL<-Tmp - } - Out<- list(HidariL,MigiL) - return(Out) -} - -################################### -# 17.09.24 Eps - -Kyoukai<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps0<- 10^(-7) - DataL<-list() - for (I in 1:Nargs){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - DataL<- Mixjoin(DataL,list(list(Tmp))) - } - if(mode(Tmp)=="list"){ - if(mode(Tmp[[1]])!="list"){ - DataL<- Mixjoin(DataL, list(Tmp)) - } - else{ - DataL<-Mixjoin(DataL,Tmp) - } - } - } - Eps<- 10.0^(-4) #17.09.24 - PLall<- list() - Sflg<- 0 - N<- length(DataL) - for (I in Looprange(1,N)){ - Data<- Op(I, DataL) - Tmp<- Op(length(Data),Data) - if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ - Rg<-Tmp ; Nd<-length(Data)-1 - } - else{ - if(mode(Tmp)=="character"){ - Rg<- Tmp ; Nd<-length(Data)-1 - } - else{ - Rg<- "c" ; Nd<-length(Data) - } - } - for (J in Looprange(1,Nd)){ - Tmp<- Op(J,Data) - if(mode(Tmp)=="character"){ - Rg<- Tmp - next - } - Points<- Tmp - P1<- Ptstart(Points) - P2<- Ptend(Points) - if(J==1){ - PL<- Points - Pfirst<- P1 - Plast<- P2 - if(Nd>=2){ - Tmp<- Op(2,Data) - P<- Ptstart(Tmp) - Q<- Ptend(Tmp) - if(Norm(P2-P)>Eps && Norm(P2-Q)>Eps){ - Tmp< Length(PL) - PL<-PL[Tmp:1,] - Pfirst<- Ptstart(PL) - Plast<- Ptend(PL) - } - } - } - else{ - if(Norm(P1-Plast)<Eps){ - Stp<-1; Ks<-2; Ke=Length(Points) - } - else{ - if(Norm(P2-Plast)<Eps) { - Stp<- -1; Ks<-Length(Points)-1; Ke=1 - } - else{ - Tmp<-Appendrow(PL,c(Inf,Inf)) - PL<- Appendrow(Tmp,Points) - Sflg<- 1 - Pfirst<- P1 - Plast<- P2 - Stp<- 1; Ks<- Length(Points)-1; Ke<- 1 - } - } - for (K in seq(Ks,Ke, by=Stp)){ - Tmp<- Appendrow(PL,Op(K,Points)) - PL<-Tmp - } - Plast<- Op(Ke,Points) - } - } - if(Norm(Pfirst-Plast)>Eps){ - Np<- Length(PL) - if(Rg=="c"){ - Tmp<- Appendrow(PL,Pfirst) - PL<- Tmp - } - else if(Rg=="s"){ - Tmp<- c(PL[1:Np,2],YMIN) - Y<- min(Tmp)-1 - P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) - Tmp<- Appendrow(PL,P) - Tmp=Appendrow(Tmp,Q) - PL=Appendrow(Tmp,Pfirst) - } - else if(Rg=="n"){ - Tmp<- c(PL[1:Np,2],YMAX) - Y<-max(Tmp)+1 - P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) - Tmp<- Appendrow(PL,P) - Tmp<- Appendrow(Tmp,Q) - PL<- Appendrow(Tmp,Pfirst) - } - else if(Rg=="w"){ - Tmp<- c(PL[1:Np,1],XMIN) - X<- min(Tmp)-1 - P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) - Tmp<- Appendrow(PL,P) - Tmp<- Appendrow(Tmp,Q) - PL<- Appendrow(Tmp,Pfirst) - } - else if(Rg=="e"){ - Tmp<- c(PL[1:Np,1],XMAX) - X<- max(Tmp)+1 - P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) - Tmp<- Appendrow(PL,P) - Tmp<- Appendrow(Tmp,Q) - PL<- Appendrow(Tmp,Pfirst) - } - else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){ - Tmp<- Kukeiwake(PL) - Tmp1<- Op(1,Tmp) - Tmp2<- Naigai(Rg,list(Tmp1)) - if(Tmp2==c(1)){ - PL<-Op(1,Tmp) - } - else{ - PL<- Op(2,Tmp) - } - } - } - Tmp<- Ptstart(PL) - for (J in Looprange(2,Length(PL))){ - P<- Op(J,PL) - Q<- Op(Length(Tmp),Tmp) - if(Norm(P-Q)>Eps){ - Tmp1<-Appendrow(Tmp,P) - Tmp<-Tmp1 - } - } - PL<-Tmp - PLall<-c(PLall,list(PL)) - } - if(length(PLall)==1 && Sflg==0){ - Tmp<- Op(1,PLall) -# Tmp<- Op(1,Tmp) - if(Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){ - Tmp1<- Appendrow(Tmp,Ptstart(Tmp)) - PLall<- list(Tmp1) - } - } - return(PLall) -} - -###################################### - -Letter<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - Irng<-c(seq(from=1,to=Nargs,by=3)) - for (I in Irng) - { - Tmp<-varargin[[I]] - P<- Doscaling(Tmp) - X<-P[1] - Y<-P[2] - Houkou<-varargin[[I+1]] - Mojiretu<-varargin[[I+2]] - Hset<-Houkou - Vhoko<-"c" - if(length(grep("n",Hset))>0) - { - Vhoko<-"n"; Y<-Y+MEMORI - } - if(length(grep("s",Hset))>0) - { - Vhoko<-"s"; Y<-Y-MEMORI - } - Hhoko<-"c" - if(length(grep("e",Hset))>0) - { - Hhoko<-"e"; X<-X+MEMORI - } - if(length(grep("w",Hset))>0) - { - Hhoko<-"w"; X<-X-MEMORI - } - Hoko<-paste(Vhoko,Hhoko,sep="") - Suu<-"+-.0123456789" - SuuL<-Suu - J<-1; Dstr<-"" - while (J<=nchar(Houkou)) - { - Tmp<-substring(Houkou,J,J) - if(length(grep(Tmp,SuuL))>0) - { - if(Dstr=="") Hk<-substring(Houkou,J-1,J-1) - Dstr<-paste(Dstr,Tmp,sep="") - } - else - { - if(Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI - if(Hk=="n") Y<-Y+D - if(Hk=="s") Y<-Y-D - if(Hk=="e") X<-X+D - if(Hk=="w") X<-X-D - Dstr<-"" - } - } - J<-J+1 - } - if(Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI; - if(Hk=="n") Y<-Y+D - if(Hk=="s") Y<-Y-D - if(Hk=="e") X<-X+D - if(Hk=="w") X<-X-D - } - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - cat("\\put(",file=Wfile,append=TRUE) - Tmp1<- sprintf("%7.7f",X) # 11.07.19 - Tmp2<- sprintf("%7.7f",Y) # 11.07.19 - Str<-paste(Tmp1,",",Tmp2,sep="") - cat(Str,file=Wfile,append=TRUE) - Tmp<-"){\\hspace*{\\Width}" - Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) - } -} - -###################################################### - -Letterrot<- function(...) -{ - varargin<- list(...) - P<- varargin[[1]] - V<- varargin[[2]]; N<- 3 - P<- Doscaling(P) - V<- Doscaling(V) - Tmov<- 0 - Tmp<- varargin[[N]] - if(mode(Tmp)=="numeric"){ - Tmov<- Tmp; N<- N+1 - } - Nmov<- 0 - Tmp<- varargin[[N]] - if(mode(Tmp)=="numeric"){ - Nmov<- Tmp; N<- N+1 - } - Mojiretu<- Assign(varargin[[N]]) #2017.11.26 - Tv<- 1/Norm(V)*V - Nv<- c(-Tv[2],Tv[1]) - P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv - Tmp<- acos(V[1]/Norm(V)) - Theta<- round(Tmp*180/pi) - if(V[2]>=0){ - Units<- "" - } - else{ - Units<- "units=-360," - } - Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") - Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") - Letter(P,"c",Tmp) -} - -################################### -# 10.12.04 - -Lineplot<-function(...) -{ - varargin <- list(...) - Nargs<-length(varargin) - A<-varargin[[1]] - if(is.numeric(A)) { - Tmp<-length(A) - if(Tmp>3) { - B <- A[(Tmp/2+1):Tmp] - A <- A[1:(Tmp/2)] - Is <- 2 - } - else { - B<-varargin[[2]] - Is <- 3 - } - } - else { - B<-A[[2]] - A<-A[[1]] - Is <- 2 - } - Mag <- 100 ; Semi <- "" ## 10.12.04 - for (I in Looprange(Is,Nargs)) { - Tmp <- varargin[[I]] - switch ( mode(Tmp), - "numeric"= Mag <- Tmp, - "character"= Semi <- Tmp - ) - } -V<- Mag/Norm(B-A)*(B-A) ## 10.12.04 from here - if(Semi=="") { - Out<- Listplot(c(A-V,A+V)) - } - else if(Semi=="+") { - Out<- Listplot(c(A,A+V)) - } - else { - Out<- Listplot(c(A-V,A)) - } ## 10.12.04 to here - return(Out) -} - -################################ - -Listplot<-function(...) -{ - varargin<-list(...); - Z<-c(); - for (I in 1:length(varargin)) - { - Data<-varargin[[I]]; - if(mode(Data)=="numeric") - { - if(class(Data)=="numeric") - { - Tmp<-matrix(Data,nrow=2); - Tmp<-t(Tmp); - Z<-Appendrow(Z,Tmp) - } - else - Z<-Appendrow(Z,Data) - } - else - { - for (J in 1:length(Data)) - { - Tmp<-Data[[J]]; - Z<-Appendrow(Z,Tmp) - } - } - } - return(Z) -} - -############################## - -MakeBowdata <- function(PA,PB,H) -{ - Eps <- 10^(-5) - BOWSTART <<- PA - BOWEND <<- PB - D <- 1/2*Norm(PB-PA) - R <- (H^2+D^2)/(2*H) - A1 <- PA[1]; A2<-PA[2] - B1 <- PB[1]; B2<-PB[2] - if(abs(A2-B2)>Eps){ -# x <- poly(0,"X") -# y <- -(A1-B1)*x/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) -# Eq1 <- (A1-x)^2+(A2-y)^2-R^2 -# Tmp <- coeff(Eq1) -# C0 <- Tmp[1]; C1<-Tm[2]; C2<-Tmp[3] - C0<- A1^2+(A2-(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2))^2-R^2 - C1<- -(A1+B1)*(A2^2+B2^2-2*A2*B2-2*A1*B1+A1^2+B1^2)/(A2-B2)^2 - C2<- 1+(A1-B1)^2/(A2-B2)^2 - Det <- sqrt(C1^2-4*C0*C2) - Ansx1 <- (-C1+Det)/(2*C2) - Ansx2 <- (-C1-Det)/(2*C2) - Tmp <- -(A1-B1)*Ansx1/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) - PC <- c(Ansx1,Tmp) - Tmp <--(A1-B1)*Ansx2/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) - PC2 <- c(Ansx2,Tmp) - } - else{ - Tmp <- 0.5*(PA+PB) - PC <- Tmp+c(0,R-H) # 11.06.02 - PC2 <- Tmp-c(0,R-H) - } - VA <- PA-PC - VB <- PB-PC - if(VA[1]*VB[2]-VA[2]*VB[1]<0) { - PC <- PC2 - } - AngA <- acos((PA[1]-PC[1])/R) - if(PA[2]-PC[2]<0){ - AngA <- -AngA - } - AngB <- acos((PB[1]-PC[1])/R) - if(PB[2]-PC[2]<0){ - AngB <- -AngB - } - if(AngA>AngB) { - AngB <- AngB+2*pi - } - Out <- list(PC,R,AngA,AngB) - return(Out) -} - -#################################################### - -MakeCurves<-function(...){ ## Scaling is implemented - varargin<-list(...) - Figdata<-varargin[[1]] - if(class(Figdata)=="numeric"){ - Figdata<-matrix(Figdata,nrow=1) - } - Ptout<-1 - if(length(varargin)>=2) Ptout<-varargin[[2]] - Eps<-10.0^(-6) - IndM<-Dataindex(Figdata) - Atos<-c() - for (Nd in 1:Nrow(IndM)){ - Tmp<-IndM[Nd,] - Motos<-Figdata[Tmp[1]:Tmp[2],] - All<-Nrow(Motos) - if(Nrow(Motos)==1){ - if(InWindow(Motos)=="o"){ - next - } - Tmp1<- as.numeric(Motos) - if(Ptout==1){ - Drwpt(Tmp1) - } - else{ - Tmp1<- Doscaling(Tmp1) - Atos<-Appendrow(Atos,c(Inf,Inf),Tmp1) - next - } - } - Crv<-c() - for (I in Looprange(2,All)){ - P<- Op(I-1,Motos) - Q<- Op(I,Motos) - Snbn<-MeetWindow(P,Q) - if(length(Snbn)==0){ - if(length(Crv)>0){ - Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) - Crv<-c() - } - } - else{ - if(Norm(Snbn[1,]-Snbn[2,])<Eps){ next} # naosi 101202 - if(length(Crv)==0){ - Crv<-Snbn - } - else{ - Tmp<-Op(Nrow(Crv),Crv) - if(Norm(Tmp-Op(1,Snbn))<Eps){ - Crv<-Appendrow(Crv,Op(2,Snbn)) - } - else{ - Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) - Crv<-Snbn - } - } - } - } - if(Nrow(Crv)>=2) - { - Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) - } - } - Outdata<-Atos[2:Nrow(Atos),] - if(class(Outdata)=="numeric") - { - Outdata<-matrix(Outdata,nrow=1) - } - return(Outdata) -} - -###################################### - -Makehasen<- function(Figdata,Sen,Gap,Ptn) -{ - Eps<- 10.0^(-6) - Clist<- MakeCurves(Figdata) - DinM<- Dataindex(Clist) - for (N in Looprange(1,Nrow(DinM))){ - Tmp<- DinM[N,] - Data<- Clist[Tmp[1]:Tmp[2],] - Dtall<- Nrow(Data) - Len<- 0 - Lenlist<- c(0) - for (I in Looprange(2,Dtall)){ - Len<- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist<- c(Lenlist,Len) - } - Lenall<- Lenlist[Dtall] - if(Lenall==0){ - next - } - Kari<- (Sen+Gap)*0.1 - Naga<- Sen*0.1 - Tobi<- Gap*0.1 - if(Norm(Data[1,]-Data[Dtall,])<Eps){ - Nsen<- max(ceiling(Lenall/Kari),3) - SegUnit<- Lenall/Nsen - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit)) - } - else{ - if(Ptn==0){ - Nsen<- max(ceiling((Lenall+Tobi)/Kari),3) - SegUnit<- Lenall*(Sen+Gap)/(Nsen*Sen+(Nsen-1)*Gap) - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit)) - } - else{ - Nsen<- max(ceiling((Lenall+Naga)/Kari),3) - SegUnit<- Lenall*(Sen+Gap)/((Nsen-1)*Sen+Nsen*Gap) - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(Tobi,Tobi+(Nsen-2)*SegUnit,by=SegUnit)) - } - } - Hajime<- 1; Owari<- 1 - Mojisu<- 0 - for (I in Looprange(1,length(SegList))){ - Len<- SegList[I] - J<- Owari - while (Len>=Lenlist[J]-Eps){ - if(J==Dtall){ - break - } - J<- J+1 - } - Hajime<- J-1 - J<- Hajime - while (Len+Naga>Lenlist[J]-Eps){ - if(J==Dtall){ - break - } - J<- J+1 - } - Owari<- J-1 - T<- (Len-Lenlist[Hajime]) - T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) - P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - for (J in Looprange(Hajime+1,Owari)){ - P<- Data[J,] - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - } - T<- (Len+Naga-Lenlist[Owari]) - T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) - P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str1<- paste("\\special{pa ",X," ",Y,"}",sep="") - Str2<- "\\special{fp}" - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str1)+nchar(Str2) - if(Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - cat("%\n%\n",file=Wfile,append=TRUE); -} - -###################################### - -Makeliststr<- function(L) -{ - Out="list(" - for (I in 1:length(L)){ - Dt<- L[[I]] - if(mode(Dt)=="numeric"){ - if(length(Dt)==1){ - Dts<- as.character(Dt) - } - else{ - Dts<- "c(" - for (J in Looprange(1,Nrow(Dt))){ - for (K in 1:ncol(Dt)){ - Dts<- paste(Dts,as.character(Dt[J,K]),sep="") - if(K< ncol(Dt)){ - Dts<- paste(Dts,",",sep="") - } - } - if(J<Nrow(Dt)){ - Dts<- paste(Dts,";",sep="") - } - else{ - Dts<- paste(Dts,")",sep="") - } - } - } - } - if(mode(Dt)=="character"){ - Dts<- paste(Prime(),Dt,Prime(),sep="") - } - if(mode(Dt)=="list"){ - Dts<- Makeliststr(Dt) - } - Out<- paste(Out,Dts,sep="") - if(I<length(L)){ - Out<- paste(Out,",") - } - else{ - Out<- paste(Out,")",sep="") - } - } - return(Out) -} - -############################################ - -Makeshasen<- function(PtnL,PA,V,Bdy) -{ - Eps<- 10^(-6) - TenL<- KoutenList(PA,V,Bdy) - Nten<- length(TenL) - Call<- length(Bdy) - Ptn<- c(seq(0, 0, length=Call)) - Out<- list() - GL<- c() - Te<- -10^6 - for (I in Looprange(1,Nten-1)){ - TenP<- Op(I,TenL); TenQ<- Op(I+1,TenL) - Ts<- Op(1,TenP) - P<- Op(2,TenP); Q<- Op(2,TenQ) - NC<- Op(4,TenP) - Tmp<- (Op(NC,Ptn)+1) %% 2 - Ptn[NC]<- Tmp - if(Op(1,TenQ)-Ts>Eps){ - if(Member(Ptn,PtnL)){ - if(abs(Te-Ts)>Eps){ - if(Nrow(GL)>0){ - Tmp<- Mixjoin(Out, list(GL)) - Out<- Tmp - } - GL<- Listplot(P,Q) - } - else{ - Tmp <- Appendrow(GL, Q) - GL<- Tmp - } - Te<- Op(1,TenQ) - } - } - } - if(Nrow(GL)>0){ - Tmp<- Mixjoin(Out, list(GL)) - Out<- Tmp - } - return(Out) -} - -############################################# - -Mawarikomi<- function(...) -{ - varargin<- list(...) - haba<- "10cm" - Nargs<- length(varargin) - if(Nargs>0){ - haba<- varargin[[1]] - } - cat("\\begin{mawarikomi}%\n",file="",append=TRUE) - cat("%<1>[5](0,0)%\n",file="",append=TRUE) - Str<- paste("{",haba,"}{%\n",sep="") - cat(Str,file="",append=TRUE) - cat("}%\n",file="",append=TRUE) - cat("\\end{mawarikomi}",file="",append=TRUE) -} - -############################################## - -MeetWindow<-function(PA,PB) -{ - if(InWindow(PA)=="i" && InWindow(PB)=="i") - { - R<-Appendrow(PA,PB) - return(R) - }; - Horner<-function(n,t) - { - PT<-(1-t)*PA+t*PB; - return(PT[n]) - } - Eps<-10.0^(-6); - Txm<-(-1); TxM<-(-1); Tym<-(-1); TyM<-(-1); - if(PA[1]!=PB[1]) - { - Txm<-(XMIN-PA[1])/(PB[1]-PA[1]); - TxM<-(XMAX-PA[1])/(PB[1]-PA[1]); - } - if(PA[2]!=PB[2]) - { - Tym<-(YMIN-PA[2])/(PB[2]-PA[2]); - TyM<-(YMAX-PA[2])/(PB[2]-PA[2]); - } - Tmp<-Horner(2,Txm); - if(Tmp<YMIN-Eps || Tmp>YMAX+Eps) - { - Txm<-(-1); - } - Tmp<-Horner(2,TxM); - if(Tmp<YMIN-Eps || Tmp>YMAX+Eps) - { - TxM<-(-1) - } - Tmp<-Horner(1,Tym); - if(Tmp<XMIN-Eps || Tmp>XMAX+Eps) - { - Tym<--1 - } - Tmp<-Horner(1,TyM); - if(Tmp<XMIN-Eps || Tmp>XMAX+Eps) - { - TyM<--1 - } - Tans<-sort(c(Txm,TxM,Tym,TyM)); - Tmp<-c(); - for (I in 1:length(Tans)) - { - Tmp1<-Tans[I]; - if(Tmp1>-Eps && Tmp1<1+Eps) - { - if(length(Tmp)==0) - { - Tmp<-c(Tmp1); - } - else - { - if(abs(Tmp[length(Tmp)]-Tmp1)>Eps) - { - Tmp<-c(Tmp,Tmp1) - } - } - } - } - Tans<-Tmp; - if(length(Tans)==0) - { - R<-c(); - return(R); - } - if(length(Tans)==1) - { - Ten1<-Horner(1:2,Tans[1]); - if(InWindow(PA)=="i") - { - R<-Appendrow(PA,Ten1) - return(R) - } - else - { - R<-Appendrow(Ten1,PB) - return(R) - } - } - Ten1<-Horner(1:2,Tans[1]) - Ten2<-Horner(1:2,Tans[2]) - R<-Appendrow(Ten1,Ten2) - return(R) -} - -######################################### - -# New 10.03.21 - -Mixjoin<-function(...) -{ - varargin<-list(...) - Nargs<- length(varargin) - M<- list() - for (I in 1:Nargs) - { - Tmp<-varargin[[I]] - if(length(Tmp)==0) next - if(Mixtype(Tmp)==1) - { - Tmp<-list(Tmp) - } - if(length(M)==0){ - M <- Tmp - } - else{ - M<- c(M,Tmp) - } - } - return(M) -} - -################################# - -Mixlength<- function(PL){ - if(length(PL)==0){ - return(0) - } - if(Mixtype(PL)==1){ - Out<- Nrow(PL) - } - else{ - Out<- length(PL) - } - return(Out) -} - -########################################### - -Mixtype<- function(D) -{ - if(mode(D)!="list") return(1) - for (I in 1:length(D)) - { - Tmp<- D[[I]] - if(mode(Tmp)=="list") return(3) - } - return(2) -} - -########################################### - -Naigai<- function(A,Bdy) -{ - V<- c(1,1) - Call<-length(Bdy) - KL<- KoutenList(A,V,Bdy) - Ptn<- seq(1,1,length=Call) - for (K in Looprange(1,length(KL))) - { - Ten<- Op(K,KL) - T<- Op(1,Ten); NC<- Op(4,Ten) - if(T<0) - { - Tmp<- (Ptn[NC]+1) %% 2 - Ptn[NC]<- Tmp - } - } - return(Ptn) -} - -######################################## - -Nearestpt<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - PL1<- varargin[[1]] - if(!is.matrix(PL1)){ - Tmp<- matrix(PL1); - PL1<- t(Tmp) - } - if(Nrow(PL1)==1) Flg=0 - else Flg=1 - Eps<- 10.0^(-6) - PL<- varargin[[2]] - Ans<- list(PL1[1,],1,PL[1,],1,Norm(PL1[1,]-PL[1,])) - for(N in Looprange(1,Nrow(PL1))){ - PA<- PL1[N,] - Pm<- PL[1,] - Im<- 1 - Sm<- Norm(Pm-PA) - for(I in Looprange(1,Nrow(PL)-1)){ - A1<- PL[I,1]; A2<-PL[I,2] - B1<- PL[I+1,1]; B2<-PL[I+1,2] - V1<- B1-A1; V2<-B2-A2 - X1<- PA[1]; X2<-PA[2] - Tmp<-V2^2+V1^2 - if(abs(Tmp)<Eps) next - T<- (-A2*V2-V1*A1+V1*X1+X2*V2)/Tmp - if(T< -Eps){ - P<- c(A1,A2) - }else{ - if(T>1+Eps){ - P<- c(B1,B2) - }else{ - P<- c(A1+T*V1,A2+T*V2) - } - } - S<- Norm(P-PA) - if(S<Sm-Eps){ - Tmp<- Paramoncurve(P,I,PL) - Pm<- P; Im<- Tmp; Sm<- S - } - } - if(Sm<Op(5,Ans)) Ans<- list(PA,N,Pm,Im,Sm) - if(Flg==0){ - Ans<- Ans[3:5] - } - } - return(Ans) -} - -######################################### - -Newlength<- function() -{ - Tmp1<- "\\newlength{\\Width}%\n" - Tmp2<- "\\newlength{\\Height}%\n" - Tmp3<- "\\newlength{\\Depth}%\n" - cat(Tmp1,file="",append=TRUE); - cat(Tmp2,file="",append=TRUE); - cat(Tmp3,file="",append=TRUE); -} - -######################################### - -Numptcrv<-function(Fig) -{ - return(Nrow(Fig)) -} - -# 2018.01.29 -Length<- function(Data){ - if(is.matrix(Data)){return(nrow(Data))} - if(is.character(Data)){return(nchar(Data))} - return(length(Data)) -} - -######################################### - -Op<-function(N,Data) -{ - C <- c() - if(length(Data)==0) return(C) - if(mode(Data)=="list"){ - if(class(Data)=="data.frame"){ # 10.02.23 - C<- Data[N,] - } - else{ - C<- Data[[N]] - } - return(C) - } - if(mode(Data)=="character"){ - if(length(Data)==1){ - C<- substring(Data,N,N) - } - else{ - C<- Data[N] - } - return(C) - } - if(mode(Data)=="numeric"){ - if(class(Data)=="matrix"){ - Din<- Dataindex(Data) - if(nrow(Din)==1){ - C<- Data[N,] - } - else{ - Tmp1<- Din[N,1] - Tmp2<- Din[N,2] - C<- Data[Tmp1:Tmp2,] - } - } - else{ - C=Data[N] - } - } - return(C) -} - -######################################### -# 2013.05.20 Changed ( Creator recorded) -# 2013.12.18 Beginpicture inclued - -Openfile<-function(...) -{ - varargin<- list(...) - File<- varargin[[1]] - Bflg<- 0 - Wfile<<- File - Creator<- "" - Cflg<- 0 - Nargs<- length(varargin) - for(N in Looprange(2,Nargs)){ - Tmp<- varargin[[N]] - Tmp1<- strsplit(Tmp,"=",fixed=TRUE) - Tmp1<- Tmp1[[1]] - if(length(Tmp1)>1){ - Creator<- Tmp1[2] - Cflg<- 1 - } - else{ - Unitstr<- Tmp - Bflg<- 1 - } - } - Recentf<- "" - Fv<- list.files() - Nv<- grep("\\.r$", Fv) - Rfiles<- Fv[Nv] - StrW<- paste("%%% ",File,sep="") #17.10.28 - StrC<- paste("%%% Generator=",Creator,sep="") - if(Cflg==0){ - } - cat(StrW,"\n",file=Wfile) - cat(StrC,"\n",file=Wfile,append=TRUE) - if(Bflg==1){ - Beginpicture(Unitstr) - } -} - -######################################### - -Openpar<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Tmp<- varargin[[1]] - Tmp1<- substr(Tmp,1,1) - if(Tmp1=="\\"){ - Namestr<- Tmp - N<- 2 - } - else{ - Namestr<- "\\tmp" - N<- 1 - } - Habastr<- varargin[[N]] - if(Nargs>N){ - Posstr<- paste("[",varargin[[N+1]],"]",sep="") - } - else{ - Posstr<- "[c]" - } - Openphr(Namestr) - S<- paste("\\begin{minipage}",Posstr,"{",Habastr,"}%\n",sep="") - cat(S,file=Wfile,append=TRUE) -} - -################################### - -Openphr<- function(Str) -{ - S<- paste("\\def",Str,"{%\n",sep="") - cat(S,file=Wfile,append=TRUE) -} - -##################################### - -Ovalbox<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Pos<- varargin[[1]] - Dr<- varargin[[2]] - StrV<- varargin[[3]] - R<- 0.2 - NDflg<- 0 - for (I in Looprange(4,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - R<- Tmp - } - else{ - if(substr(Tmp,1,1)=="-"){ - NDflg<- 1 - Tmp1<- substr(Tmp,2,nchar(Tmp)) - Cmdstr<- chartr("*","G",Tmp1) - } - } - } - Xr<- c(XMIN,XMAX) - Yr<- c(YMIN,YMAX) - Uv<- 0.6; Uh<- 0.8 - N<- nchar(StrV) - W<- Uh;H<- Uv*N - Setwindow(c(-W/2,W/2),c(-H,0)) - G<- Ovaldata(c(0,-H/2),W/2,H/2,R) - Openphr("\\ketpictmp") - Beginpicture("1cm") - if(NDflg==0){ - Drwline(G) - } - else{ - eval(parse(text=Cmdstr)) - } - for (I in Looprange(1,N)){ - Letter(c(0,Uv/2-Uv*I),"c",Op(I,StrV)) - } - Endpicture(0) - Closephr() - Setwindow(Xr,Yr) - Letter(Pos,Dr,"\\ketpictmp") -} - -########################################## - -Ovaldata<- function(...) #17.09.11 -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==1){ - Eps<- 1.0*10^(-4) - C<- c((XMIN+XMAX)/2,(YMIN+YMAX)/2) - Dx<- XMAX-C(1)-Eps - Dy<- YMAX-C(2)-Eps - N<- 1 - } - else{ - C<- varargin[[1]] - Dx<- varargin[[2]] - Dy<- varargin[[3]] - N<- 4 - } - Rc<- 0.2 - if(N<=Nargs){ #15.11.15 - Rc<- varargin[[N]]*Rc #15.11.15 - } - Out<- c() - P<- C+c(Dx-Rc,Dy-Rc) - Tmp1<- Circledata(c(P,Rc),"R=c(0,pi/2)","N=10") #17.11.29 - Tmp2<- Listplot(C+c(Dx-Rc,Dy),C+c(0,Dy)) - Tmp3<- Listplot(C+c(Dx,0),C+c(Dx,Dy-Rc)) - G<- Joincrvs(Tmp3,Tmp1,Tmp2) - Tmp<- Reflectdata(G,c(C,C+c(0,1))) - G<- Joincrvs(G,Tmp) - Tmp<- Reflectdata(G,c(C,C+c(1,0))) - Out<- Joincrvs(G,Tmp) -} - -######################################### - -Paramark<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - PA<- varargin[[1]] - PB<- varargin[[2]] - PC<- varargin[[3]] - R<- 0.5 - if(Nargs>=4){ - R<- varargin[[4]]*R - } - U<- R*(PA-PB)/Norm(PA-PB) - V<- R*(PC-PB)/Norm(PC-PB) - if(Crossprod(PA-PB,PC-PB)!=0){ - P<- Listplot(c(PB+U,PB+U+V,PB+V)) - } - else{ - P<- c() - } -} - -########################################### - -Paramoncurve<-function(...){ - varargin<-list(...) - Nargs<-length(varargin) - Eps<-10^(-8) - P<-varargin[[1]] - Gdata<-varargin[[Nargs]] - if(Nrow(P)>1){ - Tmp<-P; P<-Gdata; Gdata<-Tmp - } - if(Nargs==2){ - Tmp<-Nearestpt(P,Gdata) - Out<-Tmp[[2]] - return(Out) - } - N<-varargin[[2]] - PtL<-Gdata - N=min(N,Length(PtL)-1) #18.02.11from - Pa<-Ptcrv(N,PtL) - Pb<-Ptcrv(N+1,PtL) - V<-Pb-Pa - W<-P-Pa - D2<-Norm(V)^2 - if(D2<Eps) return(0) - S<-Dotprod(V,W)/D2 - S<-min(max(S,0),1) - Out=N+S #18.02.11until - return(Out) -} - -############################################## - -Paramplot<- function(...) -{ - varargin<- list(...) - Eps<- 10^(-5) - Nargs<- length(varargin) - Fnflg<- 0 - Fnstr<- varargin[[1]]; Is=2 - Rgstr<- varargin[[Is]]; Is<- Is+1 - Range<- c(0,2*pi) - N<- 50 # Numpoints - E<-c() # Exclusions - D<- Inf # Discont - for (I in Looprange(Is,Nargs)) - { - Tmp<- varargin[[I]] - Tmp<- strsplit(Tmp,"=") - K<- Tmp[[1]] - Tmp<- K[1] - Lhs<- substring(Tmp,1,1) - Tmp1<- K[2] - Str<-paste(Lhs,"=",Tmp1,sep="") - eval(parse(text=Str)) - } - Tmp<- strsplit(Rgstr,"=") - K<-Tmp[[1]] - if(length(K)>1) - { - Vname<- K[1] - Tmp1<- K[2] - Rng<- eval(parse(text=Tmp1)) - } - else - { - Vname<- Rgstr - Rng<- c(0,2*pi) - } - T1<- Rng[1]; T2<- Rng[2] - Dt<- (T2-T1)/N #17.09.22 - if(Fnflg==0) - { - Str<- gsub(Vname,"t",Fnstr) - } - if(abs(Dt)<Eps){ # 16.12.13 - t=T1 - P=eval(parse(text=Str)) - return(P) - } - P<-c() - if(length(E)>0) - { - E<-sort(E) - E<E[length(E):1] - } - E<- c(E, Inf) - Tmp<- sort(E) - E<- E[length(Tmp):1] - Ke<- 1 -# for (t in seq(T1, T2+Eps, by=Dt)){#18.02.05 - for(jj in 1:(N+1)){ - t=T1+(jj-1)*Dt - Pa<- c() - if(t-E[Ke]< Eps) - { - if(Fnflg==0) - { - Tmp<-eval(parse(text=Str)) - Pa<- Tmp - } - else - { - } - } - if(abs(t-E[Ke])<=Eps) - { - if(Nrow(P)>0 && Op(Nrow(P),P)!=c(Inf,Inf)) - { - Pa<- c(Inf,Inf) - } - } - if(t-E[Ke]>Eps) - { - if(Fnflg==0) - { - Tmp<- eval(parse(text=Str)) - Pa<- Tmp - } - else - { - } - Ke<-Ke+1 - } - if(length(Pa)>0) - { - if(Pa[1]==Inf) - { - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else - { - if(Nrow(P)==0) - { - Tmp<- Appendrow(P,Pa) - P<-Tmp - } - else - { - Tmp<- Op(Nrow(P),P) - if(Tmp[1]==Inf) - { - Tmp<- Appendrow(P,Pa) - P<- Tmp - } - else - { - if(Norm(Tmp-Pa)<D) - { - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else - { - Tmp<- Appendrow(P,c(Inf,Inf),Pa) - P<- Tmp - } - } - } - } - } - } - Tmp<- Nrow(P) - Tmp1<- Op(Tmp,P) - if(Tmp1[1]==Inf) - { - P<- P[1:(Tmp-1),] - } - return(P) -} - -##################################### - -Partcrv<- function(A,B,PkL) -{ - Eps<- 10.0^(-3) - if(mode(A)=="numeric" && length(A)==1){ - if(A>B+Eps){ - Npt<- Numptcrv(PkL) - Out1<- Partcrv(A,Npt,PkL) - Out2<- Partcrv(1,B,PkL) - Tmp<- Ptstart(PkL)-Ptend(PkL) - if(Norm(Tmp)<Eps){ - Ans<- Joincrvs(Out1,Out2) - } - else{ - Ans<- list(Out1,Out2) - } - return(Ans) - } - Is<- ceiling(A) - Ie<- floor(B) - PL<- c() - if(A<Is-Eps){ - P<- (Is-A)*PkL[Is-1,]+(1-Is+A)*PkL[Is,] - PL<- c(P) - } - PL<- Appendrow(PL, PkL[Looprange(Is,Ie),]) - if(B>Ie+Eps){ - P<- (1-B+Ie)*PkL[Ie,]+(B-Ie)*PkL[Ie+1,] - PL<- Appendrow(PL,P) - } - Ans<- PL - return(Ans) - } - Tmp<- Nearestpt(A,PkL) - Ta<- Op(2,Tmp) - Tmp<- Nearestpt(B,PkL) - Tb<- Op(2,Tmp) - Ans<- Partcrv(Ta,Tb,PkL) -} - -########################################## -# 13.05.03 - -Partframe<- function(Tb,St,Ed) -{ - G<- Dividetable(Tb) - Gw<- G[[1]] - Gt<- G[[2]] - Gy<- G[[3]] - Gwt<- Tb[[4]] - Gwy<- Tb[[5]] - Gat<- c(list(Gwt[[1]]),Gt,list(Gwt[[2]])) - Gay<- c(list(Gwy[[1]]),Gy,list(Gwy[[2]])) - Tmp1<- Ptstart(Gat[[St[1]]]) - Tmp2<- Ptstart(Gay[[St[2]]]) - Ps<- c(Tmp1[1],Tmp2[2]) - Tmp1<- Ptstart(Gat[[Ed[1]]]) - Tmp2<- Ptstart(Gay[[Ed[2]]]) - Pe<- c(Tmp1[1],Tmp2[2]) - Pars<- Paramoncurve(Ps,Gw) - Pare<- Paramoncurve(Pe,Gw) - if(Pars<Pare){ - Out<- Partcrv(Pars,Pare,Gw) - } - else{ - Tmp1<- Partcrv(Pars,Numptcrv(Gw),Gw) - Tmp2<- Partcrv(1,Pare,Gw) - Out<- Joincrvs(Tmp1,Tmp2) - } -return(Out) -} - - -########################################## -# 10.12.04 - -Plotdata<- function(...) -{ - varargin<- list(...) - Eps<- 10^(-5) - Fnstr<- varargin[[1]]; Is<- 2 - Fnflg<- 0 - Rgstr<- varargin[[Is]]; Is<- Is+1 - Tmp<- strsplit(Rgstr,"=") - K<-Tmp[[1]] - if(length(K)>1){ - Vname<- K[1] - Tmp1<- K[2] - Rng<- eval(parse(text=Tmp1)) - } - else{ - Vname<- Rgstr - Rng<- c(XMIN,XMAX) - } - N<- 50 # Numpoints - E<-c() # Exclusions - Exfun<- "" # Exclusion function - D<- Inf # Discont - for (I in Looprange(Is,length(varargin))){ - Tmp<- varargin[[I]] - Lhs<- substring(Tmp,1,1) - Tmp<- strsplit(Tmp,"=") - K<- Tmp[[1]] - Tmp1<- K[2] - Tmp2<- grep(Vname,Tmp1,fixed=TRUE) ## 10.12.04 - if(length(Tmp2)==0){ - Str<-paste(Lhs,"=",Tmp1,sep="") - eval(parse(text=Str)) - } - else{ - Exfun<-Tmp1 - } - } - X1<- Rng[1]; X2<- Rng[2] - dx<- (X2-X1)/N # 17.09.22 - if(Fnflg==0){ - Str<- gsub(Vname,"x",Fnstr,fixed=TRUE) - } - if(abs(dx)<Eps){ # Scilab 16.12.13 - x=X1 - P=c(X1,eval(parse(text=Str))) - return(P) - } - Exfun<- gsub(Vname,"x",Exfun,fixed=TRUE) - P<-c() - if(length(E)>0){ - E<-sort(E) - E<E[length(E):1] - } - E<- c(E, Inf) - Tmp<- sort(E) - E<- E[length(Tmp):1] - Ke<- 1 - for (x in seq(X1,X2,by=dx)){ - if(nchar(Exfun)>0){ - Tmp<-eval(parse(text=Exfun)) - if(abs(Tmp)<Eps){ - P<- Appendrow(P,c(Inf,inf)) - next - } - } - Pa<- c() - if(x-E[Ke]< -Eps){ ## 10.12.04 - Tmp<-eval(parse(text=Str)) - Pa<- c(x,Tmp) - } - if(abs(x-E[Ke])<=Eps){ - if(Nrow(P)>0 && P[Nrow(P),]!=c(Inf,Inf)){ - Pa<- c(Inf,Inf) - } - } - if(x-E[Ke]>Eps){ - Tmp<- eval(parse(text=Str)) - Pa<- c(x,Tmp) - Ke<-Ke+1 - } - if(length(Pa)>0){ - if(Pa[1]==Inf){ - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else{ - if(Nrow(P)==0){ - Tmp<- Appendrow(P,Pa) - P<-Tmp - } - else{ - Tmp<- P[Nrow(P),] - if(Tmp[1]==Inf){ - Tmp<- Appendrow(P,Pa) - P<- Tmp - } - else{ - if(Norm(Tmp-Pa)<D){ - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else{ - Tmp<- Appendrow(P,c(Inf,Inf),Pa) - P<- Tmp - } - } - } - } - } - } - Tmp<- Nrow(P) - Tmp1<-P[Tmp,] - if(Tmp1[1]==Inf) - { - P<- P[1:(Tmp-1),] - } - return(P) -} - -###################################### - -Pointoncurve<-function(...) -{ - varargin<-list(...) - Eps<-10^(-4) - T<-varargin[[1]] - Gdata<-varargin[[2]] - if(Nrow(T)>1) - { - Tmp<-T; T<-Gdata; Gdata<-Tmp - } - PtL<-Gdata - N<-trunc(T+Eps); - S<-max(T-N,0); - if(N==Nrow(PtL)) - { - Out<-PtL[N,] - } - else - { - Pa<-PtL[N,] - Pb<-PtL[N+1,] - Out<-(1-S)*Pa+S*Pb - } - return(Out) -} - -############################################## -# 10.11.20 -# 13.05.03 Inf - -Pointdata<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - PL<- list() - for (I in Looprange(1,Nargs)){ # 10.11.20 - DL<-varargin[[I]] - DL<- Flattenlist(DL) # 10.11.20 from here - for (J in Looprange(1,length(DL))){ - Dt<- DL[[J]] - if(is.matrix(Dt)|| is.data.frame(Dt)){ - for (K in 1:nrow(Dt)){ - Tmp<- as.numeric(Dt[K,]) - if(Tmp[1]<Inf){ - PL<- c(PL,list(Tmp)) - } - } - } - else{ - PL<- c(PL,list(Dt)) - } - } - } # to here - if(length(PL)==1) - { - PL<-PL[[1]] - } - return(PL) -} - -############################################## - -Prime<- function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out="'" - } - else{ - Out<- paste(varargin[[1]],"'",sep="") - } - return(Out) -} - -############################################ -# 17.09.29 - -Ptcrv<-function(N,Fig) -{ - if(is.matrix(Fig)){ - return(Fig[N,]) - } - else{ - return(Fig) - } -} - -######################################### - -Ptend<-function(Fig) -{ - if(Length(Fig)>0){ #18.02.09 - return(Op(Length(Fig),Fig)) - }else{ - return(c()) - } -} - -######################################### - -Ptne<-function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out<- c(XMAX,YMAX) - } - else{ - G<- varargin[[1]] - XM<- max(G[,1]) - YM<- max(G[,2]) - Out<- c(XM,YM) - } - return(Out) -} - -######################################### - -Ptnw<-function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out<- c(XMIN,YMAX) - } - else{ - G<- varargin[[1]] - Xm<- min(G[,1]) - YM<- max(G[,2]) - Out<- c(Xm,YM) - } - return(Out) -} - -######################################### - -Ptse<-function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out<- c(XMAX,YMIN) - } - else{ - G<- varargin[[1]] - XM<- max(G[,1]) - Ym<- min(G[,2]) - Out<- c(XM,Ym) - } - return(Out) -} - -############################################# - -Ptstart<-function(Fig) -{ - if(Length(Fig)>0){ #18.02.09 - return(Op(1,Fig)) - }else{ - return(c()) - } -} - -######################################### - -Ptsw<-function(...) -{ - varargin<- list(...) - if(length(varargin)==0){ - Out<- c(XMIN,YMAX) - } - else{ - G<- varargin[[1]] - Xm<- min(G[,1]) - Ym<- min(G[,2]) - Out<- c(Xm,Ym) - } - return(Out) -} - -############################################## - -Putcell<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - Str<- varargin[[Nargs]] - if(mode(Str)=="numeric"){ - Str<- as.character(Str) - } - Pos<- varargin[[Nargs-1]] - Nrg<- varargin[[2]] - if(mode(Nrg)=="character"){ - if(Nargs==4){ - Cell<- Findcell(TbL,Nrg) - } - else{ - Mrg<- varargin[[3]] - Cell<- Findcell(TbL,Nrg,Mrg) - } - } - else{ - Mrg<- varargin[[3]] - Cell<- Findcell(TbL,Nrg,Mrg) - } - Pt<- Cell[[1]]; Dr<- "c" - Posh<- substr(Pos,1,1) - Post<- substr(Pos,2,nchar(Pos)) - if(toupper(Posh)=="R"){ - Pt<- Pt+c(Cell[[2]],0) - if(nchar(Post)==0){ - Dr<- "w1" - } - else{ - Dr<- paste("w",Post,sep="") - } - } - if(toupper(Posh)=="L"){ - Pt=Pt-c(Cell[[2]],0) - if(nchar(Post)==0){ - Dr<- "e1" - } - else{ - Dr<- paste("e",Post,sep="") - } - } - if(toupper(Posh)=="U"){ - Pt<- Pt+c(0,Cell[[3]]) - if(nchar(Post)==0){ - Dr<- "s1" - } - else{ - Dr<- paste("s",Post,sep="") - } - } - if(toupper(Posh)=="D"){ - Pt<- Pt-c(0,Cell[[3]]) - if(nchar(Post)==0){ - Dr<- "n1" - } - else{ - Dr<- paste("n",Post,sep="") - } - } - if(toupper(Posh)=="B"){ - Pt<- Pt-c(0,Cell[[3]]) - if(nchar(Post)==0){ - Dr<- "n1" - } - else{ - Dr<- paste("n",Post,sep="") - } - Str<- paste("$\\mathstrut$",Str,sep="") - } - Letter(Pt,Dr,Str) -} - -############################################# - -PutcoL<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if(mode(TbL)!="list"){ - return("Tabledata missing") - } - Ag<- varargin[[2]] - if(mode(Ag)=="numeric"){ - CoL<- Ag - } - else{ - Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" - Clm<- c() - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,I,I) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - CoL<- Nrg - } - Nc<- length(TbL[[3]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if(I-3>Nc){ - break - } - Dt<- varargin[[I]] - if(mode(Dt)!="list"){ - Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- Dt[[N]] - Rrng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if(mode(Tmp)=="numeric"){ - Rrng<- c(K,K+Tmp) - } - if(mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,CoL,Rrng,Pos,Str) - K<- Crng[2] - } - } -} - -Putcol<- function(...) -{ - PutcoL(...) -} - -PutcoLexpr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if(mode(TbL)!="list"){ - return("Tabledata missing") - } - Ag<- varargin[[2]] - if(mode(Ag)=="numeric"){ - CoL<- Ag - } - else{ - Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" - Clm<- c() - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,I,I) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - CoL<- Nrg - } - Nc<- length(TbL[[3]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if(I-3>Nc){ - break - } - Dt<- varargin[[I]] - if(mode(Dt)!="list"){ - Dt<- paste("$",Dt,"$",sep="") - Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- paste("$",Dt[[N]],"$",sep="") - Rrng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if(mode(Tmp)=="numeric"){ - Rrng<- c(K,K+Tmp) - } - if(mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,CoL,Rrng,Pos,Str) - K<- Crng[2] - } - } -} - -Putcolexpr<- function(...) -{ - PutcoLexpr(...) -} - -##################################################### - -PutcoLstr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Tb<- varargin[[1]] - Nr<- varargin[[2]] - Pos<- varargin[[3]] - Str<- varargin[[4]] - Sep<- "" - if(Nargs>4){ - Sep<- varargin[[5]] - } - if(nchar(Sep)==0){ - for (I in Looprange(1,nchar(Str))){ - Tmp<- substr(Str,I,I) - Putcell(Tb,Nr,I,Pos,Tmp) - } - } - else{ - Ltr<- "" - K<- 1 - for (I in Looprange(1,length(Str))){ - Tmp<- substr(Str,I,I) - if(Tmp==Sep){ - Putcell(Tb,Nr,K,Pos,Ltr) - K<- K+1 - Ltr<- "" - } - else{ - Ltr<- paste(Ltr,Tmp,sep="") - } - } - if(nchar(Ltr)>0){ - Putcell(Tb,Nr,K,Pos,Ltr) - } - } -} - -############################################# - -Putrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if(mode(TbL)!="list"){ - return("Tabledata missing") - } - Row<- varargin[[2]] - Nr<- length(TbL[[2]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if(I-3>Nr){ - break; - } - Dt<- varargin[[I]] - if(mode(Dt)!="list"){ - Putcell(TbL,K,Row,Dpos,Dt) # 110308 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- Dt[[N]] - Crng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if(mode(Tmp)=="numeric"){ - Crng<- c(K,K+Tmp) - } - if(mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,Crng,Row,Pos,Str) - K<- Crng[2] - } - } -} - -Putrowexpr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if(mode(TbL)!="list"){ - return("Tabledata missing") - } - Row<- varargin[[2]] - Nr<- length(TbL[[2]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if(I-3>Nr){ - break; - } - Dt<- varargin[[I]] - if(mode(Dt)!="list"){ - Dt<- paste("$",Dt,"$",sep="") - Putcell(TbL,K,Row,Dpos,Dt) #110308 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- paste("$",Dt[[N]],"$",sep="") - Crng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if(mode(Tmp)=="numeric"){ - Crng<- c(K,K+Tmp) - } - if(mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,Crng,Row,Pos,Str) - K<- Crng[2] - } - } -} - -#################################################### - -Putrowstr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Tb<- varargin[[1]] - Nr<- varargin[[2]] - Pos<- varargin[[3]] - Str<- varargin[[4]] - Sep<- "" - if(Nargs>4){ - Sep<- varargin[[5]] - } - if(nchar(Sep)==0){ - for (I in Looprange(1,nchar(Str))){ - Tmp<- substr(Str,I,I) - Putcell(Tb,I,Nr,Pos,Tmp) - } - } - else{ - Ltr<- "" - K<- 1 - for (I in Looprange(1,length(Str))){ - Tmp<- substr(Str,I,I) - if(Tmp==Sep){ - Putcell(Tb,K,Nr,Pos,Ltr) - K<- K+1 - Ltr<- "" - } - else{ - Ltr<- paste(Ltr,Tmp,sep="") - } - } - if(nchar(Ltr)>0){ - Putcell(Tb,K,Nr,Pos,Ltr) - } - } -} - -############################################ -# 11.05.28 - -Ratiocmyk<- function(Color) -{ - if(is.numeric(Color)){ - return(Color) - } - R<- - switch(Color, - greenyellow=c(0.15,0,0.69,0), - yellow=c(0,0,1,0), - goldenrod=c(0,0.1,0.84,0), - dandelion=c(0,0.29,0.84,0), - apricot=c(0,0.32,0.52,0), - peach=c(0,0.5,0.7,0), - melon=c(0,0.46,0.5,0), - yelloworange=c(0,0.42,1,0), - orange=c(0,0.61,0.87,0), - burntorange=c(0,0.51,1,0), - bittersweet=c(0,0.75,1,0.24), - redorange=c(0,0.77,0.87,0), - mahogany=c(0,0.85,0.87,0.35), - maroon=c(0,0.87,0.68,0.32), - brickred=c(0,0.89,0.94,0.28), - red=c(0,1,1,0), - orangered=c(0,1,0.5,0), - rubinered=c(0,1,0.13,0), - wildstrawberry=c(0,0.96,0.39,0), - salmon=c(0,0.53,0.38,0), - carnationpink=c(0,0.63,0,0), - magenta=c(0,1,0,0), - violetred=c(0,0.81,0,0), - rhodamine=c(0,0.82,0,0), - mulberry=c(0.34,0.9,0,0.02), - redviolet=c(0.07,0.9,0,0.34), - fuchsia=c(0.47,0.91,0,0.08), - lavender=c(0,0.48,0,0), - thistle=c(0.12,0.59,0,0), - orchid=c(0.32,0.64,0,0), - darkorchid=c(0.4,0.8,0.2,0), - purple=c(0.45,0.86,0,0), - plum=c(0.5,1,0,0), - violet=c(0.79,0.88,0,0), - royalpurple=c(0.75,0.9,0,0), - blueviolet=c(0.86,0.91,0,0.04), - periwinkle=c(0.57,0.55,0,0), - cadetblue=c(0.62,0.57,0.23,0), - cornflowerblue=c(0.65,0.13,0,0), - midnightblue=c(0.98,0.13,0,0.43), - navyblue=c(0.94,0.54,0,0), - royalblue=c(1,0.5,0,0), - blue=c(1,1,0,0), - cerulean=c(0.94,0.11,0,0), - cyan=c(1,0,0,0), - processblue=c(0.96,0,0,0), - skyblue=c(0.62,0,0.12,0), - turquoise=c(0.85,0,0.2,0), - tealblue=c(0.86,0,0.34,0.02), - aquamarine=c(0.82,0,0.3,0), - bluegreen=c(0.85,0,0.33,0), - emerald=c(1,0,0.5,0), - junglegreen=c(0.99,0,0.52,0), - seagreen=c(0.69,0,0.5,0), - green=c(1,0,1,0), - forestgreen=c(0.91,0,0.88,0.12), - pinegreen=c(0.92,0,0.59,0.25), - limegreen=c(0.5,0,1,0), - yellowgreen=c(0.44,0,0.74,0), - springgreen=c(0.26,0,0.76,0), - olivegreen=c(0.64,0,0.95,0.4), - rawsienna=c(0,0.72,1,0.45), - sepia=c(0,0.83,1,0.7), - brown=c(0,0.81,1,0.6), - tan=c(0.14,0.42,0.56,0), - gray=c(0,0,0,0.5), - black=c(0,0,0,1), - white=c(0,0,0,0) - ) - if(length(R)<4){ - print("No color") - return(c()) - } - return(R) -} - -############################################ -# 11.01.07 - -Readtextdata<- function(...) -{ - varargin<- list(...) - OutL<- list() - Nargs<- length(varargin) - Fname<- varargin[[1]] - Tmp<- readLines(Fname,n=1) - if(length(grep("\t",Tmp))>0){ - Sep<- "\t" - } - else if(length(grep(",",Tmp))>0){ - Sep<- "," - } - else{ - Sep<- " " - } - Hajime<- c(1,1) - Owari<- c(Inf,Inf) - C<- Inf - R<- Inf - Rna<- FALSE - Cna<- TRUE - Mat<- FALSE - Num<- TRUE - D<- -Inf - Flg<- 0 - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - if (Flg==0){ - Hajime<- Tmp - Flg<- 1 - } - else{ - Owari<- Tmp - } - } - else{ - eval(parse(text=Tmp)) - } - } - Tmp<- Hajime+c(R-1,C-1) - Owari<- c(min(Owari[1],Tmp[1]),min(Owari[2],Tmp[2])) - if(Cna){ - Df<- read.table(Fname,sep=Sep,header=TRUE,,stringsAsFactors=FALSE) - } - else{ - Df<- read.table(Fname,sep=Sep,header=FALSE,,stringsAsFactors=FALSE) - Nv<- c(1:ncol(Df)) - colnames(Df)<- Nv - } - if(Rna){ - rownames(Df)<-Df[,1] - Hajime<- Hajime+c(0,1) - } - if(Mat){ - M<- as.matrix(Df) - Tmp1<- min(Owari[1],nrow(M)) - Tmp2<- min(Owari[2],ncol(M)) - Out<- as.matrix(M[Hajime[1]:Tmp1,Hajime[2]:Tmp2]) - if(Num){ - Tmp1<- as.numeric(Out) - Out<- matrix(Tmp1,nrow=nrow(Out)) - } - } - else{ - Tmp1<- min(Owari[1],nrow(Df)) - Tmp2<- min(Owari[2],ncol(Df)) - Out<- Df[Hajime[1]:Tmp1,Hajime[2]:Tmp2] - } - if(D!=-Inf){ # 11.01.20 v2 - Tmp<- ncol(Out) # 11.01.07 - Tmp1<- rep(Inf,Tmp) - Out[Out[,1]<=D,]<- Tmp1 # 11.01.07 - } - return(Out) -} - -################################## - -Reflectdata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if(Mixtype(ML)==1){ - ML<- list(ML) - } - if(Nargs==1){ - PtA<- c(0,0); PtB<- PtA - } - else{ - Pts<- varargin[[2]] - if(length(Pts)==2){ - PtA<- Pts; PtB<- PtA - } - else{ - PtA<- Pts[1:2]; PtB<- Pts[3:4] - } - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if(X1==Inf){ - X2<- X1 - Y2<- Y1 - } - else{ - if(Norm(PtA-PtB)<Eps){ - X2<- 2*PtA[1]-X1 - Y2<- 2*PtA[2]-Y1 - } - else{ - U<- PtB[1]-PtA[1] - V<- PtB[2]-PtA[2] - A<- PtA[1] - B<- PtA[2] - X2<- (U^2-V^2)/(U^2+V^2)*X1+2*U*V/(U^2+V^2)*Y1 - X2<- X2-2*V*(U*B-V*A)/(U^2+V^2) - Y2<- 2*U*V/(U^2+V^2)*X1-(U^2-V^2)/(U^2+V^2)*Y1 - Y2<- Y2+2*U*(U*B-V*A)/(U^2+V^2) - } - } - Out<- Appendrow(Out,c(X2,Y2)) - } - OutL<- Mixjoin(OutL,list(Out)) - } - if(length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -########################################## - -Writetextdata<- function(...) -{ - varargin<- list(...) - OutL<- list() - Nargs<- length(varargin) - Data<- varargin[[1]] - Fname<- varargin[[2]] - Sep="," - for (I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - eval(parse(text=Tmp)) - } - write.table(Data,Fname,sep=Sep,row.names=FALSE,na="") -} - -########################################## -# 2014.12.17 -# 2015.10.29 - -WriteOutData<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) -# if modulo(Nargs,2)==0 then -# Fname=Fnameout; -# Nst=1; -# else - Fname=varargin[[1]] - Nst=2; -# end; - for(N in seq(Nst,Nargs,by=2)){ - Gname=varargin[[N]] - Tmp=paste(Gname,"//",sep="") - if(N==Nst){ - cat(Tmp,"\n",sep="",file=Fname) - } - else{ - cat(Tmp,"\n",sep="",file=Fname,append=TRUE) - } - Gdata=varargin[[N+1]] - Gdata=Flattenlist(Gdata) - if(!is.list(Gdata)){Gdata=list(Gdata)} - for(K in Looprange(1,length(Gdata))){ - GL=Dividegraphics(Gdata[[K]]) -# for(J in seq(1,length(GL))){ - for(J in Looprange(1,length(GL))){ - cat("start//","\n",sep="",file=Fname,append=TRUE) - Str="" - Iend=Numptcrv(GL[[J]]) -# for(II in seq(1,Iend)){ - for(II in Looprange(1,Iend)){ - Pt=Ptcrv(II,GL[[J]]) - if(nchar(Str)>0){ - Str=paste(Str,",",sep="") - } - if(length(Pt)<3){ - Str=paste(Str,sprintf("[%5.5f,%5.5f]",Pt[1],Pt[2]),sep="") - } - else{ - Str=paste(Str,sprintf("[%5.5f,%5.5f,%5.5f]",Pt[1],Pt[2],Pt[3]),sep="") - } - if(nchar(Str)>80){ - cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) - Str="" - } - } - if(nchar(Str)>0){ - cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) - } - if((N==Nargs-1) & (K==length(Gdata)) & (J==length(GL))){ -# cat("end////","\n",sep="",file=Fname,append=TRUE) - cat("end//","\n",sep="",file=Fname,append=TRUE) - } - else{ - cat("end//","\n",sep="",file=Fname,append=TRUE) - } - } - } - } - cat("//","\n",sep="",file=Fname,append=TRUE) # 15.11.05 -} - -###### Old #################################### -# 2015.10.23 -ReadOutData<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Fname=varargin[[1]] - cmdall=readLines(Fname) - cmdall=gsub("//","",cmdall,fixed=TRUE) - varname=cmdall[1] - outdt=list() - varL=c() - ptL=list() - flg=0 - for(cmd in cmdall){ - if(nchar(cmd)>0){ - if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ - if(cmd=="start"){ - pts=c() - } - if(cmd=="end"){ - ptL=c(ptL,list(pts)) - } - if(substring(cmd,1,1)=="["){ - tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") - tmp1=strsplit(tmp1,"]",fixed=TRUE) - tmp1=tmp1[[1]] - tmp1=gsub(",[","c(",tmp1,fixed=TRUE) - for(st in tmp1){ - tmp=eval(parse(text=paste(st,")",sep=""))) - pts=rbind(pts,tmp) - } - row.names(pts)=1:nrow(pts) - } - } - else{ - varname=cmd - varL=c(varL,varname) - if(flg==0){ # 17.10.07from - flg=1 - }else{ - outdt=c(outdt,list(ptL)) - } # 17.10.07until - ptL=c() - } - } - } - outdt=c(outdt,list(ptL)) # 17.10.07 - names(outdt)=varL - for(var in varL){ - tmp=paste(var,"<<- outdt$",var,sep="") - eval(parse(text=tmp)) - } -# print(varL) - outdt -} - -#################################################### - -ReadOutData<- function(...){ #2017.10.23 - varargin<- list(...) - Nargs<- length(varargin) - Fname=varargin[[1]] - cmdall=readLines(Fname) - cmdall=gsub("//","",cmdall,fixed=TRUE) - varname=""#17.12.13 cmdall[1] - outdt=list() - varL=c() - ptL=list() - flg=0 - for(cmd in cmdall){ - if(nchar(cmd)>0){ - if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ - if(cmd=="start"){ - tmp=paste(varname,"<<- c(",varname,",list(c()))",sep="") - eval(parse(text=tmp)) - Ctr=Ctr+1 - } - if(cmd=="end"){ - } - if(substring(cmd,1,1)=="["){ - tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") - tmp1=strsplit(tmp1,"]",fixed=TRUE) - tmp1=tmp1[[1]] - tmp1=gsub(",[","c(",tmp1,fixed=TRUE) - for(st in tmp1){ - tmp=paste(varname,"[[",as.character(Ctr),"]]",sep="") - tmp=paste(tmp,"<<- rbind(",tmp,",",st,"))",sep="")# - eval(parse(text=tmp)) - } - } - } - else{ - # 17.12.13from - if(nchar(varname)>0){ - tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") - eval(parse(text=tmp)) - } - # 17.12.13until - varname=cmd - tmp=paste(varname,"<<- list()",sep="") - eval(parse(text=tmp)) - Ctr=0 - if(flg==0){ # 17.10.07from - flg=1 - }else{ - } # 17.10.07until - } - } - } - # 17.12.13from - tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") - eval(parse(text=tmp)) - # 17.12.13until -} - -#################################################### - -Rotatedata<- function(..., deg=FALSE) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if(Mixtype(ML)==1){ - ML<- list(ML) - } - Theta<- varargin[[2]] - if(deg) Theta<- Theta*pi/180 # 10.12.07 - if(Nargs==2){ - Pt<- c(0,0) - } - else{ - Pt<- varargin[[3]] - } - Cx<- Pt[1]; Cy<- Pt[2] - OutL<- c() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if(X1==Inf){ - X2<- X1 - Y2<- Y1 - } - else{ - X2<- Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta) - Y2<- Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta) - } - Out<- Appendrow(Out,c(X2,Y2)) - } - if(nrow(Out)==1){ - Out<- Out[1,] - } - OutL<- Mixjoin(OutL,list(Out)) - } - if(length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -############################################### - -Scaledata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if(Mixtype(ML)==1){ - ML<- list(ML) - } - A<- varargin[[2]] - B<- varargin[[3]] - if(Nargs==3){ - Pt<- c(0,0) - } - else{ - Pt<- varargin[[4]] - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if(X1==Inf){ - X2<- X1 - Y2<-Y1 - } - else{ - X2<- Pt[1]+A*(X1-Pt[1]) - Y2<- Pt[2]+B*(Y1-Pt[2]) - } - Out<- Appendrow(Out,c(X2,Y2)) - } - OutL<- Mixjoin(OutL,list(Out)) - } - if(length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -################################ - -Setarrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - Str<- paste("Size=",YaSize,",","Angle=",YaAngle,",",sep="") - Str<- paste(Str,"Position=",YaThick,",","Style=",YaStyle,sep="") - return(Str) - } - Flg<- 0 - for (I in 1:Nargs){ - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric"){ - Flg<- Flg+1 - if(Flg==1) YaSize<<-Tmp - if(Flg==2){ - if(Tmp<5){ - YaAngle<<- 18*Tmp - } - else{ - YaAngle<<- Tmp - } - } - if(Flg==3) YaPosition<<- Tmp - if(Flg==4) YaThick<<- Tmp - } - if(mode(Tmp)=="character"){ - YaStyle<<- Tmp - } - } -} - -#################################### - -Setax<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - if(ZIKU=="line"){ - Tmp<- "," - } - else{ - Tmp<- paste("(Arrowsize=", as.character(ARROWSIZE),"),",sep="") - } - Str<- paste(ZIKU,Tmp,XNAME,",",XPOS,",",sep="") - Str<- paste(Str,YNAME,",",YPOS,",",ONAME,",",OPOS,sep="") - return(Str) - } - ArgL<- c() - Is<- 1 - Tmp<- varargin[[1]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - Is<- varargin[[1]] - ArgL<- c() - for (I in Looprange(1,Is-1)){ - ArgL<- c(ArgL,"") - } - for (I in Looprange(2,Nargs)){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - else{ - if(Nargs==1){ - ArgL<- c(varargin[[1]]) - } - else{ - Tmp<- varargin[[2]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - ARROWSIZE<<-Tmp - ArgL<- c(varargin[[1]]) - for (I in Looprange(3,Nargs)){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - else{ - ArgL<- c() - for (I in 1:Nargs){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - } - } - for (I in Looprange(length(ArgL)+1,7)){ - ArgL<- c(ArgL,"") - } - Zk<- ArgL[1] - if(nchar(Zk)>0){ - ZL<-substr(Zk,2,nchar(Zk)) - Zk<-substr(Zk,1,1) - if(nchar(ZL)>0){ - ARROWSIZE<<- as.numeric(ZL) - } - } - Xn<- ArgL[2]; Xp<- ArgL[3] - Yn<- ArgL[4]; Yp<- ArgL[5] - Genn<- ArgL[6]; Genp<- ArgL[7] - if(nchar(Zk)>0){ - C<- Zk - if(C=="a"){ - ZIKU<<- "arrow" - } - else{ - ZIKU<<- "line" - } - } - if(nchar(Xn)>0){ - XNAME<<- paste("$",Xn,"$",sep="") - } - if(nchar(Xp)>0){ - XPOS<<- Xp - } - if(nchar(Yn)>0){ - YNAME<<- paste("$",Yn,"$",sep="") - } - if(nchar(Yp)>0){ - YPOS<<-Yp - } - if(nchar(Genn)>0){ - ONAME<<- Genn - } - if(nchar(Genp)>0){ - OPOS<<- Genp - } - Out<- ""; -} - -################################# -# 11.08.24 - -Setcolor<- function(...){ - varargin<- list(...) - Color<- 'black' - Kosa<- 1 - for(J in Looprange(1,length(varargin))){ - Tmp<- varargin[[J]] - if(is.character(Tmp)) Color<- Tmp - if(is.numeric(Tmp)){ - if(length(Tmp)==1){# 11.08.24 - Kosa<- Tmp - } - else{ - Color<- Tmp - } - }# 11.08.24 - } - Iro<- Ratiocmyk(Color) - if(length(Iro)==0) return(c()) - Str<- "\\color[cmyk]{" #17.09.22 - for(J in 1:4){ - Str<- paste(Str,as.character(Kosa*Iro[J]),sep="") - if(J<4){ - Str<- paste(Str,",",sep="") - } - } - Str<- paste(Str,"}",sep="") - Texcom(Str) -} - -################################## - -Setmarklen<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - Tmp<- MARKLENNow/MARKLENInit - Tmp=round(Tmp*100)/100 - return(Tmp) - } - Size<- varargin[[1]] - MARKLENNow<<- MARKLENInit*Size - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn -} - -############################### - -Setorigin<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - return(GENTEN) - } - Pt<- varargin[[1]] - GENTEN<<- Pt; -} - -################################ - -Setscaling<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0) - { - return(c(SCALEY,LOGX,LOGY)) - } - for (I in 1:Nargs) - { - Tmp<- varargin[[I]] - if(mode(Tmp)=="numeric") - { - SCALEY<<- Tmp - } - if(mode(Tmp)=="character") - { - if(Tmp=="l") - { - LOGX<<- 0 - LOGY<<- 1 - } - else if(Tmp=="ll") - { - LOGX<<- 1 - LOGY<<- 1 - } - else - { - LOGX<<- 0 - LOGY<<- 0 - } - } - } - Tmp<- c(SCALEY,LOGX,LOGY); -} - -######################################### - -Setpen<-function(Width) -{ - PenThick<<-round(PenThickInit*Width) - Str=paste("\\special{pn ", as.character(PenThick),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) -} - -############################################## - -Setpt<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0) - { - Tmp<- TenSize/TenSizeInit - Tmp<- round(Tmp*100)/100 - return(Tmp) - } - Size<- varargin[[1]] - TenSize<<- TenSizeInit*Size; -} - -############################################## - -Setunitlen<-function(...) -{ - varargin<-list(...) - if(length(varargin)==0){ - return(ULEN) - } - Ul=varargin[[1]] - Dx<-XMAX-XMIN - Dy<-YMAX-YMIN - Sym<-".0123456789 +-*/" - SL<-Sym - OL<-"+-*/" - if(nchar(Ul)>0){ - ULEN<<-Ul - } - Is<-1 - VL<-"" - Ucode<-ULEN - for (I in 1:nchar(Ucode)){ - C<-substring(Ucode,I,I) - if(length(grep(C,SL))>0){ - if(length(grep(C,OL))>0){ - Tmp<-substring(Ucode,Is,I-1) - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1 - } - } - else{ - Unit<-substring(Ucode,I,I+1) - Str<-substring(Ucode,Is,I-1) - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)) - Str<-as.character(Valu) - ULEN<<-paste(Str,Unit,sep=""); - if(Unit=="cm") MilliIn<<-1000/2.54*Valu - if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if(Unit=="in") MilliIn<<-1000*Valu - if(Unit=="pt") MilliIn<<-1000/72.27*Valu - if(Unit=="pc") MilliIn<<-1000/6.022*Valu - if(Unit=="bp") MilliIn<<-1000/72*Valu - if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu - if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<-MARKLENNow*1000/2.54/MilliIn - MEMORI<<-MEMORINow*1000/2.54/MilliIn #17.12.17 -} - -######################################### -# 10.11.20 - -Setwindow<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - if(Nargs==0){ - Out<-c(XMIN,XMAX,YMIN,YMAX) - return(Out) - } - if(Nargs==1){ - Dt<- varargin[[1]] - if(is.list(Dt) && !is.data.frame(Dt)){ - Tmp<- as.data.frame(Dt) - Dt<- t(Tmp) - } - Xm<- min(Dt[,1]) - XM<- max(Dt[,1]) - Ym<- min(Dt[,2]) - YM<- max(Dt[,2]) - Str<- "Setwindow(" - Str<- paste(Str,"c(",as.character(Xm),",",as.character(XM),"),c(",sep="") - Str<- paste(Str,as.character(Ym),",",as.character(YM),")",sep="") - Str<- paste(Str,")",sep="") - print(Str) - } - if(Nargs==2){ - RgX<-varargin[[1]] - RgY<-varargin[[2]] - XMIN<<-RgX[1]; XMAX<<-RgX[2] - YMIN<<-RgY[1]; YMAX<<-RgY[2] - } - if(Nargs==4){ - XMIN<<-varargin[[1]]; XMAX<<-varargin[[2]] - YMIN<<-varargin[[3]]; YMAX<<-varargin[[4]] - } - Out<- c(XMIN,XMAX,YMIN,YMAX); -} - -######################################### - -Shadeold<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg=0 - Kosa=1 - if(Nargs>1){ - Iro=varargin[[Nargs]] - if(is.character(Iro)){ - Iroflg=1 - if(length(grep("{",Iro))>0){ - Str=paste("{\\color",Iro,sep="") - } - else{ - Str=paste("{\\color{",Iro,"}",sep="") - } - } - else{ - if(length(Iro)==1){ - Kosa=Iro - } - else{ - Iroflg=1 - if(length(Iro)==4){ - Str="{\\color[cmyk]{" - } - else{ - if(length(Iro)==3){ - Str="{\\color[rgb]{" - } - } - for(J in 1:length(Iro)){ - Str=paste(Str,as.character(Iro[J]),sep="") - if(J<length(Iro)){ - Str=paste(Str,",") - } - } - Str=paste(Str,"}") - } - } - if(Iroflg==1){ - Str=paste(Str,"%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - } - } - Tmp=varargin[[1]] - Data=Kyokai(Tmp) - Data=list(Data) ####180327 - for (I in Looprange(1, length(Data))){ - PL<- Op(I,Data) - Mojisu<- 0 - for (J in 1:Nrow(PL)){ - P<- Doscaling(Op(J,PL)) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if(Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- paste("\\special{ip}%\n",sep="") - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - } - if(Iroflg==1){ - cat("}%\n",file=Wfile,append=TRUE) - } -} - -####### Shade new 17.09.24############ - -Shade<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg<- 0 - Kosa<- 1 - if(Nargs>1){ - Iro<- varargin[[Nargs]] - if(mode(Iro)=="character"){ - Iroflg<- 1 - if(length(grep(Iro,"{"))>0) - Str<- paste("{\\color",Iro,sep="") - else - Str<- paste("{\\color{",Iro,"}",sep="") - } - else{ - if(length(Iro)==1) - Kosa<- Iro - else{ - Iroflg<- 1 - if(length(Iro)==4) - Str<- paste("{\\color[cmyk]{",sep="") - else - if(length(Iro)==3) - Str<- paste("{\\color[rgb]{",sep="") - for (J in Looprange(1,length(Iro))){ - Str<- paste(Str,as.character(Iro[J]),sep="") - if(J<length(Iro)) - Str<- paste(Str,",",sep="") - } - Str<- paste(Str,"}",sep="") - } - } - if(Iroflg==1){ - if(Wfile=="default") - cat(Str,"%\n",file="",append=TRUE,sep="") - else - cat(Str,"%\n",file=Wfile,append=TRUE,sep="") - } - } - Tmp<- varargin[[1]] - Data<- Kyoukai(Tmp) - for (I in Looprange(1, length(Data))){ - PL<- Op(I,Data) - Mojisu<- 0 - for (J in 1:Nrow(PL)){ - P<- Doscaling(Op(J,PL)) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - if(Wfile=="default") - cat(Str,file="",append=TRUE,sep="") - else - cat(Str,file=Wfile,append=TRUE,sep="") - Mojisu<- Mojisu+nchar(Str) - if(Mojisu>80){ - if(Wfile=="default") - cat("%\n",file="",append=TRUE,sep="") - else - cat("%\n",file=Wfile,append=TRUE,sep="") - Mojisu<- 0 - } - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- paste("\\special{ip}%\n",sep="") - if(Wfile=="default"){ - cat(Str1,file="",append=TRUE,sep="") - cat(Str2,file="",append=TRUE,sep="") - } - else{ - cat(Str1,file=Wfile,append=TRUE,sep="") - cat(Str2,file=Wfile,append=TRUE,sep="") - } - } - if(Iroflg==1){ - if(Wfile=="default") - cat("}%\n",file="",append=TRUE,sep="") - else - cat("}%\n",file=Wfile,append=TRUE,sep="") - } -} - -############################################## -# 11.01.07 - -Splinedata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-3) - PL<- varargin[[1]] - if(mode(PL)=="character"){ - Fname<- PL - PL<- Readtextdata(Fname) - } - else{ - PL<- as.matrix(PL) - if(Nrow(PL)==1){ - PL<- matrix(PL, nrow=length(PL)/2) - PL<- t(PL) - } - } - if(ncol(PL)==3){ - Flg3<- 1 - } - else{ - Flg3<- 0 - } - PLL<- Dividegraphics(PL) - N<- 50 - C<- c() - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if(mode(Tmp)!="character") next - if(length(grep("=",Tmp,fixed=TRUE))>0){ - eval(parse(text=Tmp)) - } - else{ - Tmp1<- substr(Tmp,1,1) - if(toupper(Tmp1)=="C"){ - C<- 1:length(PLL) - } - } - } - Cflg<- rep(0,length(PLL)) - for(J in Looprange(1,length(C))){ - K<- C[J] - Cflg[K]<- 1 - } - if(length(N)>1){ - Nj<- as.numeric(N) - } - else{ - Tmp<- lapply(PLL,nrow) - Tmp1<- as.numeric(Tmp) - MxP<- max(Tmp1) - Nj<- c() - for (J in 1:length(PLL)){ - Tmp<- nrow(PLL[[J]]) - Tmp1<- round(N/MxP*(Tmp-1)) - Nj<- c(Nj,Tmp1) - } - } - OutL<- list() - for(J in 1:length(PLL)){ - PL<- PLL[[J]] - if(Cflg[J]==1){ - if(Norm(PL[1,]-PL[Nrow(PL),])>Eps){ - PL<-Appendrow(PL,PL[1,]) - Nj[J]=round(N/MxP*nrow(PL)) - } - else{ - PL[Nrow(PL),]<- PL[1,] - } - } - Tn<- 1:Nrow(PL) - Xn<- PL[,1] - Yn<- PL[,2] - if(Flg3==1) Zn<- PL[,3] - if(Cflg[J]==0){ - Dxn<- spline(Tn,Xn,n=Nj[J]) - Dyn<- spline(Tn,Yn,n=Nj[J]) - if(Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J]) - } - else{ - Dxn<- spline(Tn,Xn,method="periodic") - Dyn<- spline(Tn,Yn,method="periodic") - if(Flg3==1) Dzn<- spline(Tn,Zn,method="periodic") - } - Tmp1<- Dxn$y - Tmp2<- Dyn$y - Tmp3<-c() - if(Flg3==1) Tmp3<- Dzn$y - Out<- matrix(c(Tmp1,Tmp2,Tmp3),nrow=length(Tmp1)) - OutL<- c(OutL,list(Out)) - } - return(OutL) -} - -############################################ -# 2013.05.03 Domain is optional - -Tabledata<- function(...){ - varargin<- list(...) - Eps<- 0.001 - Tmp<- varargin[[1]] # 130503 from - if(is.numeric(Tmp)){ - Domain<- varargin[[1]] - VL<- varargin[[2]] - HL<- varargin[[3]] - } - else{ - Domain<- c(-1,-1) - VL<- varargin[[1]] - HL<- varargin[[2]] - } # 130503 until - Hsize<- Domain[1] - SvL<- list(0) - S<- 0 - for (I in Looprange(1,length(VL))){ - Tmp<- VL[[I]] - S<- S+Tmp[1] - Tmp[1]<- S - SvL<- c(SvL,list(Tmp)) - } - if(Hsize>S){ - SvL<- c(SvL,list(Hsize)) - } - Hsize<- Op(1,SvL[[length(SvL)]]) - Vsize<- Domain[2] - ShL<- list(0) - S<- 0 - for (I in Looprange(1,length(HL))){ - Tmp<- HL[[I]] - S<- S+Tmp[1] - Tmp[1]<- S - ShL<- c(ShL,list(Tmp)) - } - if(Vsize>S){ - ShL<- c(ShL,list(Vsize)) - } - Vsize<- Op(1,ShL[[length(ShL)]]) - Marw<- 0; Mare<- 0; Mars<- 0; Marn<- 0 - if(length(Domain)>2){ - Marw<- Domain[3] - Mare<- Domain[4] - } - if(length(Domain)>4){ - Marn<- Domain[5] - Mars<- Domain[6] - } - Setwindow(c(-Marw,Hsize+Mare),c(-Mars,Vsize+Marn)) - Tmp<- Framedata(c(Eps,Hsize-Eps),c(Eps,Vsize-Eps)) - Gdata<- list(Tmp) - Tmp<- -Marw - Hdata<- list(Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn)))) - for (I in Looprange(1,length(SvL))){ - Data<- SvL[[I]] - X<- Data[1] - if(length(Data)==1){ - Y1<- 0 - Y2<- Vsize - G<- Listplot(c(X,Y1),c(X,Y2)) - } - else{ - G<- c() - for (J in seq(2,length(Data),by=2)){ - Y1<- Vsize-Op(1,ShL[[Data[J]]]) - Y2<- Vsize-Op(1,ShL[[Data[J+1]]]) - Tmp<- Listplot(c(c(X,Y1),c(X,Y2))) - Tmp1<- Appendrow(G,c(Inf,Inf)) - G<- Appendrow(Tmp1,Tmp) - } - G<- G[2:nrow(G),] - } - Hdata<- c(Hdata,list(G)) - } - Tmp<- Hsize+Mare - Tmp1<- Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn))) - Hdata<- c(Hdata,list(Tmp1)) - Tmp<- Vsize+Marn - Vdata<- list(Listplot(c(c(-Marw,Tmp),c(Hsize+Mare,Tmp)))) - for (I in Looprange(1,length(ShL))){ - Data<- ShL[[I]] - Y<- Vsize-Data[1] - if(length(Data)==1){ - X1<- 0 - X2<- Hsize - G<- Listplot(c(X1,Y),c(X2,Y)) - } - else{ - G<- c() - for (J in seq(2,length(Data),by=2)){ - X1<- Op(1,SvL[[Data[J]]]) - X2<- Op(1,SvL[[Data[J+1]]]) - Tmp<- Listplot(c(X1,Y),c(X2,Y)) - G<- Appendrow(G,c(Inf,Inf)) - G<- Appendrow(G,Tmp) - } - G<-G[2:nrow(G),] - } - Vdata<- c(Vdata,list(G)) - } -# Tmp<- Listplot(c(c(0,0),c(Hsize,0))) # 2011.03.02 -# Vdata<- Mixjoin(Vdata,list(Tmp)) - Tmp<- Listplot(c(c(-Marw,-Mars),c(Hsize+Mare,-Mars))) - Vdata<- Mixjoin(Vdata,list(Tmp)) - Tmp1<- Hdata[Looprange(3,length(Hdata)-2)] - Tmp2<- Vdata[Looprange(3,length(Vdata)-2)] - Gdata<- Mixjoin(Gdata,Tmp1,Tmp2) - Hind<- Looprange(2,1+length(Tmp1)) - Vind<- Looprange(2+length(Tmp1),1+length(Tmp1)+length(Tmp2)) - G=Gdata[[1]] - P1<- Ptsw(G); P2<- Ptnw(G) - Q1<- Ptse(G); Q2<- Ptne(G) - Tmp1<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) - P1<- Ptnw(G); P2<- Ptne(G) - Q1<- Ptsw(G); Q2<- Ptse(G) - Tmp2<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) - Tmp3<- Framedata() - Out<- list(Gdata,Hind,Vind,Tmp1,Tmp2,Tmp3) - return(Out) -} - -################################ - -Texcom<- function(Meirei) -{ - if(Meirei=="\\thinlines"){ - Setpen(1); - return(); - } - if(Meirei=="\\thicklines"){ - Setpen(2); - return() - } - if(Meirei=="\\Thicklines"){ - Setpen(3); - return() - } - if(length(Meirei)==0){ # 09.12.07 - Tmp<- c() - } - else{ - Tmp<- grep("newline",Meirei) - } - if(length(Tmp)>0){ - cat("\n",file=Wfile,append=TRUE); - } - else{ - Tmp<- paste(Meirei,"%\n",sep="") - Tmp<- gsub("//","\\",Tmp,fixed=TRUE) # 11.03.02 - cat(Tmp,file=Wfile,append=TRUE); - } -} - -############################################### - -Texctr<- function(N){ - if(is.numeric(N)){ - Alpha<- "abcdefghijklmnopqrstuvwxyz" - Out<- paste("ketpicctr",substr(Alpha,N,N),sep="") - } - else{ - if(grep("\\",N,fixed=TRUE)>0){ - Out<- substr(N,2,nchar(N)) - } - else{ - Out<- N - } - } - return(Out) -} - -############################################### - -Texelse<- function (){ - Texcom(""); - Texcom("\\else") -} - -############################################### - -Texend<- function() -{ - Texcom("%\n}") -} - -############################################### - -Texendfor<- function(I){ - Last<- TEXFORLAST[[TEXFORLEVEL]] - Texcom("") - Tmp<- paste("\\ifnum",Texthectr(I),"<",Last,sep="") - Texcom(Tmp) - Texcom("\\repeat") - Texcom("}") - TEXFORLEVEL<<- TEXFORLEVEL-1 - TEXFORLAST<<- TEXFORLAST[1:(length(TEXFORLAST)-1)] -} - -############################################### - -Texendif<- function(){ - Texcom("") - Texcom("\\fi") - Texcom("}") -} - -############################################### - -Texfor<- function(I,First,Last){ - TEXFORLEVEL<<- TEXFORLEVEL+1; - Texsetctr(I,"0") - Texsetctr(I,paste(as.character(First),"-1",sep="")) - Texcom("") - Texcom("{") - Texcom("\\loop") - Texsetctr(I,"+1") - TEXFORLAST<<- c(TEXFORLAST,as.character(Last)) -} - -############################################### - -Texforinit<- function(){ - TEXFORLEVEL<<- 0 - TEXFORLAST<<- list() -} - -############################################### - -Texif<- function(...){ - varargin<- list(...) - Condstr<- varargin[[1]] - Tp<- 0 - if(length(varargin)>1){ - Tp<- varargin[[2]] - } - Texcom("") - Texcom("{") - if(Tp==0){ - Texcom("\\ifnum") - } - else{ - Texcom("\\ifdim ") - } - Texcom(paste(Condstr," ",sep="")) -} - -###################################### - -Texletter<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - for (I in seq(1,Nargs,by=3)){ - P<- varargin[[I]] - X<- P[1] - if(mode(X)=="numeric"){ - X<- as.character(X) - } - Y<- P[2] - if(mode(Y)=="numeric"){ - Y<- as.character(Y) - } - Houkou<- varargin[[I+1]] - Mojiretu<- varargin[[I+2]] - Hset<- Houkou - Vhoko<- "c" - if(length(grep("n",Hset))>0){ - Vhoko<- "n" - } - if(length(grep("s",Hset))>0){ - Vhoko<- "s" - } - Hhoko<- "c"; - if(length(grep("e",Hset))>0){ - Hhoko<- "e" - } - if(length(grep("w",Hset))>0){ - Hhoko<- "w" - } - Hoko<- paste(Vhoko,Hhoko,sep="") - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - Tmp<- paste("\\put(",X,",",Y,"){\\hspace*{\\Width}",sep="") - Str<- paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - } -} - -################################################## - -Texnewcmd<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Str<- varargin[[1]] - S<- paste("\\newcommand{",Str,"}",sep="") - if(Nargs>1){ - Tmp<- as.character(varargin[[2]]) - S<- paste(S,"[",Tmp,"]",sep="") - } - if(Nargs>2){ - Tmp<- varargin[[3]] - if(mode(Tmp)=="numeric"){ - Tmp<- as.character(Tmp) - } - S<- paste(S,"[",Tmp,"]",sep="") - } - S<- paste(S,"{",sep="") - Texcom(S) -} - -############################################### - -Texnewctr<- function(N) -{ - if(mode(N)=="character"){ - Str<- paste("\\newcounter{",N,"}",sep="") - Texcom(Str) - } - else{ - for (I in N){ - Str<- paste("\\newcounter{",Texctr(I),"}",sep="") - Texcom(Str) - } - } -} -############################################### - -Texrenewcmd<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Str<- varargin[[1]] - S<- paste("\\renewcommand{",Str,"}",sep="") - if(Nargs>1){ - Tmp<- as.character(varargin[[2]]) - S<- paste(S,"[",Tmp,"]",sep="") - } - if(Nargs>2){ - Tmp<- varargin[[3]] - if(mode(Tmp)=="numeric"){ - Tmp<- as.character(Tmp) - } - S<- paste(S,"[",Tmp,"]",sep="") - } - S<- paste(S,"{",sep="") - Texcom(S) -} - -############################################### - -Texsetctr<- function(Nctr,Opstr) -{ - Ctr<- Texctr(Nctr) - Opstr<- paste(Opstr,"%",sep="") - OperL<- "+-*/%" - Oper<- "" - Va<- "" - Evflg<- 0 - Paflg<- 0 - for (I in Looprange(1,nchar(Opstr))){ - Tmp<- substring(Opstr,I,I) - if(Tmp=="("){ - Paflg<- 1 - if(nchar(Va)>0){ - Evflg<- 1 - Va<- paste(Va,Tmp,sep="") - } - next - } - if(Tmp==")"){ - Paflg<- 0 - if(Evflg>0){ - Va<- paste(Va,Tmp,sep="") - } - next - } - if(Paflg>0){ - Va<- paste(Va,Tmp,sep="") - next - } - if(length(grep(Tmp,OperL))==0){ - Va<- paste(Va,Tmp,sep="") - } - else{ - if(Evflg>0){ - Tmp1<- eval(parse(text=Va)) - Va<- paste("\\value{",Tmp1,"}",sep="") - Evflg<- 0 - } - if(Oper==""){ - if(nchar(Va)>0){ - Str<- paste("\\setcounter{",Ctr,"}{",Va,"}",sep="") - Texcom(Str) - } - Oper<- Tmp - Va<-"" - } - else if(Oper=="+"){ - Str<- paste("\\addtocounter{",Ctr,"}{",Va,"}",sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="-"){ - Str<- paste("\\addtocounter{",Ctr,"}{-",Va,"}",sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="*"){ - Str<- paste("\\multiply\\value{",Ctr,"} by ",Va,sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="/"){ - Str<- paste("\\divide\\value{",Ctr,"} by ",Va,sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - } - } -} - -############################################### - -Texthectr<- function(N) -{ - Out<- paste("\\the",Texctr(N),sep="") - return(Out) -} - -############################################### - -Texvalctr<- function(N){ - Out<- paste("\\value{",Texctr(N),"}",sep="") - return(Out) -} - -############################################### - -Texvctr<- function(N) -{ - Out<- paste("\\value{",Texctr(N),"}",sep="") - return(Out) -} - -############################################### - -Tonumeric <- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Data<- varargin[[1]] - Sp<- c(1,1) - Ep<- c(Inf,Inf) - if(Nargs>1){ - Sp<- varargin[[2]] - } - if(Nargs>2){ - Ep<- varargin[[3]] - } - Nrs<- Sp[1] - Nre<- min(nrow(Data),Ep[1]) - Ncs<- Sp[2] - Nce<- min(ncol(Data),Ep[2]) - Tmp1<- Data[Nrs:Nre, Ncs:Nce] - Tmp2 <- as.numeric(Tmp1) - Out <- matrix(Tmp2,nrow=nrow(Tmp1)) - Sp<- c() - for (I in 1:nrow(Out)){ - for (J in 1:ncol(Out)){ - Tmp<- Out[I,J] - if(!is.na(Tmp)){ - Sp<- c(I,J) - break; - } - } - if(length(Sp)>0) break - } - if(length(Sp)==0){ - return("Numeric data not found") - } - Ep<- c(nrow(Out),ncol(Out)) - for (I in Sp[1]:nrow(Out)){ - Tmp<- Out[I,Sp[2]] - if(is.na(Tmp)){ - Ep[1]<- I-1 - break - } - } - for (J in Sp[2]:ncol(Out)){ - Tmp<- Out[Sp[1],J] - if(is.na(Tmp)){ - Ep[2]<- J-1 - break - } - } - Out<- Out[Sp[1]:Ep[1], Sp[2]:Ep[2]] - return(Out) -} - -################################################## - -Translatedata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if(Mixtype(ML)==1){ - ML<- list(ML) - } - Tmp=varargin[[2]] - if(mode(Tmp)=="numeric" && length(Tmp)>1){ - A<- Tmp[1]; B<- Tmp[2] - } - else{ - A<- Tmp - if(Nargs>=3){ - B<- varargin[[3]] - } - else{ - B<- 0 - } - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if(X1==Inf){ - X2<- X1 - Y2<-Y1 - } - else{ - X2<- X1+A - Y2<- Y1+B - } - Out<- Appendrow(Out,c(X2,Y2)) - } - OutL<- Mixjoin(OutL,list(Out)) - } - if(length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -####################################### - -Unscaling<- function(G) -{ - GLg<- G - if(class(GLg)=="numeric"){ - GLg<-c(G[1]/SCALEX, G[2]/SCALEY) - Tmp<-GLg - if(LOGX==1) Tmp[1]<- 10^(GLg[1]) - if(LOGY==1) Tmp[2]<- 10^(GLg[2]) - return(Tmp) - } - else{ - Tmp1<-matrix(c(1/SCALEX,0,0,1/SCALEY),nrow=2) - GLg<-G %*% Tmp1 - Tmp<-GLg - if(LOGX==1) Tmp[,1]<- 10^(G[,1]) - if(LOGY==1) Tmp[,2]<- 10^(G[,2]) - return(Tmp) - } -} - -############################################# - -Vtickmark<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if(mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if(K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if(is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if(J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if(is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if(is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if(mode(Dt)=="numeric" && length(Dt)>1){ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt[1],Dt[2]) - next - } - if(mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(GENTEN[1],Dt) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X+MARKLEN,Y)) - Tmp2<- Unscaling(c(X-MARKLEN,Y)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if(Ndt==3){ - Tmp<-Unscaling(c(X-MARKLEN,Y)) - Expr(Tmp,"w",Moji) - } - if(Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("w",Houkou) - if(length(Tmp)>0){ - Tmp<-Unscaling(c(X-MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X+MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -############################################ - -Windisp<-function(...){ - varargin<-list(...) - Nargs<-length(varargin) - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") - Tmp<- Doscaling(Listplot(c(0,YMIN),c(0,YMAX))) - axis(2,at=as.numeric(Tmp[,2]), labels=round(c(YMIN,YMAX),2)) - Tmp<- Doscaling(Listplot(c(XMIN,0),c(XMAX,0))) - axis(1,at=as.numeric(Tmp[,1]), labels=round(c(XMIN,XMAX),2)) - Tmp1<- c(XMIN,GENTEN[2]) - Tmp2<- c(XMAX,GENTEN[2]) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if(Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp1<- c(GENTEN[1],YMAX) - Tmp2<- c(GENTEN[1],YMIN) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if(Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp<-Doscaling(Framedata()) - lines(Tmp[,1],Tmp[,2]) - for (I in Looprange(1,Nargs)){ - Pdata<-varargin[[I]] - if(mode(Pdata)=="numeric"){ - Pdata<-list(Pdata) - } - while(Mixtype(Pdata)==3){ # 10.02.23 - Tmp1<- list() - for(II in Looprange(1,length(Pdata))){ - Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) - } - Pdata<- Tmp1 - } # 10.02.23 - for (II in Looprange(1,length(Pdata))){ - Tmp<-Pdata[[II]] - P<-MakeCurves(Tmp,0) - Ndm<-Dataindex(P) - for (J in Looprange(1,Nrow(Ndm))){ - Q<-P[Ndm[J,1]:Ndm[J,2],] - if(Nrow(Q)==1){ - Tmp<-seq(1,Ncol(Q),by=2) - for (K in Tmp){ - Pt<-Q[K:(K+1)] - points(Pt[1],Pt[2]) - } - } - else{ - lines(Q[,1],Q[,2]) - } - } - } - } -} - -############################################ - -WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ # 10.12.04 - par(new=new) - varargin<-list(...) - Nargs<-length(varargin) - if(!new) # 10.12.04 - { - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") - Tick<- sort(c(YMIN,YMAX,vtick)) #### 10.12.04 from here - Tmp1<- matrix(c(rep(0,length(Tick)),Tick),ncol=2) - Tmp<- Doscaling(Tmp1) - axis(2,at=as.numeric(Tmp[,2]), labels=round(Tick,2)) - Tick<- sort(c(XMIN,XMAX,htick)) - Tmp1<- matrix(c(Tick,rep(0,length(Tick))),ncol=2) - Tmp<- Doscaling(Tmp1) - axis(1,at=as.numeric(Tmp[,1]), labels=round(Tick,2)) #### 10.12.04 to here - Tmp1<- c(XMIN,GENTEN[2]) - Tmp2<- c(XMAX,GENTEN[2]) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if(Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp1<- c(GENTEN[1],YMAX) - Tmp2<- c(GENTEN[1],YMIN) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if(Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp<-Doscaling(Framedata()) - lines(Tmp[,1],Tmp[,2]) - } - for (I in Looprange(1,Nargs)){ - Pdata<-Flattenlist(varargin[[I]]) # 101129 from here - Cmd<- list() - for (II in Looprange(1,length(Pdata))){ - Tmp<-Pdata[[II]] - if(length(Tmp)==1){ - Cmd<- c(Cmd,list(Tmp)) - next - } - - P<-MakeCurves(Tmp,0) - - if(length(Cmd)>0){ - if(length(Cmd)>=3){ - polygon(P,col=Cmd[[1]],border=Cmd[[2]],density=Cmd[[3]]) - } - else{ - polygon(P,col=Cmd[[1]],border=Cmd[[2]]) - } - next - } # 101129 to here - Ndm<-Dataindex(P) - for (J in Looprange(1,Nrow(Ndm))){ - Q<-P[Ndm[J,1]:Ndm[J,2],] - if(Nrow(Q)==1){ - Tmp<-seq(1,Ncol(Q),by=2) - for (K in Tmp){ - Pt<-Q[K:(K+1)] - points(Pt[1],Pt[2],col=color)#taka101111 - } - } - else{ - lines(Q[,1],Q[,2],col=color,lwd=width)#taka101111 - } - } - } - } - par(new=FALSE) -} - -###################################### - -# 3D - -################################# - -# 10.08.16 -CameracoordCurve<- function(Curve){ - Out<- c() - for(J in Looprange(1,Nrow(Curve))){ - P<- Ptcrv(J,Curve) #P=Curve(J,:); - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Xz<- X3 - Yz<- E3/(E3-X3)*Y3 - Zz<- E3/(E3-X3)*Z3 - Out<- rbind(Out,c(Yz,Zz,Xz)) - } - rownames(Out)<- 1:Nrow(Out) - return(Out) -} - -######################################### - -#100815 -CameraCurve<- function(Curve){ - Eps<- 10^(-6) - for (I in Looprange(1,Nrow(Curve))){ - P<- Curve[I,] - x<- P[1]; y<- P[2]; z<- P[3] - if(x!=Inf){ - Tmp<- Perspt(P) - if(I==1){ - AnsL<- rbind(c(),Tmp) - }else{ - Tmp1<- AnsL[Nrow(AnsL),] - if(Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){ - AnsL<- rbind(AnsL,Tmp) - } - } - }else{ - AnsL<- rbind(AnsL,c(Inf,Inf)) - } - } - rownames(AnsL)<- 1:Nrow(AnsL) - return(AnsL) -} - -###################################### - -Cancoordpara<- function(P){ # 18.02.15 - Xz<- P[1] - Yz<- P[2] - Zz<- P[3] - X<- -Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA) - Y<- Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA) - Z<- Yz*sin(THETA)+Zz*cos(THETA) - Out<- c(X,Y,Z) - return(Out) -} - -###################################### - -Cancoordpers<- function(P){ - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Xz<- P[3]; Yz<- P[1]; Zz<- P[2] - X3<- Xz; Y3<- Yz*(E3-Xz)/E3; Z3<- Zz*(E3-Xz)/E3 - X2<- X3*Cb-Sb*Z3; Y2<- Y3; Z2<- Cb*Z3+Sb*X3 - X1<- X2*Ca-Sa*Y2; Y1<- Ca*Y2+Sa*X2; Z1<- Z2 - X<- X1+FocusPoint[1] - Y<- Y1+FocusPoint[2] - Z<- Z1+FocusPoint[3] - Out<- c(X,Y,Z) - return(Out) -} - -####################################### - -Embed<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Pd3<- varargin[[1]] - if(Mixtype(Pd3)==1){ - Pd3<- list(Pd3) - } - else if(Mixtype(Pd3)==3){ - Tmp<- list(); - for(I in Looprange(1,length(Pd3))){ - Tmp<- c(Tmp,Pd3[[I]]) - } - Pd3<- Tmp - } - Tmpf=varargin[[2]] - if(mode(Tmpf)=="character"){ - Tmp<- varargin[[3]] - Tmp1<- gsub("c(","(",Tmp,fixed=TRUE) - Vstr<- gsub(")",")",Tmp1,fixed=TRUE) - Str<- paste("Tmpfn<- function",Vstr,"{",Tmpf,"}",sep="") - eval(parse(text=Str)) - } - else{ - Tmpfn<- Tmpf - } - Out<- list() - for(I in Looprange(1,length(Pd3))){ - PD<- Pd3[[I]] - Ans<- c() - for(J in Looprange(1,Nrow(PD))){ - P<- PD[J,] - Tmp<- Tmpfn(P[1],P[2]) - Ans<- rbind(Ans,Tmp) - } - Out<- c(Out, list(Ans)) - } - if(length(Out)==1){ - Out<- Out[[1]] - } - return(Out) -} - -####################### -# 10.08.17 -# 14.03.30 -Facesdata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - FL<- varargin[[1]] - PT<- varargin[[length(varargin)]] - Tmp<-grep("para",PT,fixed=TRUE) - if(length(Tmp)>0){ - Ptype<- 1 - }else{ - Ptype<- -1 - } - if(Nargs==2){ - CLadd<- list() - }else{ - CLadd<- varargin[[2]] - } - NohiddenL<- list() - HiddenL<- list() - Eps<- 10^(-4) - if(length(CLadd)>0){ - if(mode(CLadd)=="numeric"){ - C<- list() - if(Nrow(CLadd)>1){ - for (I in Looprange(1,Nrow(CLadd))){ - C<- c(C,list(CLadd[I,])) - } - }else{ - I<- 1 - while (I<=Ncol(CLadd)){ - C<- c(C,list(CLadd[1,I:(I+2)])) - I<- I+3 - } - } - CrvL<- list(C) - }else if(mode(CLadd[[1]])=="numeric"){ - CrvL<- list() - for (J in Looprange(1,length(CL))){ - Ctmp<- CLadd[[J]] - C<- list() - if(Nrow(Ctmp)>1){ - for (I in Looprange(1,Nrow(Ctmp))){ - C<- c(C,list(Ctmp[I,])) - } - }else{ - I<- 1 - while(I<=Ncol(Ctmp)){ - C<- c(C,list(Ctmp[1,I:(I+2)])) - I<- I+3 - } - } - CrvL<- c(CrvL,list(C)) - } - }else{ - CrvL<- CLadd - } - }else{ - CrvL<- list() - } - Out<- MakeveLfaceL(FL) - VELNO<<- Out[[1]] - VELHI<<- list() - for (I in Looprange(1,length(CrvL))){ - Tmp<- CrvL[[I]] - for (J in Looprange(1,length(Tmp)-1)){ - Edge<- list(Tmp[J],Tmp[J+1]) - Ntmp<- length(VELNO) - VELNO(Ntmp+1)<<- list(Edge,0,Ntmp+1) - } - } - FaceL<- Out[[2]] - Tmp<- grep("raw",PT,fixed=TRUE) - if(length(Tmp)==0){ - for (Nf in Looprange(1,length(FaceL))){ - Face<- FaceL[[Nf]] - Menkakusi2(Face,Nf,Ptype) - } - } - for (I in Looprange(1,length(VELNO))){ - Edge<- Op(1,VELNO[[I]]) - if(Norm(Edge[[1]]-Edge[[2]])>Eps){ - NohiddenL<- c(NohiddenL,list(Spaceline(Edge))) - } - } - EdgeL<- list() # from 13.03.30 - for(K in Looprange(1,length(VELHI))){ - Edge<- Op(1,VELHI[[K]]) - P<- Edge[[1]]; Q<- Edge[[2]] - if(Norm(P-Q)>Eps){ - EdgeL<- c(EdgeL,list(Edge)) - } - } - for(K in Looprange(1,length(EdgeL))){ - Edge<- EdgeL[[K]] - P<- Edge[[1]]; Q<- Edge[[2]] - Cflg<- 0 - for(J in Looprange(K+1,length(EdgeL))){ - Ej<- EdgeL[[J]] - Pj<- Ej[[1]]; Qj<- Ej[[2]] - if(Norm(Crossprod(Q-P,Qj-Pj))>Eps){ - next - } - if(Norm(Q-Pj)<Eps){ - EdgeL[[J]]<- list(P,Qj) - Cflg<- 1 - break - } - if(Norm(P-Qj)<Eps){ - EdgeL[[J]]=list(Q,Pj) - Cflg<- 1 - break - } - } - if(Cflg==0){ - HiddenL<- c(HiddenL,list(Spaceline(Edge))) - } - } # until 14.03.30 - PHHIDDENDATA<<- HiddenL - return(NohiddenL) -} - -############################## -# 2014.03.31 - -PhHiddenData<- function(){ - PHHIDDENDATA -} - -########## Old Fullform ( Check the case of Polygon )#################### - -Fullformfunc<- function(FdL){# Out=Fullformfunc(FdL) - Out<- list(Op(1,FdL)) - N<- Mixlength(FdL) - for (Jrg in Looprange(1,N)){ - Tmp<- Stripblanks(Op(Jrg,FdL)) - Tmp1<- grep("=c(",Tmp,fixed=TRUE) - if(length(Tmp1)>0){ - break - } - } - Urg<- Stripblanks(Op(Jrg,FdL)) - StrV<- strsplit(Urg,"=",fixed=TRUE)[[1]] - Uname<- StrV[1] - Vrg<- Stripblanks(Op(Jrg+1,FdL)) - StrV<- strsplit(Vrg,"=",fixed=TRUE)[[1]] - Vname<- StrV[1] - if(Jrg==2){ - Tmp<- Stripblanks(Op(1,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- list(Uname,Vname,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - }else if(Jrg==4){ - Tmp<- Stripblanks(Op(1,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- Stripblanks(Op(2,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Xname<- StrV[1] - Xf<- StrV[2] - Tmp<- Stripblanks(Op(3,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Yname<- StrV[1] - Yf<- StrV[2] - Tmp<- gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) - Zf<- gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) - Tmp<- list(Xf,Yf,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - }else{ - Tmp<- Stripblanks(Op(2,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Xf<- StrV[2] - Tmp<- Stripblanks(Op(3,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Yf<- StrV[2] - Tmp<- Stripblanks(Op(4,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- list(Xf,Yf,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - } - DrwS<- "enws" - BdyL<- c() - for (I in Looprange(Jrg+2,Mixlength(FdL))){ - Tmp<- Op(I,FdL) - if(mode(Tmp)=="character"){ - if(length(Tmp)==0){ - Tmp<- " " - } - DrwS<- Tmp - } - if(mode(Tmp)=="numeric" && Ncol(Tmp)>1){ - BdyL<- Tmp - } - } - Tmp<- list(DrwS,BdyL) - Out<- c(Out,Tmp) - return(Out) -} - -#################################### - -Initangle<- function (){ - PHI<<- 30*pi/180 - THETA<<- 60*pi/180 -} - -########################## - -Invparapt<- function(...){ - varargin<- list(...) - Eps<- 10^(-4) - Fk<- varargin[[length(varargin)]] - NFk<- Numptcrv(Fk) - Tmp<- varargin[[1]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ # debug - Ph<- Tmp - Fh<- varargin[[2]] - }else{ - Fh<- Projpara(Fk) - if(NFk>2){ - Tmp1<- Nearestpt(Tmp,Fh) - Ph<- Tmp1[[2]] - }else{ - Ah<- Ptcrv(1,Fh); Bh=Ptcrv(2,Fh) - V1<- Tmp-Ah; V2<- Bh-Ah - Tmp1<- Crossprod(V1,V2) - if(abs(Tmp1)>Eps){ - print("Not on the line") - return(c()) - }else{ - Ph<- Dotprod(V1,V2)/Norm(V2)^2+1 - } - } - } - if(NFk>2){ - N<- trunc(Ph) - S0<- Ph-N - if(Ph>Numptcrv(Fh)-Eps){ - Out<- list(Ptend(Fk),Numptcrv(Fh)) - return(Out) - } - }else{ - N<- 1 - S0<- Ph-1 - } - Ak<- Ptcrv(N,Fk); Bk=Ptcrv(N+1,Fk) - Ah<- Ptcrv(N,Fh); Bh=Ptcrv(N+1,Fh) - Ph<- (1-S0)*Ah+S0*Bh - T2<- S0 - Pk<- (1-T2)*Ak+T2*Bk - Out<- list(Pk,N+T2) - return(Out) -} - -################################# - -#100815 -Invperspt<- function(...){ - varargin<-list(...) - Eps<- 10^(-4) - Fk<- varargin[[length(varargin)]] - NFk<- Numptcrv(Fk) - Tmp<- varargin[[1]] - if(mode(Tmp)=="numeric" && length(Tmp)==1){ - Ph<- varargin[[1]] - Fh<- varargin[[2]] - }else{ - Fh<- Projpers(Fk) - if(NFk>2){ - Tmp1<- Nearestpt(Tmp,Fh) - Ph<- Tmp1[[2]] - }else{ - Ah<- Ptcrv(1,Fh); Bh<- Ptcrv(2,Fh) - V1<- Tmp-Ah; V2<- Bh-Ah - Tmp1<- Crossprod(V1,V2) - if(abs(Tmp1)>Eps){ - print("Not on the line") - Out<- c() - return(Out) - }else{ - Ph<- Dotprod(V1,V2)/Norm(V2)^2+1# 09.11.12 - } - } - } - if(NFk>2){ - N<- trunc(Ph) - S0<- Ph-N - if(Ph>Numptcrv(Fh)-Eps){ - Out<- list(Ptend(Fk),Numptcrv(Fh)) - return(Out) - } - }else{ - N<- 1 - S0<- Ph-1 # 09.11.12 - } - Ak<- Ptcrv(N,Fk); Bk<- Ptcrv(N+1,Fk) - Ah<- Ptcrv(N,Fh); Bh<- Ptcrv(N+1,Fh) - Ph<- (1-S0)*Ah+S0*Bh - Phc<- Cancoordpers(c(Ph,0)) - Ahc<- Cancoordpers(c(Ah,0)) - Bhc<- Cancoordpers(c(Bh,0)) - Vp<- Phc-EyePoint - Va<- Ak-EyePoint - AB<- Bk-Ak - Cp<- Crossprod(Vp,AB) - Nmr<- Crossprod(Va,Vp) - Mx<- max(abs(Cp)) - if(abs(Cp[1])==Mx){ - T2<- Nmr[1]/Cp[1] - }else if(abs(Cp[2])==Mx){ - T2<- Nmr[2]/Cp[2] - }else{ - T2<- Nmr[3]/Cp[3] - } - Pk<- (1-T2)*Ak+T2*Bk - Out<- list(Pk,N+T2) - return(Out) -} - -######################### - -Kukannozoku<- function(Jokyo,KukanL){ - Eps<- 10^(-6) - N<- Nrow(KukanL) - T1<- Jokyo[1]; T2<- Jokyo[2] - Tmp<- KukanL[1,] - T1<- max(T1,Tmp[1]) - Tmp<- KukanL[N,] - T2<- min(T2,Tmp[2]) - Res<- c() - Flg<- 0 - for (I in Looprange(1,N)){ - Ku<- KukanL[I,] - if(Flg==0){ - if(Ku[2]<T1){ - Res<- rbind(Res,Ku) - }else{ - Flg<- 1 - if(Ku[1]<T1-Eps){ - Tmp<- c(Ku[1],T1) - Res<- rbind(Res,Tmp) - } - if(Ku[2]>T2+Eps){ - Tmp<- c(T2,Ku[2]) - Res<- rbind(Res,Tmp) - } - } - }else if(Flg==1){ - if(Ku[2]<T2){ - next - }else{ - Flg<- 2 - if(Ku[1]<T2-Eps){ - Ku<- c(T2,Ku[2]) - } - Res<- rbind(Res,Ku) - } - }else{ - Res<- rbind(Res,Ku) - } - } - return(Res) -} - -######################################## - -Makeskeletondata<- function(Obj2L,Plt2L,R0,Eps2){ - Eps<- 10.0^(-3) - Dmat<- c() - Dind<- c() - for (I in Looprange(1,Mixlength(Plt2L))){ - Dt<- Op(I,Plt2L) - N1<- Nrow(Dmat)+1 - if(Nrow(Dmat)==0){ - Dmat<- Dt - }else{ - Dmat<- rbind(Dmat,Dt) - } - N2<- Nrow(Dmat) - Dind<- c(Dind,N1,N2) - } - Dind<- matrix(Dind,ncol=2,byrow=TRUE) - Nind<- Nrow(Dind) - Allres<- list() - for (Nobj in Looprange(1,Mixlength(Obj2L))){ - Plt2<- Op(Nobj,Obj2L) - PhL<- Plt2[,1:2] - ClipL<- c() - for (Ns in Looprange(1,Nrow(PhL)-1)){ - P1<- PhL[Ns:(Ns+1),] - for (I in Looprange(1,Nrow(Dind))){ - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - P2<- Tmp[,1:2] - KC<- IntersectcrvsPp(P1,P2,Eps) - if(Mixlength(KC)>0){ - for (J in 1:Mixlength(KC)){ - P<- Op(1,Op(J,KC)) - Tmp<- Op(2,Op(J,KC)) - if(Tmp<1+Eps && Ns==1){ - next - } - if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ - next - } - N1<- Ns - N2<- Op(3,Op(J,KC)) - Pa<- Plt2[N1,1:2] - Za<- Plt2[N1,3] - Pb<- Plt2[N1+1,1:2] - Zb<- Plt2[N1+1,3] - if(Norm(Pa-Pb)<Eps){ - next - } - T1<- Norm(Pa-P)/Norm(Pa-Pb) - Z1<- (1-T1)*Za+T1*Zb - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - Pa<- Tmp[N2,1:2] - Za<- Tmp[N2,3] - Pb<- Tmp[N2+1,1:2] - Zb<- Tmp[N2+1,3] - if((Norm(Pa-Pb)<Eps)){ - next - } - T2<- Norm(Pa-P)/Norm(Pa-Pb) - Z2<- (1-T2)*Za+T2*Zb - if(Z1<Z2-Eps2){ - if(Nrow(ClipL)==0){ - Tmp<- 1 - }else{ - Tmp1<- ClipL[,1]-P[1] - Tmp2<- ClipL[,2]-P[2] - Tmp3<- Tmp1^2+Tmp2^2 - Tmp<- min(Tmp3) - } - if(Tmp>Eps^2){ - Tmp1<- P1[2,]-P1[1,] - Tmp2<- Pb-Pa - Tmp3<- Dotprod(Tmp1,Tmp2) - Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) - Tmp<- 1-0.5*Tmp3^2 - ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) - } - } - } - } - } - } - Te<- Nrow(Plt2) - KukanL<- rbind(c(),c(1.0,Te)) - P1<- PhL - if(Nrow(ClipL)>0){ - for (I in 1:Nrow(ClipL)){ - P<- ClipL[I,1:2] - NN<- ClipL[I,3] - T<- NN+ClipL[I,4] - R<- ClipL[I,5] - Flg<- 0 - for (J in NN:1){ - Q<- Pointoncurve(J,P1) - if(Norm(P-Q)<R){ - next - } - Flg<- 1 - break - } - if(Flg==0){ - T1<- 1 - }else{ - T1<- J; T2<- T - H<- T2-T1 - for (N in 1:10){ - H<- H*0.5 - Q<- Pointoncurve(T1+H,P1) - if(Norm(P-Q)<R){ - T2<- T2-H - }else{ - T1<- T1+H - } - } - } - Ku<- c(T1) - Flg<- 0 - for (J in Looprange(NN+1,Te)){ - Q<- Pointoncurve(J,P1) - if(Norm(P-Q)<R){ - next - } - Flg<- 1 - break - } - if(Flg==0){ - T2<- Te - }else{ - T1<- T; T2<- J - H<- T2-T1 - for (N in 1:10){ - H<- H*0.5 - Q<- Pointoncurve(T1+H,P1) - if(Norm(P-Q)<R){ - T1<- T1+H - }else{ - T2<- T2-H - } - } - } - Ku<- c(Ku,T2) - KukanL<- Kukannozoku(Ku,KukanL) - } - } - Res<- list() - for (I in Looprange(1,Nrow(KukanL))){ - T1<- KukanL[I,1]; N1<- trunc(T1) - T2<- KukanL[I,2]; N2<- trunc(T2) - PtL<- list() - if(T1-N1<1-Eps){ - Tmp<- Pointoncurve(T1,P1) - PtL<- list(Tmp) - } - for (J in Looprange(N1+1,N2)){ - Tmp<- Pointoncurve(J,P1) - PtL<- c(PtL,list(Tmp)) - } - if(T2-N2>Eps){ - Tmp<- Pointoncurve(T2,P1) - PtL<- c(PtL,list(Tmp)) - } - Res<- c(Res,list(Listplot(PtL))) - } - Allres<- c(Allres,Res) - } - return(Allres) -} - -######################### - -#100815 -Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){ - Eps<- 10.0^(-3) - Dmat<- c() - Dind<- c() - for (I in Looprange(1,Mixlength(Plt2L))){ - Dt<- Op(I,Plt2L) - N1<- Nrow(Dmat)+1 - Dmat<- rbind(Dmat,Dt) - N2<- Nrow(Dmat) - Dind<- rbind(Dind,c(N1,N2)) - } - Nind<- Nrow(Dind) - Allres<- list() - for (Nobj in Looprange(1,Mixlength(Obj2L))){ - Plt2<- Op(Nobj,Obj2L) - PhL<- Plt2[,1:2] - ClipL<- c() - for (Ns in Looprange(1,Nrow(PhL)-1)){ - P1<- PhL[Ns:(Ns+1),] - for (I in Looprange(1,Nrow(Dind))){ - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - P2<- Tmp[,1:2] - KC<- IntersectcrvsPp(P1,P2,Eps) - if(Mixlength(KC)>0){ - for (J in Looprange(1,Mixlength(KC))){# - P<- Op(1,Op(J,KC)) - Tmp<- Op(2,Op(J,KC)) - if(Tmp<(1+Eps) && Ns==1){ - next - } - if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ - next - } - N1<- Ns - N2<- Op(3,Op(J,KC)) - Pa<- Plt2[N1,1:2] - Za<- Plt2[N1,3] - Pb<- Plt2[N1+1,1:2] - Zb<- Plt2[N1+1,3] - if(Norm(Pa-Pb)<Eps){ - next - } - T1<- Norm(Pa-P)/Norm(Pa-Pb)#norm(Pa-P)/norm(Pa-Pb) - Pka<- Cancoordpers(c(Pa[1],Pa[2],Za)) - Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb)) - if(T1>1-Eps){ - Pk<- Pkb - }else{ - Tmp1<- Listplot(c(Pa,Pb)) - Tmp2<- Spaceline(c(Pka,Pkb)) - Tmp<- Invperspt(1+T1,Tmp1,Tmp2) - Pk<- Op(1,Tmp) - } - Z1<- Zperspt(Pk) - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - Pa<- Tmp[N2,1:2] - Za<- Tmp[N2,3] - Pb<- Tmp[N2+1,1:2] - Zb<- Tmp[N2+1,3] - if(Norm(Pa-Pb)<Eps){ - next - } - T2<- Norm(Pa-P)/Norm(Pa-Pb) - Pka<- Cancoordpers(c(Pa[1],Pa[2],Za)) - Pkb<- Cancoordpers(c(Pb[1],Pb[2],Zb)) - if(T2>(1-Eps)){ - Pk<- Pkb - }else{ - Tmp1<- Listplot(c(Pa,Pb)) - Tmp2<- Spaceline(c(Pka,Pkb)) - Tmp<- Invperspt(1+T2,Tmp1,Tmp2) - Pk<- Op(1,Tmp) - } - Z2<- Zperspt(Pk) - if(Z1<(Z2-Eps2)){ - if(length(ClipL)==0){ - Tmp<- 1 - }else{ - Tmp1<- ClipL[,1]-P[1] - Tmp2<- ClipL[,2]-P[2] - Tmp3<- Tmp1^2+Tmp2^2 - Tmp<- min(Tmp3) - } - if(Tmp>Eps^2){ - Tmp1<- P1[2,]-P1[1,] - Tmp2<- Pb-Pa - Tmp3<- Dotprod(Tmp1,Tmp2) - Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) - Tmp<- 1-0.5*Tmp3^2 - ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) - } - } - } - } - } - } - Te<- Nrow(Plt2) - KukanL<- rbind(c(),c(1.0,Te)) - P1<- PhL - if(Nrow(ClipL)>0){ - for (I in Looprange(1,Nrow(ClipL))){ - P<- ClipL[I,1:2] - NN<- ClipL[I,3] - T<- NN+ClipL[I,4] - R<- ClipL[I,5] #added 10.08.17 - Flg<- 0 - for (J in NN:1){ - Q<- Pointoncurve(J,P1) - if(Norm(P-Q)<R){#(norm(P-Q)<R) - next - } - Flg<- 1 - break - } - if(Flg==0){ - T1<- 1 - }else{ - T1<- J; T2<- T - H<- T2-T1 - for (N in 1:10){ - H<- H*0.5 - Q<- Pointoncurve(T1+H,P1) - if(Norm(P-Q)<R){ # norm(P-Q)<R - T2<- T2-H - }else{ - T1<- T1+H - } - } - } - Ku<- c(T1)#Ku<- [T1] - Flg<- 0 - for (J in Looprange(NN+1,Te)){ - Q<- Pointoncurve(J,P1) - if(Norm(P-Q)<R){ - next#continue - } - Flg<- 1 - break - } - if(Flg==0){ - T2<- Te - }else{ - T1<- T; T2<- J - H<- T2-T1 - for (N in 1:10){ - H<- H*0.5 - Q<- Pointoncurve(T1+H,P1) - if(Norm(P-Q)<R){ - T1<- T1+H - }else{ - T2<- T2-H - } - } - } - Ku<- c(Ku,T2)#[Ku,T2] - KukanL<- Kukannozoku(Ku,KukanL) - } - } - Res<- list()#[] - for (I in Looprange(1,Nrow(KukanL))){#(I=1:size(KukanL,1)) - T1<- KukanL[I,1]; N1<- trunc(T1) - T2<- KukanL[I,2]; N2<- trunc(T2) - PtL<- list()#[] - if(T1-N1<1-Eps){ - Tmp<- Pointoncurve(T1,P1) - PtL<- list(Tmp)#100816c(PtL,list(Tmp)) PtL<- MixS(Tmp) - } - for (J in Looprange(N1+1,N2)){ - Tmp<- Pointoncurve(J,P1) - PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp) - } - if(T2-N2>Eps){ - Tmp<- Pointoncurve(T2,P1) - PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp) - } - Res<- c(Res,list(Listplot(PtL)))#Res<- Mixadd(Res,Listplot(PtL)) - } - Allres<- c(Allres,Res)#Allres<- Mixjoin(Allres,Res) - } - return(Allres) -} - -##############################3 - -MakeveLfaceL<- function(VfL){ -# // Out format -# // VeL Edge, Face num(as numlist), VeL num -# // FL Face (Vertexs) - Eps<- 10^(-4) - Tmp<- VfL[[length(VfL)]] - Tmp1<- Tmp[[1]] - if(mode(Tmp1)=="numeric"){ - FvL<- list(VfL) - }else{ - FvL<- VfL - } - EL<- list(); FL<- list() - for (Nn in Looprange(1,length(FvL))){ - Tmp<- FvL[[Nn]] - VL<- Tmp[[1]] - if(length(VL)>0){ - FnL<- Tmp[[2]] - FaceL<- list() - for (I in Looprange(1,length(FnL))){ - Tmp1<- FnL[[I]] - PtL<- list() - for (J in Looprange(1,length(Tmp1))){ - Tmp2<- Tmp1[[J]] - PtL[[J]]<- VL[[Tmp2]] - } - FaceL[[I]]<- PtL - } - }else{ - FaceL<- list(Tmp[[2]]) - } - for (I in Looprange(1,length(FaceL))){ - Face<- FaceL[[I]] - Face<- c(Face,list(Face[[1]])) - FL<- c(FL,list(Face)) - for (J in Looprange(1,length(Face)-1)){ - Edge<- list(Face[[J]],Face[[J+1]]) - Flg<- 0 - for (K in Looprange(1,length(EL))){ - Tmp<- EL[[K]] - Tmp1<- Tmp[[1]] - Tmp2<- Norm(Edge[[1]]-Tmp1[[1]])+Norm(Edge[[2]]-Tmp1[[2]]) - Tmp3<- Norm(Edge[[1]]-Tmp1[[2]])+Norm(Edge[[2]]-Tmp1[[1]]) - if(Tmp2<Eps || Tmp3<Eps){#( - Tmp<- EL[[K]] - Tmp1<- Tmp[[1]] - Tmp2<- c(Tmp[[2]],length(FL)) - EL[[K]]<- list(Tmp1,Tmp2,K) - Flg<- 1 - break - } - } - if(Flg==0){ - Ntmp<- length(EL) - EL[[Ntmp+1]]<- list(Edge,c(length(FL)),Ntmp+1) - } - } - } - } - Out<- list(EL,FL) - return(Out) -} - -########################### -#// 09.10.29 -#// 09.11.15 - -Menkakusi2<- function(Face,Nf,Ptype){ -# global THETA PHI EyePoint FocusPoint VELNO VELHI - Eps0<- 10^(-6) - Eps<- 10^(-4) - Tmp1<- Face[[1]]-Face[[2]] - Tmp2<- Face[[3]]-Face[[2]] - if(Norm(Tmp1)<Eps || Norm(Tmp2)<Eps){ - return() - } - Vec<- 1/Norm(Tmp1)/Norm(Tmp2)*Crossprod(Tmp1,Tmp2) - if(Norm(Vec)<Eps){ - return() - } - if(Ptype== -1){ - W<- EyePoint - Tmp<- Dotprod(Vec,W-Face[[1]]) - }else{ - W<- c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)) - W<- 100*W - Tmp<- Dotprod(Vec,W-Face[[1]]) - } - if(abs(Tmp)<Eps){ - return() - } - if(Tmp<-Eps){ - Vec<- -Vec - } - if(Ptype==-1){ - G1<- Projpers(Spaceline(Face)) - }else{ - G1<- Projpara(Spaceline(Face)) - } - VL<- list() - for (I in Looprange(1,Numptcrv(G1))){ - VL[[I]]<- Ptcrv(I,G1) - } - Out1L<- list() - Out2L<- VELHI - for (N in Looprange(1,length(VELNO))){ - Out1<- list() - Out2<- list() - Tmp<- VELNO[[N]] - Edge<- Tmp[[1]] - Ne<- Tmp[[2]] - NNe<- Tmp[[3]] - if(Member(Nf,Ne)){ - Out1L<- c(Out1L, list(list(Edge,Ne,NNe))) - next - } - if(Ptype==-1){ - PtA<- Perspt(Edge[[1]]) - PtB<- Perspt(Edge[[2]]) - }else{ - PtA<- Parapt(Edge[[1]]) - PtB<- Parapt(Edge[[2]]) - } - if(Norm(PtA-PtB)<Eps){ - next - } - Bdy<- list(G1) - V<- PtB-PtA - TenL<- KoutenList(PtA,V,Bdy) - Nten<- length(TenL) - if(Nten==0){ # debug 10.08.17 - Out1L<- c(Out1L,list(list(Edge,Ne,NNe))) - next - } - Te<- 0 - Pe3<- Edge[[1]] - if(Ptype==-1){ - Tmp1<- Perspt(Pe3) - Tmp<- Invperspt(Tmp1,Spaceline(Face)) - }else{ - Tmp1<- Parapt(Pe3) - Tmp<- Invparapt(Tmp1,Spaceline(Face)) - } - Qe3<- Tmp[[1]] - Flg<- 0 - for (I in Looprange(1,Nten)){ - TenP<- TenL[[I]] - Ts<- TenP[[1]] - P<- TenP[[2]] - if(Ts< -Eps){ - next - } - Eline<- Spaceline(Edge) - if(Ptype==-1){ - Tmp<- Invperspt(P,Eline) - Tmp1<- Invperspt(P,Spaceline(Face)) - }else{ - Tmp<- Invparapt(P,Eline) - Tmp1<- Invparapt(P,Spaceline(Face)) - } - P3<- Tmp[[1]]; Q3<- Tmp1[[1]] - if(Ts>1-Eps){# // P3, Q3 are necessary - Flg<- I - break - } - if(abs(Te-Ts)>Eps0){ - if((I%%2)==1){ - Out1<- c(Out1,list(list(Pe3,P3))) - }else{ - if(length(Qe3)==0){ - Tmp<- Op(2,TenL[[I-1]]) - if(Ptype==-1){ - Tmp1<- Invperspt(Tmp,Spaceline(Face)) - }else{ - Tmp1<- Invparapt(Tmp,Spaceline(Face)) - } - Qe3<- Tmp1[[1]] - } - PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) - if(Ptype==-1){ - Z1<- Zperspt(PM); Z2<- Zperspt(QM) - }else{ - Z1<- Zparapt(PM); Z2<- Zparapt(QM) - } - if(Z1>Z2){ - Out1<- c(Out1, list(list(Pe3,P3))) - }else{ - Out2<- c(Out2, list(list(Pe3,P3))) - }## - } - } - Te<- Ts; Pe3<- P3; Qe3<- Q3 - } - if(Flg==0){ - if(Norm(Pe3-Edge[[2]])>Eps0){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - } - }else{ - if((Flg%%2)==1){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - }else{ - PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) - if(Ptype==-1){ - Z1<- Zperspt(PM); Z2<- Zperspt(QM) - }else{ - Z1<- Zparapt(PM); Z2<- Zparapt(QM) - } - if(Z1>Z2){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - }else{ - Out2<- c(Out2, list(list(Pe3,Edge[[2]]))) - } - } - } - for (I in Looprange(1,length(Out1))){ - Tmp<- Out1[[I]] - if(I==1){ - SeL<- Tmp - }else{ - if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){ - SeL[[2]]<- Tmp[[2]] - }else{ - Out1L<- c(Out1L, list(list(SeL,Ne,NNe))) - SeL<- Tmp - } - } - } - if(length(Out1)>0){ - Out1L<- c(Out1L, list(list(SeL,Ne,NNe))) - } - for (I in Looprange(1,length(Out2))){ - Tmp<- Out2[[I]] - if(I==1){ - SeL<- Tmp - }else{ - if(Norm(SeL[[2]]-Tmp[[1]])<Eps0){ - SeL[[2]]<- Tmp[[2]] - }else{ - Out2L<- c(Out2L, list(list(SeL,Ne,NNe))) - SeL<- Tmp - } - } - } - if(length(Out2)>0){ - Out2L<- c(Out2L, list(list(SeL,Ne,NNe))) - } - } - VELNO<<- Out1L - VELHI<<- Out2L -} - -################################### - -Parapt<- function(Plist){ # 18.02.19 changed (for point list) - if(!is.list(Plist)){Plist=list(Plist)} - Out=list() - for(jj in 1:length(Plist)){ - P=Op(jj,Plist) - x<- P[1] - y<- P[2] - z<- P[3] - Xz<- -x*sin(PHI)+y*cos(PHI) - Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA) - Out<- c(Out,list(c(Xz,Yz))) - } - if(length(Out)==1){Out=Op(1,Out)} - return(Out) -} - -################################### - -Partcrv3<- function(T1,T2,Fk){ - Eps0=10^(-4) -#// Tmp=Mixop(1,Fk) -#// new part from - if(T1>(T2+Eps0)){ - Npt<- Nrow(Fk) - Out1<- Partcrv3(T1,Npt,Fk) - Out2<- Partcrv3(1,T2,Fk) - Tmp<- Fk[1,]-Fk[Npt,] - if(Norm(Tmp)<Eps0){ - PL<- Joincrvs(Out1,Out2) - }else{ - PL<- list(Out1,Out2) - } - rownames(PL)<- 1:Nrow(PL) - return(PL) - } - if(floor(T1)==floor(T2)){ #18.02.26from - Tmp=floor(T1) - p1=Op(Tmp,Fk); p2=Op(Tmp+1,Fk) - PL=c(p1+(T1-Tmp)*(p2-p1)) - PL=Appendrow(PL, p1+(T2-Tmp)*(p2-p1)) #18.02.26until - }else{ - Is<- ceiling(T1) - Ie<- floor(T2) - PL<- c() - if(T1<Is-Eps0){ - P<- (Is-T1)*Fk[Is-1,]+(1-Is+T1)*Fk[Is,] - PL<- Appendrow(PL, P) #18.02.10(bug) - } - PL<- Appendrow(PL,Fk[Is:Ie,]) - if(T2>(Ie+Eps0)){ - P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,] - PL<- Appendrow(PL,P) - } - } - return(PL) -} - -################################### - -#100815 -Perspt<- function(P){ - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1];F1<- Tmp[2];G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Yz<- E3/(E3-X3)*Y3 - Zz<- E3/(E3-X3)*Z3 - Out<- c(Yz,Zz) - return(Out) -} - - -################################# - -Phcutdata<- function(VL,FaceL,PlaneD){ - Out<- list() - EL<- list() - Eps<- 10^(-4) - for (I in Looprange(1,Mixlength(FaceL))){ - Face<- Op(I,FaceL) - for (J in Looprange(1,length(Face))){ - Nj<- J+1 - if(J==length(Face)){ - Nj<- 1 - } - N1<- Face[J]; N2<- Face[Nj] - Tmp<- c(N1,N2) - Flg<- 0 - for (K in Looprange(1,Mixlength(EL))){ - Tmp1<- Op(K,EL) - Tmp2<- Tmp1[2:1] - if(all(Tmp==Tmp1) || all(Tmp==Tmp2)){ - Flg<- 1 - break - } - } - if(Flg==0){ - EL<- c(EL,list(Tmp)) - } - } - } - Out0<- list() - for (I in Looprange(1,Mixlength(EL))){ - Tmp<- Op(I,EL) - Tmp1<- Op(Tmp[1],VL) - Tmp2<- Op(Tmp[2],VL) - Out0<- c(Out0, list(Spaceline(Tmp1,Tmp2))) - } - if(Mixtype(PlaneD)!=1){ - V1<- Op(1,PlaneD) - Tmp<- Op(2,PlaneD) - if(length(Tmp)>1){ - d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] - }else{ - d<- Tmp - } - }else if(mode(PlaneD)=="numeric"){ - V1<- PlaneD[1:3] - d<- PlaneD[4] - }else{ - StrV<- strsplit(PlaneD,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Tmp1<- StrV[1] - Tmp2<- StrV[2] - PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") - } - x<- 0; y<- 0; z<- 0 - d<- -eval(parse(text=PlaneD)) - x<- 1; y<- 0; z<- 0; - Tmp1<- eval(parse(text=PlaneD))+d - x<- 0; y<- 1; z<- 0 - Tmp2<- eval(parse(text=PlaneD))+d - x<- 0; y<- 0; z<- 1 - Tmp3<- eval(parse(text=PlaneD))+d - V1<- c(Tmp1,Tmp2,Tmp3) - } - if(all(V1==c(0,0,0))){ - return(Out0) - } - V3<- c(1,0,0) - Out1<- Rotate3data(Out0,V1,V3) - Tmp2<- Rotate3pt(c(1,0,0),V3,V1) - Tmp<- V1[1]*Tmp2[1]+V1[2]*Tmp2[2]+V1[3]*Tmp2[3] - x0<- d/Tmp - PtL<- list() - for (I in Looprange(1,Mixlength(Out1))){ - Tmp<- Op(I,Out1) - Tmp1<- Tmp[1,]; Tmp2<- Tmp[2,] - P<- list(Tmp1,Tmp2-Tmp1) - Tmp<- list(Tmp1[1],Tmp2[1]-Tmp1[1]) - if(abs(Tmp[[2]]) < Eps){ - Tmp<- c() - }else{ - Tmp1<- Tmp[[2]] - Tmp2<- x0-Tmp[[1]] - Tmp<- c(Tmp2/Tmp1) - } - if(length(Tmp)>0){ - Tmp<- Tmp[1] - if(Tmp>-Eps && Tmp<(1+Eps)){ - Tmp3<- P[[1]]+Tmp*P[[2]] - Tmp3<- Rotate3pt(Tmp3,V3,V1) - if(Tmp<Eps){ - Tmp1<- Op(I,EL) - Tmp1<- Tmp1[1] - Tmp4<- list(c(Tmp1,Tmp1),Tmp3) - }else{ - if(Tmp>1-Eps){ - Tmp1<- Op(I,EL) - Tmp1<- Tmp1[2] - Tmp4<- list(c(Tmp1,Tmp1),Tmp3) - }else{ - Tmp4<- list(Op(I,EL),Tmp3) - } - } - Flg<- 0 - for (J in Looprange(1,Mixlength(PtL))){ - Tmp<- Op(J,PtL) - Tmp<- Op(2,Tmp) - if(Norm(Tmp3-Tmp)<Eps){ - Flg<- 1 - break - } - } - if(Flg==0){ - PtL<- c(PtL,list(Tmp4)) - } - } - } - } - if(Mixlength(PtL)==0){ - return(Out0) - } - PL<- list(Op(1,PtL)) - QL<- PtL[2:Mixlength(PtL)] - N<- Mixlength(QL) - for (I in Looprange(2,N+1)){ - Tmp1<- Op(Mixlength(PL),PL) - Tmp1<- Op(1,Tmp1) - for (J in Looprange(1,Mixlength(QL))){ - Tmp2<- Op(J,QL) - Tmp2<- Op(1,Tmp2) - Flg<- 0 - for (K in Looprange(1,Mixlength(FaceL))){ - Tmp3<- Op(K,FaceL); - if(Member(Tmp1[1],Tmp3) && - Member(Tmp1[2],Tmp3) && - Member(Tmp2[1],Tmp3) && - Member(Tmp2[2],Tmp3)){ - Flg<- 1 - break - } - } - if(Flg==1){ - break - } - } - J<- min(J, Mixlength(QL)) - PL<- c(PL,list(Op(J,QL))) - Tmp1<- QL[Looprange(1,J-1)] - Tmp2<- QL[Looprange(J+1,Mixlength(QL))] - QL<- c(Tmp1,Tmp2) - if(Mixlength(QL)==0){ - break - } - } - PHCUTPOINTL<<- PL - Tmp<- list() - for (J in Looprange(1,Mixlength(PL))){ - Tmp1<- Op(J,PL) - Tmp1<- Op(2,Tmp1) - Tmp<- c(Tmp,list(Tmp1)) - } - Tmp1<- Op(1,PL) - Tmp1<- Op(2,Tmp1) - Tmp<- c(Tmp,list(Tmp1)) - Out2<- Spaceline(Tmp) - Out<- c(Out0,list(Out2)) -} - -######################################### - -Phcutoffdata<- function(...){ - varargin<-list(...) - Eps<- 10^(-4) - Out2<- list() - VL<- varargin[[1]] - FaceL<- varargin[[2]] - PlaneD<- varargin[[3]] - Sgnstr<- varargin[[4]] - Fugou<- 1 - if(Sgnstr=="-" || Sgnstr=="n"){ - Fugou<- -1 - } - Out0<- Phcutdata(VL,FaceL,PlaneD) - PtL<- PHCUTPOINTL - PHVERTEXL<<- VL - PHFACEL<<- FaceL - if(length(PtL)==0){ - Out2<- Out0 - return(Out2) - } - N1<- Mixlength(VL) - Face<- c() - for (I in Looprange(1,Mixlength(PtL))){ - Tmp<- Op(I,PtL) - Tmp3<- Op(1,Tmp) - Tmp1<- Tmp3[[1]]; Tmp2<- Tmp3[[2]] # debugged 10.08.14 - if(Tmp1!=Tmp2){ - VL<- c(VL,list(Op(2,Tmp))) - N1<- N1+1 - Tmp1<- N1 - } - Face<- c(Face,Tmp1) - PtL[[I]]<- list(Op(1,Tmp),Tmp1) - } - OutfL<- list(Face) - if(Mixtype(PlaneD)!=1){ - V1<- Op(1,PlaneD) - Tmp<- Op(2,PlaneD) - if(length(Tmp)>1){ - d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] - }else{ - d<- Tmp - } - }else if(mode(PlaneD)=="numeric"){ - V1<- PlaneD[1:3] - d<- PlaneD[4] - }else{ - StrV<- strsplit(PlaneD,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Tmp1<- StrV[1] - Tmp2<- StrV[2] - PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") - } - x<- 0; y<- 0; z<- 0 - d<- -eval(parse(text=PlaneD)) - x<- 1; y<- 0; z<- 0 - Tmp1<- eval(parse(text=PlaneD))+d - x<- 0; y<- 1; z<- 0 - Tmp2<- eval(parse(text=PlaneD))+d - x<- 0; y<- 0; z<- 1 - Tmp3<- eval(parse(text=PlaneD))+d - V1<- c(Tmp1,Tmp2,Tmp3) - } - for (I in Looprange(1,Mixlength(FaceL))){ - Face<- Op(I,FaceL) - TmpL<- list() - for (J in Looprange(1,length(Face))){ - N1<- Face[J] - if(J==length(Face)){ - N2<- Face[1] - }else{ - N2<- Face[J+1] - } - for (K in Looprange(1,Mixlength(PtL))){ - Pd<- Op(K,PtL) - Tmp<- Op(1,Pd) - if(Tmp[1]==Tmp[2]){ - if(Tmp[1]==N1){ - TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) - } - }else{ - if(all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){ - TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) - } - } - } - } - if(Mixlength(TmpL)<2){ - Flg<- 0 - for (J in Looprange(1,length(Face))){ - Tmp<- Op(Face[J],VL) - Tmp1<- Fugou*(Dotprod(V1,Tmp)-d) - if(Tmp1< -Eps){ - Flg<- 1 - break - } - } - if(Flg==0){ - OutfL<- c(OutfL,list(Face)) - } - next - } - Pd<- Op(1,TmpL) - Qd<- Op(2,TmpL) - Outf1<- c(Op(3,Pd)) - Nf<- Op(1,Pd)+1 - Tmp<- Op(2,Pd) - JJ<- 0 - while (!all(Tmp==Op(2,Qd))){ - JJ<- JJ+1 - if(JJ>20){ - print("bug") - return() - } - Tmp1<- Tmp[2] - if(Outf1[length(Outf1)]!=Tmp1){ - Outf1<- c(Outf1,Tmp1) - } - Tmp<- c(Face[Nf]) - Nf<- Nf+1 - if(Nf>length(Face)){ - Nf<- 1 - } - Tmp<- c(Tmp,Face[Nf]) - } - Tmp1<- Op(3,Qd) - if(Outf1[length(Outf1)]!=Tmp1){ - Outf1<- c(Outf1,Tmp1) - } - Outf2<- c(Op(3,Pd)) - Nf<- Op(1,Pd) - Tmp<- Op(2,Pd) - JJ<- 0 - while (!all(Tmp==Op(2,Qd))){ - JJ<- JJ+1 - if(JJ>20){ - print("bug") - return() - } - Tmp1<- Tmp[1] - if(Outf2[length(Outf2)]!=Tmp1){ - Outf2<- c(Outf2,Tmp1) - } - Tmp<- c(Face[Nf]) - Nf<- Nf-1 - if(Nf<1){ - Nf<- length(Face) - } - Tmp<- c(Face[Nf],Tmp) - } - Tmp1<- Op(3,Qd) - if(Outf2[length(Outf2)]!=Tmp1){ - Outf2<- c(Outf2,Tmp1) - } - if(length(Outf1)<3 || length(Outf2)<3){ - Face<- Outf1 - if(length(Outf1)<length(Outf2)){ - Face<- Outf2 - } - Flg<- 0 - for (J in Looprange(1,length(Face))){ - Tmp<- Op(Face(J),VL) - Tmp1<- Fugou*(Dotprod(V1,Tmp)-d) - if(Tmp1<-Eps){ - Flg<- 1 - break - } - } - if(Flg==0){ - OutfL<- c(OutfL,list(Face)) - } - }else{ - Tmp<- Op(Outf1[2],VL) - Tmp1<- Outf1 - Tmp2<- Fugou*(Dotprod(V1,Tmp)-d) - if(Tmp2<0){ - Tmp1<- Outf2 - } - OutfL<- c(OutfL,list(Tmp1)) - } - } - PHVERTEXL<<- VL - PHFACEL<<- OutfL - Out2<- Phcutdata(VL,OutfL,c(0,0,0,0)) - return(Out2) -} - -####################### - -Phparadata<- function(VL,FaceL){ - Out<- Facesdata(list(VL,FaceL),"para") - return(Out) -} - -#################################### - -Phpersdata<- function(VL,FaceL){ - Out<- Facesdata(list(VL,FaceL),"pers") - return(Out) -} - -#################################### - -Phspersdata<- function(Fdata){ - Out<- Facesdata(Fdata,"pers") - return(Out) -} - -#################################### - -Phsparadata<- function(Fdata){ - Out<- Facesdata(Fdata,"para") - return(Out) -} - -######################### - -#100816 -Projpers<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Flg<- 0 - if(Nargs==1 && Mixtype(varargin[[1]])==1){ - Flg<- 1 - } - CL<- list() - for (N in Looprange(1,Nargs)){ - Crv<- varargin[[N]] - if(Mixtype(Crv)==1){ - Tmp<- CameraCurve(Crv) - CL<- c(CL,list(Tmp)) - }else{ - if(Mixtype(Crv)==3){ - ObjL<- list() - for (I in Looprange(1,Mixlength(Crv))){ - Tmp1<- Op(I,Crv) - if(Mixtype(Tmp1)==1){ - ObjL<- c(ObjL,list(Tmp1)) - }else{ - ObjL<- c(ObjL,Tmp1) - } - } - Crv<- ObjL - } - for (J in Looprange(1,Mixlength(Crv))){ - Tmp<- CameraCurve(Op(J,Crv)) - CL<- c(CL,list(Tmp)) - } - } - } - if(Mixlength(CL)==1 && Flg==1){ - CL<- Op(1,CL) - } - return(CL) -} - -################################### - -ProjcoordCurve<- function(Curve){ - SP<- sin(PHI); CP<- cos(PHI) - ST<- sin(THETA); CT<- cos(THETA) - Out<- c() - for (J in Looprange(1,Nrow(Curve))){ - P<- Ptcrv(J,Curve) - x<- P[1]; y<- P[2]; z<- P[3] - Xz<- -x*SP+y*CP - Yz<- -x*CP*CT-y*SP*CT+z*ST - Zz<- x*CP*ST+y*SP*ST+z*CT - Out<- c(Out,Xz,Yz,Zz) - } - Out<- matrix(Out,ncol=3,byrow=TRUE) - return(Out) -} - -################################# - -ProjCurve<- function(Curve){ # 2018.02.26 rewritten - AnsL= c() - SP=sin(PHI); CP=cos(PHI) - ST=sin(THETA); CT=cos(THETA) - for(I in Looprange(1,Length(Curve)) ){ - P=Op(I,Curve) - x=P[1]; y=P[2]; z=P[3] - if(x!=Inf){ - Xz=-x*SP+y*CP - Yz= -x*CP*CT-y*SP*CT+z*ST - AnsL=Appendrow(AnsL,c(Xz,Yz)) - Tmp= c(Xz,Yz) - }else{ - AnsL=Appendrow(AnsL,c(Inf,Inf)) - } - } - return(AnsL) -} - -#################################### - -Projpara<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Flg<- 0 - if((Nargs==1)&&(is.numeric(varargin[[1]]))){ - Flg<- 1 - } - CL<- list() - for (N in Looprange(1,Nargs)){ - Crv<- varargin[[N]] - if(is.numeric(Crv)){ - Tmp<- ProjCurve(Crv) - CL<- c(CL,list(Tmp)) - } - else{ - if(is.list(Crv)){ - ObjL<- list() - for (I in Looprange(1,Mixlength(Crv))){ - Tmp1<- Op(I,Crv) - if(is.numeric(Tmp1)){ - ObjL<- c(ObjL,list(Tmp1)) - } - else{ - ObjL<- c(ObjL,Tmp1) - } - } - Crv<- ObjL - } - for (J in Looprange(1,length(Crv))){ - Tmp<- ProjCurve(Op(J,Crv)) - CL<- c(CL,list(Tmp)) - } - } - } - if((length(CL)==1)&&(Flg==1)){ - CL<- Op(1,CL) - } - return(CL) -} - -######################### - -#100816 -Projpers<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Flg<- 0 - if(Nargs==1 && Mixtype(varargin[[1]])==1){ - Flg<- 1 - } - CL<- list() - for (N in Looprange(1,Nargs)){ - Crv<- varargin[[N]] - if(Mixtype(Crv)==1){ - Tmp<- CameraCurve(Crv) - CL<- c(CL,list(Tmp)) - }else{ - if(Mixtype(Crv)==3){ - ObjL<- list() - for (I in Looprange(1,Mixlength(Crv))){ - Tmp1<- Op(I,Crv) - if(Mixtype(Tmp1)==1){ - ObjL<- c(ObjL,list(Tmp1)) - }else{ - ObjL<- c(ObjL,Tmp1) - } - } - Crv<- ObjL - } - for (J in Looprange(1,Mixlength(Crv))){ - Tmp<- CameraCurve(Op(J,Crv)) - CL<- c(CL,list(Tmp)) - } - } - } - if(Mixlength(CL)==1 && Flg==1){ - CL<- Op(1,CL) - } - return(CL) -} - -######################################### -# 11.08.27 -# 14.03.23 Debugged "center" - -Rotate3data<- function(...){ -#Eps=10^(-4) - varargin<-list(...) - Nargs<- length(varargin) - Pd3<- varargin[[1]] - W1<- varargin[[2]] - W2<- varargin[[3]] - C<- c(0,0,0) - if(Nargs>=4){ - C<- varargin[[4]] - } - if(Mixtype(Pd3)==1){ - Pd3<- list(Pd3) - } else if(Mixtype(Pd3)==3){ - Tmp<- list() - for (I in Looprange(1,Mixlength(Pd3))){ - Tmp<- c(Tmp,Op(I,Pd3)) - } - Pd3<- Tmp - } - Out<- list() - for (I in Looprange(1,Mixlength(Pd3))){ - PD<- Op(I,Pd3) - Ans<- c() - for (J in Looprange(1,Nrow(PD))){ - if(is.matrix(PD)){ # 11.08.27 - P<- PD[J,] - } - else{ - P<- PD - } - Tmp<- Rotate3pt(P,W1,W2,C) # 14.03.23 - Ans<- rbind(Ans,Tmp) - } # 11.08.27 - rownames(Ans)<- 1:Nrow(Ans) #10.08.16 - Out<- c(Out,list(Ans)) - } - if(Mixlength(Out)==1){ - Out<- Op(1,Out) - } - return(Out) -} - -####################################### - -Rotate3pt<- function(...){ - varargin<-list(...) - Eps<-10^(-4) - Nargs<-length(varargin) - P<- varargin[[1]] - W1<- varargin[[2]] - W2<- varargin[[3]] - C<- c(0,0,0) - if(Nargs>=4){ - C<- varargin[[4]] - } - if(mode(W2)=="numeric" && length(W2)==1){ - Ct<- cos(W2) - St<- sin(W2) - V3<- 1/Norm(W1)*W1 - if(V3[1]==0){ - Tmp<- c(1,0,0) - }else{ - Tmp<- c(0,1,0) - } - W1<- c(Tmp[2]*V3[3]-Tmp[3]*V3[2], - Tmp[3]*V3[1]-Tmp[1]*V3[3], - Tmp[1]*V3[2]-Tmp[2]*V3[1]) - V1<- 1/Norm(W1)*W1 - V2<- c(V3[2]*V1[3]-V3[3]*V1[2], - V3[3]*V1[1]-V3[1]*V1[3], - V3[1]*V1[2]-V3[2]*V1[1]) - }else{ - Tmp<- c(W1[2]*W2[3]-W1[3]*W2[2], - W1[3]*W2[1]-W1[1]*W2[3], - W1[1]*W2[2]-W1[2]*W2[1]) - if(Norm(Tmp)<Eps){ - Ans<- P - return(Ans) - } - V1<- 1/Norm(W1)*W1 - Ns<- V1[1]*W2[1]+V1[2]*W2[2]+V1[3]*W2[3] - Tmp<- W2-Ns*V1 - V2<- 1/Norm(Tmp)*Tmp - Tmp<- c(V1[2]*V2[3]-V1[3]*V2[2], - V1[3]*V2[1]-V1[1]*V2[3], - V1[1]*V2[2]-V1[2]*V2[1]) - V3<- 1/Norm(Tmp)*Tmp - Ct<- Ns/Norm(W2) - St<- sqrt(1-Ct^2) - } - if(Norm(Tmp)<Eps){ - Ans<- P - return(Ans) - } - V1x<- V1[1]; V1y<- V1[2]; V1z<- V1[3] - V2x<- V2[1]; V2y<- V2[2]; V2z<- V2[3] - V3x<- V3[1]; V3y<- V3[2]; V3z<- V3[3] - if(Mixtype(P)!=1){ - PtL<- P - }else{ - PtL<- list(P) - } - Ans<- list() - for (N in Looprange(1,Mixlength(PtL))){ - P<- Op(N,PtL) - if(P[1]==Inf){ - Ans<- c(Ans,list(c(Inf,Inf,Inf))) - next - } - x<- P[1]-C[1]; y=P[2]-C[2]; z=P[3]-C[3] - Tmp1<- ((V1x*Ct+V2x*St)*V1x+(-V1x*St+V2x*Ct)*V2x+V3x^2)*x - Tmp2<- ((V1x*Ct+V2x*St)*V1y+(-V1x*St+V2x*Ct)*V2y+V3x*V3y)*y - Tmp3<- ((V1x*Ct+V2x*St)*V1z+(-V1x*St+V2x*Ct)*V2z+V3x*V3z)*z - X<- Tmp1+Tmp2+Tmp3 - Tmp1<- ((V1y*Ct+V2y*St)*V1x+(-V1y*St+V2y*Ct)*V2x+V3x*V3y)*x - Tmp2<- ((V1y*Ct+V2y*St)*V1y+(-V1y*St+V2y*Ct)*V2y+V3y^2)*y - Tmp3<- ((V1y*Ct+V2y*St)*V1z+(-V1y*St+V2y*Ct)*V2z+V3y*V3z)*z - Y<- Tmp1+Tmp2+Tmp3 - Tmp1<- ((V1z*Ct+V2z*St)*V1x+(-V1z*St+V2z*Ct)*V2x+V3x*V3z)*x - Tmp2<- ((V1z*Ct+V2z*St)*V1y+(-V1z*St+V2z*Ct)*V2y+V3y*V3z)*y - Tmp3<- ((V1z*Ct+V2z*St)*V1z+(-V1z*St+V2z*Ct)*V2z+V3z^2)*z - Z<- Tmp1+Tmp2+Tmp3 - Ans<- c(Ans,list(C+c(X,Y,Z))) - } - if(Mixlength(Ans)==1){ - Ans<- Op(1,Ans) - } - return(Ans) -} - -###################################### - -Setangle<- function(...){ - Eps<- 10^(-6) - varargin<-list(...) - Nargs<-length(varargin) - if(Nargs==0) { - } - else if(Nargs==1){ - V<- varargin[[1]] - V<- V/Norm(V) - THETA<<- acos(V[3]) - if(abs(sin(THETA))<Eps){ - PHI<<- 0 - } - else{ - PHI<<- acos(V[1]/sin(THETA)) - if(V[2]< -Eps) PHI<<- -PHI - } - } - else{ - PHI<<- varargin[[2]]*pi/180 - THETA<<- varargin[[1]]*pi/180 - } - Out<- paste("theta=",as.character(THETA*180/pi)," phi=", - as.character(PHI*180/pi),sep="") - return (Out) -} - -################################# - -Setpers<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - if(Nargs==0){ - } - else{ - FocusPoint<<- varargin[[1]] - EyePoint<<- varargin[[2]] - } - F<- as.character(FocusPoint) - E<- as.character(EyePoint) - Out<- paste("Focus = c(",F[1],",",F[2],",",F[3],") , ", - " Eye = c(", E[1],",",E[2],",",E[3],") ",sep="") - return (Out) -} - -################################# - -SetstereoL<- function(R,T,P,H){ - X<- R*sin(T*pi/180)*cos(P*pi/180) - Y<- R*sin(T*pi/180)*sin(P*pi/180) - Z<- R*cos(T*pi/180) - Eye<- c(X+H/2*Y/(X^2+Y^2),Y-H/2*X/(X^2+Y^2),Z) - Out<- Setpers(c(0,0,0),Eye) - return(Out) -} - -################################# - -SetstereoR<- function(R,T,P,H){ - X<- R*sin(T*pi/180)*cos(P*pi/180) - Y<- R*sin(T*pi/180)*sin(P*pi/180) - Z<- R*cos(T*pi/180) - Eye<- c(X-H/2*Y/(X^2+Y^2),Y+H/2*X/(X^2+Y^2),Z) - Out<- Setpers(c(0,0,0),Eye) - return(Out) -} - -############################### - -Sf3data<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - FdL<- Fullformfunc(varargin[[1]]) - F<- Op(1,FdL) - Xf<- Op(2,FdL) - Yf<- Op(3,FdL) - Zf<- Op(4,FdL) - Urg<- Op(5,FdL) - Vrg<- Op(6,FdL) - Str<- strsplit(Urg,"=",fixed=TRUE)[[1]] - U<- Str[1] - Tmp<- Str[2] - Tmp<- eval(parse(text=Tmp)) - Umin<- Tmp[1]; Umax<- Tmp[2] - Str<- strsplit(Vrg,"=",fixed=TRUE)[[1]] - V<- Str[1] - Tmp<- Str[2] - Tmp<- eval(parse(text=Tmp)) - Vmin<- Tmp[1]; Vmax<- Tmp[2] - Ndu<- 25 ; Ndv<- 25; Np<- c(50,50) - if(Nargs>=3){ - Ndu<- varargin[[2]] - Ndv<- varargin[[3]] - } - if(Nargs>=4){ - Np<- varargin[[4]] - if(mode(Np)=="numeric" && length(Np)==1){ - Np<- c(Np,Np) - } - } - Du<- (Umax-Umin)/Ndu - Dv<- (Vmax-Vmin)/Ndv - PL <- c()#PL <- [] - Assign("Vmin",Vmin,"Vmax",Vmax) - Trgstr<- Assign("t=c(Vmin,Vmax)") - PL <- list() - for (I in Looprange(0,Ndu)){ - U0 <- paste("(",as.character(Umin+I*Du),")",sep="") - Tmp<- gsub(U,U0,Xf,fixed=TRUE) - Tmp1<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- gsub(U,U0,Yf,fixed=TRUE) - Tmp2<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- gsub(U,U0,Zf,fixed=TRUE) - Tmp3<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")",sep="") - PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[2]))) - PL<- c(PL,list(PD)) - } - Assign("Umin",Umin,"Umax",Umax) - Trgstr<- Assign("t=c(Umin,Umax)") - for (J in Looprange(0,Ndv)){ - V0<- paste("(",as.character(Vmin+J*Dv),")",sep="") - Tmp<- gsub(V,V0,Xf,fixed=TRUE) - Tmp1<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- gsub(V,V0,Yf,fixed=TRUE) - Tmp2<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- gsub(V,V0,Zf,fixed=TRUE) - Tmp3<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")") - PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[1]))) - PL<- c(PL,list(PD)) - } - return(PL) -} - -################################### - -Skeletonparadata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if(Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if(Nargs>3){ - Eps2<- varargin[[4]] - } - Obj2L<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Tmp<- ProjcoordCurve(Op(I,ObjL)) - Obj2L<- c(Obj2L,list(Tmp)) - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- ProjcoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- Makeskeletondata(Obj2L,Plt2L,R,Eps2) - return(Out) -} - -################################ - -Skeletonpara3data<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if(Nargs>2){ - R=R*varargin[[3]] - } - Eps2<- 0.05 - if(Nargs>3){ - Eps2<- varargin[[4]] - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- ProjcoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Obj3<- Op(I,ObjL) - Tmp<- ProjcoordCurve(Obj3) - Data<- Makeskeletondata(list(Tmp),Plt2L,R,Eps2) - for (J in Looprange(1,Mixlength(Data))){ - Gd<- Op(J,Data) - PtD<- c() - for (J in Looprange(1,Nrow(Gd))){ - Tmp<- Ptcrv(J,Gd) - Tmp1<- Invparapt(Tmp,Obj3) - Tmp1<- Op(1,Tmp1) - PtD<- c(PtD,Tmp1) - } - PtD<- matrix(PtD,ncol=3,byrow=TRUE) - Out<- c(Out,list(PtD)) - } - } - return(Out) -} - -################################# - -#100815 -Skeletonpersdata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if(Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if(Nargs>3){ - Eps2<- varargin[[4]] - } - Obj2L<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Tmp<- CameracoordCurve(Op(I,ObjL)) - Obj2L<- c(Obj2L,list(Tmp)) - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- CameracoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- Makeskeletonpersdata(Obj2L,Plt2L,R,Eps2) - return(Out) -} - -##################### -#100815 -Skeletonpers3data<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if(Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if(Nargs>3){ - Eps2<- varargin[[4]] - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- CameracoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Obj3<- Op(I,ObjL) - Tmp<- CameracoordCurve(Obj3) - Data<- Makeskeletonpersdata(list(Tmp),Plt2L,R,Eps2) - for (J in Looprange(1,Mixlength(Data))){ - Gd<- Op(J,Data) - PtD<- c() - for (J in Looprange(1,Nrow(Gd))){ - Tmp<- Gd[J,] - Tmp1<- Invperspt(Tmp,Obj3) - Tmp1<- Op(1,Tmp1) - PtD<- rbind(PtD,Tmp1) - } - Out<- c(Out,list(PtD)) - } - } - return(Out) -} - -################################# - -Spacecurve<- function(...){ - Eps<- 10^(-5) - varargin<-list(...) - Nargs<- length(varargin) - Fnstr<- varargin[[1]] - Rgstr<- varargin[[2]] - Range<- c(0,2*pi) - N<- 50 #Numpoints - E<- c() #Exclusions - D<- Inf #Discont (Changed) - for(I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - StrV<- strsplit(Tmp,"=",fixed=TRUE) - StrV<- StrV[[1]] - Tmp1<- toupper(StrV[1]) - Lhs<- substr(Tmp1,1,1) - Str<- paste(Lhs,"=",StrV[2],sep="") - eval(parse(text=Str)) - } - StrV<- strsplit(Rgstr,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Vname<- StrV[1] - Rng<- eval(parse(text=StrV[2])) - } - else{ - Vname<- Rgstr - Rng<- c(XMIN,XMAX) - } - T1<- Rng[1]; T2<- Rng[2] - Dt<- (T2-T1)/N #17.09.22 - Str<- gsub(Vname,"t",Fnstr) - Str=gsub("[","c(",Str,fixed=TRUE) #17.12.22(2lines) - Str=gsub("]",")",Str,fixed=TRUE) - if(abs(Dt)<Eps){ # 16.12.13 - t=T1 - P=eval(parse(text=Str)) - return(P) - } - P<- c() -# E<- sort(E,decreasing=FALSE) - E<- c(E,Inf) - E<- sort(E,decreasing=FALSE) - Ke<- 1 - for(jj in 1:(N+1)){ - t=T1+(jj-1)*Dt - Pa<- c() - if(t-E[Ke]< Eps){ - Pa<- eval(parse(text=Str)) - } - if(abs(t-E[Ke])<=Eps){ - if(length(P)>0 && P[Nrow(P),1]!=Inf){ - Pa<- c(Inf,Inf,Inf) - } - } - if(t-E[Ke]>Eps){ - Pa<- eval(parse(text=Str)) - Ke<- Ke+1 - } - if(length(Pa)>0){ - if(Pa[1]==Inf){ - P<- rbind(P,Pa) - }else if(length(P)==0){ - P<- rbind(c(),c(Pa)) - } - else{ - Tmp<- P[Nrow(P),] - if(Tmp[1]==Inf){ - P<- rbind(P,Pa) - } - else if( Norm(Tmp-Pa)<D){ - P<- rbind(P,Pa) - } - else{ - P<- rbind(P,c(Inf,Inf,Inf)) - P<- rbind(P,Pa) - } - } - } - } - rownames(P)<- 1:Nrow(P) # 10.08.16 - return(P) -} - -######################################## - -Spaceline<- function(...){ - varargin<- list(...) - Z<- c() - for(I in 1:length(varargin)){ - Data<- varargin[[I]] - if(Mixtype(Data)==1){ - J<- 1 - while (J<=Ncol(Data)){ - Tmp<- Data[J:(J+2)] - Z<-c(Z,Tmp) - J<- J+3 - } - next - } - if(Mixtype(Data)==3){ - Tmp<- list() - for(I in 1:Mixlength(Data)){ - Tmp<- c(Tmp,Op(I,Data)) - } - Data<- Tmp - } - for(J in 1:Mixlength(Data)){ - Tmp<- Op(J,Data) - Z<- c(Z,Tmp) - } - } - Z<- matrix(Z,ncol=3,byrow=TRUE) - return(Z) -} - -################################# - -Translate3data<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Pd3<- varargin[[1]] - Mv<- varargin[[2]] - if(mode(Mv)=="numerice" && length(Mv)==1){ - Mv<- c(varargin[[2]],varargin[[3]],varargin[[4]]) - } - if(Mixtype(Pd3)==1){ - Pd3<- list(Pd3) - } - else if(Mixtype(Pd3)==3){ - Tmp<-list() - for(I in Looprange(1,Mixlength(Pd3))){ - Tmp<- c(Tmp, Op(I,Pd3)) - } - Pd3<- Tmp - } - Out<- list() - for(I in Looprange(1,Mixlength(Pd3))){ - PD<- Op(I,Pd3) - PD<- rbind(c(),PD) - Ans<- c() - for(J in Looprange(1,Nrow(PD))){ - P<- PD[J,] - Tmp<- P+Mv - Ans<- rbind(Ans,Tmp) - } - rownames(Ans)<- 1:Nrow(Ans) - Out<- c(Out,list(Ans)) - } - if(Mixlength(Out)==1){ - Out<- Op(1,Out) - } - return(Out) -} - -############################################### - -Xyzax3data<- function(Xrange,Yrange,Zrange){ - StrV<-strsplit(Xrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1) StrV<- StrV[2] - Tmp<- eval(parse(text=StrV)) - Px<- c(Tmp[1],0,0) - Qx<- c(Tmp[2],0,0) - StrV<-strsplit(Yrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1) StrV<- StrV[2] - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1) StrV<- StrV[2] - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - Out<- list(Spaceline(Px,Qx),Spaceline(Py,Qy),Spaceline(Pz,Qz)) - return(Out) -} - -################################### - -Xyzaxparaname<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10.0^(-6) - Dr<- 0.19*1000/2.54/MilliIn - Tmp<- varargin[[Nargs]] - if(Nargs>1 && is.numeric(Tmp)){ - Dr<- Dr*Tmp - Nargs<- Nargs-1 - } - if(mode(varargin[[1]])=="character"){ - Xname<- "x" - Yname<- "y" - Zname<- "z" - Xrange<- varargin[[1]] - Yrange<- varargin[[2]] - Zrange<- varargin[[3]] - StrV<-strsplit(Xrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Xname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Px<- c(Tmp[1],0,0) - Qx<- c(Tmp[2],0,0) - StrV<-strsplit(Yrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Yname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Zname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - }else{ - Data<- varargin[[1]] - Xname<- "x"; Yname<- "y"; Zname<- "z" - if(Nargs>1){ - if(varargin[[2]]!=""){ - Xname<- varargin[[2]] - } - if(varargin[[3]]!=""){ - Yname<- varargin[[3]] - } - if(varargin[[4]]!=""){ - Zname<- varargin[[4]] - } - } - Tmp<- Op(1,Data) - Px<- Tmp[1,]; Qx<- Tmp[2,] - Tmp<- Op(2,Data) - Py<- Tmp[1,] - Qy<- Tmp[2,] - Tmp<- Op(3,Data) - Pz<- Tmp[1,] - Qz<- Tmp[2,] - } - Ph<- Parapt(Px); Qh<- Parapt(Qx); R<-Norm(Ph-Qh) - Kekka<- list() - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Xname) - } - Ph<- Parapt(Py); Qh<- Parapt(Qy); R<- Norm(Ph-Qh) - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Yname) - } - Ph<- Parapt(Pz); Qh<- Parapt(Qz); R<- Norm(Ph-Qh) - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Zname) - } -# return(Kekka) -} - -################################### - -Xyzaxpersname<- function(...){ - varargin<- list(...) - Eps<- 10.0^(-6) - Nargs<- length(varargin) - Dr<- 0.19*1000/2.54/MilliIn - Tmp<- varargin[[Nargs]] - if(Nargs>1 && mode(Tmp)=="numeric"){ - Dr<- Dr*Tmp - Nargs<- Nargs-1 - } - if(mode(varargin[[1]])=="character"){ - Xname<- "x" - Yname<- "y" - Zname<- "z" - Xrange<- varargin[[1]] - Yrange<- varargin[[2]] - Zrange<- varargin[[3]] - StrV<-strsplit(Xrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Xname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Px<- c(Tmp[1],0,0) - Qx<- c(Tmp[2],0,0) - StrV<-strsplit(Yrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Yname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Zname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - }else{ - Data<- varargin[[1]] - Xname<- "x"; Yname<- "y"; Zname<- "z" - if(Nargs>1){ - if(varargin[[2]]!=""){ - Xname<- varargin[[2]] - } - if(varargin[[3]]!=""){ - Yname<- varargin[[3]] - } - if(varargin[[4]]!=""){ - Zname<- varargin[[4]] - } - } - Tmp<- Op(1,Data) - Px<- Tmp[1,]; Qx<- Tmp[2,] - Tmp<- Op(2,Data) - Py<- Tmp[1,] - Qy<- Tmp[2,] - Tmp<- Op(3,Data) - Pz<- Tmp[1,] - Qz<- Tmp[2,] - } - Ph<- Perspt(Px) - Qh<- Perspt(Qx) - R<- Norm(Ph-Qh) - Kekka<- list() - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Xname) - } - Ph<- Perspt(Py) - Qh<- Perspt(Qy) - R<- Norm(Ph-Qh) - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Yname) - } - Ph<- Perspt(Pz) - Qh<- Perspt(Qz) - R<- Norm(Ph-Qh) - if(R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Zname) - } -# return(Kekka) -} - -######################### -#100815 -Zparapt<- function(P){#function Out=Zparapt(P) - x<- P[1]; y<- P[2]; z<- P[3] - Out<- x*cos(PHI)*sin(THETA)+y*sin(PHI)*sin(THETA)+z*cos(THETA) - return(Out) -} - -######################### -#100815 -Zperspt<- function(P){ - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb - return(X3) -} - -########################################## - - - -########################################## - -# Stat Package - -########################################## - -# 2010.04.12 - -# new - -# Htickmarklower, Vtickmarkleft, HtickmarklowerV -# VtickmarkleftV, Insertcom, Replacecom -# Maketexfile, Formatting -# Drwhistframe, Histplotdata, Drwhistplot - -Htickmarklower<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if(mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if(K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if(is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if(J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if(is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if(is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if(mode(Dt)=="numeric" && length(Dt)>1){ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt) - next - } - if(mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt,GENTEN[2]) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y)) - Tmp2<- Unscaling(c(X,Y-2*MARKLEN)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if(Ndt==3){ - Tmp<-Unscaling(c(X,Y-2*MARKLEN)) - Expr(Tmp,"s",Moji) - } - if(Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("s",Houkou) - if(length(Tmp)>0){ - Tmp<-Unscaling(c(X,Y-2*MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -Vtickmarkleft<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if(mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if(length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if(K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if(is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if(J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if(is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if(is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if(I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if(mode(Dt)=="numeric" && length(Dt)>1){ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt) - next - } - if(mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if(length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(GENTEN[1],Dt) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y)) - Tmp2<- Unscaling(c(X-2*MARKLEN,Y)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if(Ndt==3){ - Tmp<-Unscaling(c(X-2*MARKLEN,Y)) - Expr(Tmp,"w",Moji) - } - if(Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("w",Houkou) - if(length(Tmp)>0){ - Tmp<-Unscaling(c(X-2*MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -HtickmarklowerV<- function(Vec,digits=2,nsmall=2) -{ - for (I in 1:length(Vec)){ - Tmp<- Vec[I] - Htickmarklower(Tmp, Formatting(Tmp,digits,nsmall)) - } -} - -HtickLV<- function(...) -{ - HtickmarklowerV(...) -} - -VtickmarkleftV<- function(Vec,digits=2,nsmall=2) -{ - for (I in 1:length(Vec)){ - Tmp<- Vec[I] - Vtickmarkleft(Tmp, Formatting(Tmp,digits,nsmall)) - } -} - -VtickLV<- function(...) -{ - VtickmarkleftV(...) -} - -Insertcom<- function(CmdM,Npos,Str) -{ - if(is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Out<- c(Out,Str) - Tmp<- Cmd[Looprange(Npos,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if(!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Replacecom<- function(CmdM,Npos,Str) -{ - if(is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Out<- c(Out,Str) - Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if(!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Deletecom<- function(CmdM,Npos) -{ - if(is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if(!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Maketexfile<- function(commands="",texfile="") -{ - Openfile(texfile) - Execmd(commands) - Closefile() -} - -Formatting<- function(X,D=2,N=2) -{ - if(D>0){ - Xs <- format(X,digits=D,nsmall=N) - } - else{ - Xs<- as.character(X) - } - return(Xs) -} - -################################ - -Boxplotdata1 <-function(DataF1,CenterX,Width,...) -{ - Xr <- Width - Temp <- boxplot(DataF1[1],plot=FALSE) - Stats <- Temp$stats - rownames(Stats) <- c("Lhige","Q1","Q2","Q3","Uhige") - Out <- Temp$out - Lhige <- Stats["Lhige",1] - Uhige <- Stats["Uhige",1] - Q1 <- Stats["Q1",1] - Q2 <- Stats["Q2",1] - Q3 <- Stats["Q3",1] - CenterY <- (Q1+Q3)/2 - C <- c(CenterX,CenterY) - V <- c(0,(Q3-Q1)/2) - G1 <- Framedata(C,Xr/2,V[2]) # box - Temp1 <- c(0,Q1-Lhige) - Temp2 <- c(0,Uhige-Q3) - G2 <- Listplot(C-V,C-V-Temp1) # - G3 <- Listplot(C+V,C+V+Temp2) # - Temp3 <- c(Xr/4,0) - G4 <- Listplot(C-V-Temp1-Temp3,C-V-Temp1+Temp3) # - G5 <- Listplot(C+V+Temp2-Temp3,C+V+Temp2+Temp3) # - Temp4 <- c(0,Q3-Q2) - Temp5 <- c(Xr/2,0) - G6 <- Listplot(C+V-Temp4-Temp5,C+V-Temp4+Temp5) # - G7 <- list() - for(j in Looprange(1,length(Out))){ - G7 <- c(G7,list(c(CenterX, Out[j]))) - } - G7 <- G7[order(Out,decreasing=TRUE)] - list(median=G6,box=G1,uwhisker=G2,lwhisker=G3,lwp=G4,uwp=G5,outliers=G7) -} - -Boxplotdata2 <- function(Data,Ratio, ...) -{ - DataF<- Flattenlist(Data) # 11.07.21(from) - ymin<- Inf - ymax<- -Inf - for(J in 1:length(DataF)){ - Tmp<- DataF[[J]] - ymin<- min(ymin, min(Tmp)) - ymax<- max(ymax,max(Tmp)) - } # 11.07.21(until) - dy <- ymax-ymin - Setwindow(c(0,XMAX-XMIN),c(ymin-0.1*dy,ymax+0.1*dy)) - R1<- (YMAX-YMIN)/(XMAX-XMIN) - R<- Ratio/R1 - Setscaling(R) - Delta <- XMAX/length(DataF) - W <- 0.6*Delta - PdL <- list() - for(i in 1:length(DataF)){ # 11.07.21 - X <- (0.5+i-1)*Delta - G <- Boxplotdata1(DataF[i],X,W,...) - PdL <- c(PdL,list(G)) - } - G <- Framedata() - Tmp<- list(frame=G) - PdL <-c(PdL,list(Tmp)) - Epsi <-0 - Setwindow(c(XMIN-Epsi,XMAX+Epsi),c(YMIN-Epsi,YMAX+Epsi)) - return(PdL) -} - -Drwboxframe<-function(BoxDataL) -{ - Setorigin(c(XMIN,YMIN)) - Tmp<- Unscaling(c(0.2,0.2)) - Setwindow(c(XMIN-0.2,XMAX),c(YMIN-Tmp[2],YMAX)) - Hako<- BoxDataL$plotdata - title<- BoxDataL$title - cap<- BoxDataL$cap - ylab<- BoxDataL$ylab - if(mode(title)!="list") title<- list(title) - if(mode(cap)!="list") cap<- list(cap) - if(mode(ylab)!="list") ylab<- list(ylab) - if(length(title)==0) title<- list("") - if(length(title)==1) title<- c(title, list("n")) - if(length(title)==2) title<- c(title, list("")) - if(length(cap)==0) cap<- list("") - if(length(cap)==1) cap<- c(cap, list("n"),0) # 11.11.27 - if(length(cap)==2) cap<- c(cap, 0) # 11.11.27 - if(length(ylab)==0) ylab<- list("") - if(length(ylab)==1) ylab <- c(ylab, list("n")) - if(length(ylab)==2) ylab<- c(ylab, list("")) - Temp <- Hako[[length(Hako)]] - Drwline(Temp$frame) - Fontsize(cap[[2]]) - for(i in Looprange(1,length(Hako)-1)){ - Temp <- Hako[[i]] - attach(Temp) - Dashline(uwhisker,lwhisker) - Drwline(median,2) - Drwline(box,lwp,uwp) - Drwpt(outliers,0) - X <- uwhisker[1,1] - detach(Temp) - Htickmarklower(X) - if(nchar(cap[[1]])<1) next # 2011.03.08 - if(length(cap)==2 || cap[[3]]==0){ - pos<- 1 - if(length(cap)>=4) pos<- cap[[4]] - Tmp<- paste("s",as.character(pos),sep="") - Letter(c(X,YMIN),Tmp, Op(i,cap[[1]])) - } - else{ - rotate<- cap[[3]] - if(length(cap)==3){ - pos<- 0 - } - else{ - pos<- cap[[4]] - } - Temp1 <- rotate*pi/180 - Temp <- c(cos(Temp1),sin(Temp1)) - Letterrot(c(X,YMIN-pos),Temp,Op(i,cap[[1]])) - } - } - if(nchar(ylab[[1]])>0){ - Fontsize(ylab[[2]]) - Tmp1<- ylab[[1]] - Tmp3<- ylab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c(XMIN, YMAX),"n2",Tmp1) - Fontsize("n") - } - if(nchar(title[[1]])>0){ - Fontsize(title[[2]]) - Tmp1<- title[[1]] - Tmp3<- title[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) - } - Fontsize("n") -} - -Drwboxplot<- function(dataf,var,size, - title=list(""), cap=list(colnames(dataf)), - ylab=list(""), ptsize=5,plot=TRUE,...) - #Return : title,cap,ylab,commands,plotdata,info -{ - Tmp <- boxplot(dataf, plot=FALSE, ...) - Stats <- Tmp$stats - DataF<- Flattenlist(dataf) # 11.07.21(from) - ymin<- Inf - ymax<- -Inf - for(J in 1:length(DataF)){ - Tmp<- DataF[[J]] - ymin<- min(ymin, min(Tmp)) - ymax<- max(ymax,max(Tmp)) - } # 11.07.21(until) - Hako<- Boxplotdata2(dataf, size[2]/size[1], ...) - if(plot){ - Windisp(Hako) - } - Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) - unit<- paste(Tmp,"cm",sep="") - Setunitlen(unit) - Exstr<- c( - "","", - paste("Beginpicture(","'",unit,"')",sep=""), - paste("Setpt(",as.character(ptsize),")",sep=""), - "","", - paste("Drwboxframe(",var,")",sep=""), - paste("VtickLV(c(",as.character(ymin),",", as.character(ymax),"),0,0)",sep=""), - "","","","", - "Setpt(1)", - "Endpicture(0)" - ) - Exstr<- matrix(Exstr) - Xpos<- c() - for(i in Looprange(1,length(Hako)-1)){ - Temp <- Hako[[i]] - Temp1 <- Temp[[5]] - Xpos <- c(Xpos,Temp1[1,1]) - } - Info<- list(stats=Stats,window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2),xpos=Xpos) - Tmp<- paste(var,"<<- ", - "list(title=title,cap=cap,ylab=ylab,", - "commands=Exstr,plotdata=Hako,info=Info)",sep="") - eval(parse(text=Tmp)) -} - - -########################################### - -Histplotdata <- function(DataV,Ratio,freq=TRUE,densplot=FALSE,...) -# 10.12.07 freq -{ - Temp <- hist(DataV,plot=FALSE,...) - Breaks <- Temp$breaks - Counts <- Temp$counts - Density <- Temp$density - Mids <- Temp$mids - if(!freq){ - Data<- Density - } - else{ - Data<- Counts - } - Ghist <- list() - for(i in Looprange(1,length(Breaks)-1)){ - Tmp1 <- c(Breaks[i],Breaks[i+1]) - Tmp2 <- c(0,Data[i]) - G1 <- Framedata(Tmp1,Tmp2) #bar - Ghist <- c(Ghist,list(G1)) - } - Bin <- Breaks[2]-Breaks[1] - Eps <- 0.7*Bin # 0.7 times Bin - Temp1 <- c(min(Breaks)-Eps,max(Breaks)+Eps) # Put Eps at both sides - Temp2 <- c(0,max(Data)*1.02) - Setwindow(Temp1,Temp2) - Setorigin(c(Temp1[1],0)) - R1<- (YMAX-YMIN)/(XMAX-XMIN) - R<- Ratio/R1 - Setscaling(R) - VEps <- 0.05*(XMAX-XMIN)/5 - Temp1<- Temp1-c(VEps,0) - Temp2<- Temp2-1/R*c(VEps,0) - Setwindow(Temp1,Temp2) - Fpt <- c(Mids[1]-Bin,0) - Lpt <- c(Mids[length(Mids)]+Bin,0) - Fp <- matrix(Fpt,nrow=1) - for(i in Looprange(1,length(Mids))){ - Tmp <- c(Mids[i],Data[i]) - Fp <- rbind(Fp,Tmp) - } - Fp <- rbind(Fp,Lpt) - rownames(Fp)<- c(1:nrow(Fp)) - if(densplot){ - Temp <- density(DataV) - X <- matrix(Temp$x) - Y <- matrix(Temp$y) - Gdens <- cbind(X,Y) - } - else{ - Gdens <- list() - } - list(plotdata=list(histplot=Ghist,fpplot=list(Fp),densityplot=list(Gdens)), - breaks=Breaks,counts=Counts,density=Density,mids=Mids) -} - -Drwhistframe<-function(HistDataL) -{ - title<- HistDataL$title - xlab<- HistDataL$xlab - ylab<- HistDataL$ylab - if(mode(title)!="list") title<- list(title) - if(mode(xlab)!="list") cap<- list(xlab) - if(mode(ylab)!="list") cap<- list(ylab) - if(length(title)==0) title<- list("") - if(length(title)==1) title<- c(title, list("n")) - if(length(title)==2) title<- c(title, list("")) - if(length(xlab)==0) xlab<- list("") - if(length(xlab)==1) xlab<- c(xlab, list("n")) - if(length(xlab)==2) xlab<- c(xlab, list("")) - if(length(xlab)==3) xlab<- c(xlab, list(8)) - if(length(ylab)==0) ylab<- list("") - if(length(ylab)==1) ylab<- c(ylab, list("n")) - if(length(ylab)==2) ylab<- c(ylab, list("")) - if(nchar(title[[1]])>0){ - Fontsize(title[[2]]) - Tmp1<- title[[1]] - Tmp3<- title[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) - Fontsize("n") - } - if(nchar(xlab[[1]])>0){ - Fontsize(xlab[[2]]) - Tmp1<- xlab[[1]] - Tmp3<- xlab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Tmp4<- paste("s",as.character(xlab[[4]]),sep="") - Letter(c((XMIN+XMAX)/2,YMIN),Tmp4,Tmp1) - Fontsize("n") - } - if(nchar(ylab[[1]])>0){ - Fontsize(ylab[[2]]) - Tmp1<- ylab[[1]] - Tmp3<- ylab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Tmp<- Setorigin() - Letter(c(Tmp[1], YMAX),"n2",Tmp1) - Fontsize("n") - } - - Setax(2," ") - Setax(4," ") - Setax(6," ") -} - -Drwhistplot<- function(datav,var,size,freq=TRUE, - title=list(""), xlab=list(""), ylab=list(""), - plot=TRUE,densplot=FALSE,fpplot=TRUE,...) - #Output : title,xlab,ylab,commands,plotdata,info -{ - H <- Histplotdata(datav, size[2]/size[1], freq=freq,densplot=densplot,...) - Pd<- H$plotdata - Ghist <- list(histplot=Pd$histplot,densityplot=Pd$densityplot) # 10.12.07 - if(fpplot){ - Ghist<- c(Ghist,list(fpplot=Pd$fpplot)) - } - if(plot){ - Windisp(Ghist) - } - Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) - unit<- paste(Tmp,"cm",sep="") - Setunitlen(unit) - Infostr<- paste(var,"$info",sep="") - Brkstr<- paste(Infostr,"$breaks",sep="") - Midstr<- paste(Infostr,"$mids",sep="") - if(!freq){ - Digits<- ",2,2" - Denstr<- paste(Infostr,"$density",sep="") - } - else{ - Digits<- ",0,0" - Denstr<- paste(Infostr,"$counts",sep="") - } - - if(fpplot) Prefp<- "" else Prefp<- "#" - Exstr<- c( - "","", - paste("Beginpicture(","'",unit,"')",sep=""), - "","", - paste("Drwhistframe(",var,")",sep=""), - paste("HtickLV(",Midstr,",1,1)",sep=""), - paste("VtickLV(max(",Denstr,")",Digits,")",sep=""), - paste("Drwline(",var,"[['plotdata']]","$histplot)",sep=""), - paste(Prefp,"Dashline(",var,"[['plotdata']]","$fpplot)",sep=""), - paste("#Drwline(",var,"[['plotdata']]","$densityplot,2)",sep=""), - "","","","", - "Endpicture(1)" - ) - Exstr<- matrix(Exstr) - Info<- list(breaks=H$breaks,counts=H$counts,density=H$density,mids=H$mids, - window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2)) - Tmp<- paste(var,"<<- ", - "list(title=title,xlab=xlab,ylab=ylab,", - "commands=Exstr,plotdata=Ghist,info=Info)",sep="") - eval(parse(text=Tmp)) -} - -########################## -#17.09.30 - -Bezierpt<- function(t,Ptlist,Ctrlist){ - if(length(Ptlist)==6){ - P0=Ptlist[1:3] - P3=Ptlist[4:6] - P1=Ctrlist[1:3] - if(length(Ctrlist)==3){ - P2=P3 - flg3=0 - }else{ - P2=Ctrlist[4:6] - flg3=1 - } - }else{ - P0=Ptlist[1:2] - P3=Ptlist[3:4] - P1=Ctrlist[1:2] - if(length(Ctrlist)==2){ - P2=P3 - flg3=0 - }else{ - P2=Ctrlist[3:4] - flg3=1 - } - } - P4=(1-t)*P0+t*P1 - P5=(1-t)*P1+t*P2 - P6=(1-t)*P2+t*P3 - P7=(1-t)*P4+t*P5 - P8=(1-t)*P5+t*P6 - P9=(1-t)*P7+t*P8 - if(flg3==0){ - Out=P7 - }else{ - Out=P9 - } - return(Out) -} - -Bezier<- function(...){ - varargin<- list(...) - Nargs=length(varargin) - Ptlist=varargin[[1]] - Ctrlist=varargin[[2]] - Num=10 - for(J in Looprange(3,Nargs)){ - Tmp=varargin[[J]] - K=strsplit(Tmp,'=',fixe=TRUE) - K=K[[1]] - Tmp1=substring(K[1],1,1) - Lhs=toupper(Tmp1) - if(Lhs=="N"){ - Num=eval(parse(text=K[2])) - } - } - if(length(Num)==1){ - Num=rep(Num,length(Ctrlist)) #17.10.08 - } - Out=c() - for(ii in Looprange(1,length(Ctrlist))){ - Tmp1=c(Ptlist[[ii]],Ptlist[[ii+1]]) - Tmp2=Ctrlist[[ii]] - if(ii==1){ - St=0 - }else{ - St=1 - } - for(J in Looprange(St,Num[ii])){ - Tmp=Bezierpt(J/Num[ii],Tmp1,Tmp2) - Out=Appendrow(Out,Tmp) - } - } - return(Out) -} - -####################### -# 17.10.02 - -Connectseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Pdata=varargin[[1]] - Eps=10^(-4) - if(Nargs>=2){ - Eps=varargin[[2]] - } - if(is.matrix(Pdata)){ - Din=Dataindex(Pdata) - tmp1=list() - for(J in 1:nrow(Din)){ - tmp=Pdata[Din[J,1]:Din[J,2],] - tmp1=c(tmp1,list(tmp)) - } - Pdata=tmp1 - } - PlotL=list(Op(1,Pdata)) - VI=Looprange(2,length(Pdata)) - while(length(VI)>0){ - Qd=Op(Length(PlotL),PlotL) - Ah=Op(1,Qd); Ao=Op(Length(Qd),Qd) - Flg=0 - for(J in 1:length(VI)){ - Tmp1=Op(VI[J],Pdata) - P=Op(1,Tmp1); Q=Op(Length(Tmp1),Tmp1) - if(Norm(P-Ao)<Eps){ - Tmp=Tmp1[Looprange(2,Length(Tmp1)),] - if(Length(Tmp)>0){ - Qd=Appendrow(Qd,Tmp) - } - PlotL[[length(PlotL)]]=Qd - VI=VI[-J] - Flg=1 - break - } - if(Norm(Q-Ao)<Eps){ - Tmp=Tmp1[(nrow(Tmp1)-1):1,] - Qd=Appendrow(Qd,Tmp) - PlotL[[length(PlotL)]]=Qd - VI=VI[-J] - Flg=1 - break - } - if(Norm(P-Ah)<Eps){ - Tmp=Tmp1[2:nrow(Tmp1),] - Qd=Appendrow(Tmp,Qd) - PlotL[[length(PlotL)]]=Qd - VI=VI[-J] - Flg=1 - break - } - if(Norm(Q-Ah)<Eps){ - Tmp=Tmp1[(nrow(Tmp1)-1):1,] - Qd=Appendrow(Tmp,Qd) - PlotL[[length(PlotL)]]=Qd - VI=VI[-J] - Flg=1 - break - } - } - if(Flg==0){ - PlotL=c(PlotL,Pdata[VI[1]]) - VI=VI[-1] - } - } - return(PlotL) -} - -Implicitplot<- function(...){ #180402 - varargin=list(...) - Eps=10^(-4) - Nargs=length(varargin) - Func=varargin[[1]] - Xrng=varargin[[2]] - Yrng=varargin[[3]] - Mdv=50;Ndv=50 - for (I in Looprange(4,length(varargin))){ - Str= varargin[[I]] - Tmp=strsplit(Str,"=",fixed=TRUE) - Tmp=Tmp[[1]] - Tmp1=toupper(Tmp[1]) - if(substring(Tmp1,1,1)=="N"){ - Mdv=eval(parse(text=Tmp[2])) - if(length(Mdv)==1){ - Ndv=Mdv - }else{ - Ndv=Mdv[2] - Mdv=Mdv[1] - } - } - } - Tmp=strsplit(Func,"=",fixed=TRUE) - Tmp=Tmp[[1]] - if(length(Tmp)==1){ - Fn=Func - }else{ - Fn=paste(Tmp[1],"-(",Tmp[2],")",sep="") - } - Tmp=strsplit(Xrng,"=",fixed=TRUE) - Tmp=Tmp[[1]] - Varx=Tmp[1] - Rngx=eval(parse(text=Tmp[2])) - Tmp=strsplit(Yrng,"=",fixed=TRUE) - Tmp=Tmp[[1]] - Vary=Tmp[1] - Rngy=eval(parse(text=Tmp[2])) - Tmp=paste("Impfun<- function(",Varx,",",Vary,"){",Fn,"}",sep="") - eval(parse(text=Tmp)) - dx=(Rngx[2]-Rngx[1])/Mdv - dy=(Rngy[2]-Rngy[1])/Ndv - out=list() - for(jj in 1:Ndv){ - yval1=Rngy[1]+(jj-1)*dy - yval2=Rngy[1]+jj*dy - xval1=Rngx[1] - eval11=Impfun(xval1,yval1) - eval12=Impfun(xval1,yval2) - for(ii in 1:Mdv){ - xval2=Rngx[1]+ii*dx - eval21=Impfun(xval2,yval1) - eval22=Impfun(xval2,yval2) - pL=list(c(xval1,yval1));vL=c(eval11) - pL=c(pL,list(c(xval2,yval1)));vL=c(vL,eval21) - pL=c(pL,list(c(xval2,yval2)));vL=c(vL,eval22) - pL=c(pL,list(c(xval1,yval2)));vL=c(vL,eval12) - pL=c(pL,list(c(xval1,yval1)));vL=c(vL,eval11) - qL=c() - for(kk in 1:4){ - if(abs(vL[kk])<=Eps){ - qL=Appendrow(qL,pL[[kk]]) - }else{ - if(vL[kk]>Eps){ - if(vL[kk+1]< -Eps){ - tmp=1/(vL[kk]-vL[kk+1])* - (-vL[kk+1]*pL[[kk]]+vL[kk]*pL[[kk+1]]) - qL=Appendrow(qL,tmp) - } - }else{ - if(vL[kk+1]>Eps){ - tmp=1/(-vL[kk]+vL[kk+1])* - (vL[kk+1]*pL[[kk]]-vL[kk]*pL[[kk+1]]) - qL=Appendrow(qL,tmp) - } - } - } - } - xval1=xval2 - eval11=eval21 - eval12=eval22 - if(Length(qL)==2){ - out=c(out,list(qL)) - } - } - } - if(length(out)>0){ - out=Connectseg(out) - } - if(length(out)==1){ - out=out[[1]] - } - return(out) -} - -######################### -# 17.10.06 - -Deqdata=function(deq,rng,initt,initf,Num){ - Eps=10^(-3) - inf=10^3 - tmp=strsplit(deq,"=")[[1]] - tmp1=gsub("`","",tmp[1],fixed=TRUE) - tmp1=substring(tmp1,3,nchar(tmp1)-1) - Xname=strsplit(tmp1,",")[[1]] - func=tmp[2] - for(J in 1:(length(Xname))){ - tmp1=paste("X[",as.character(J),"]",sep="") - func=gsub(Xname[J],tmp1,func,fixed=TRUE) - } - tmp=strsplit(rng,"=")[[1]] - tname=tmp[1] - tmp=eval(parse(text=tmp[2])) - t1=tmp[1] - t2=tmp[2] - tmp=paste("function(",tname,",X){",func,"}",sep="") - funP=eval(parse(text=tmp)) - tmp=paste("function(",tname,",X){-",func,"}",sep="") - funN=eval(parse(text=tmp)) - dt=(t2-t1)/Num - tt=initt - X0=initf - pdL=c(tt,X0) - for(J in Looprange(1,floor((t2-initt)/dt))){ - kl1=dt*funP(tt,X0) - kl2=dt*funP(tt+dt/2,X0+kl1/2) - kl3=dt*funP(tt+dt/2,X0+kl2/2) - kl4=dt*funP(tt+dt,X0+kl3) - X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 - tt=initt+J*dt - tmp=c(tt,X0) - if(Norm(tmp)>inf){break} - pdL=Appendrow(pdL,tmp) - } - tt=initt - X0=initf - for(J in Looprange(1,floor((initt-t1)/dt))){ - kl1=dt*funN(tt,X0) - kl2=dt*funN(tt+dt/2,X0+kl1/2) - kl3=dt*funN(tt+dt/2,X0+kl2/2) - kl4=dt*funN(tt+dt,X0+kl3) - X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 - tt=initt-J*dt - tmp=c(tt,X0) - if(Norm(tmp)>inf){break} - pdL=Appendrow(tmp,pdL) - } - pdL -} - -Deqplot=function(...){ - varargin=list(...) - deq=varargin[[1]] - rng=varargin[[2]] - initt=varargin[[3]] - initf=varargin[[4]] - Num=50 - Sel=c(1,2) - for(J in Looprange(5,length(varargin))){ - tmp1=varargin[[J]] - if(is.character(tmp1)){ - tmp=strsplit(tmp1,"=")[[1]] - Num=eval(parse(text=tmp[2])) - }else{ - SeL=tmp1 - } - } - pdL=Deqdata(deq,rng,initt,initf,Num) - pdL=pdL[,SeL] -} - - -############## obj ############### - -Openobj<- function(Fnm){ - OBJFMT<<- "%7.4f" - NPOINT<<- 0 - NNORM<<- 0 - OBJSCALE<<- 1 - OBJFIGNO<<- 0 - OBJJOIN<<- 0 - Wfile<<- Fnm - Tmp=grep(".obj",Fnm,fixed=TRUE) - if(length(Tmp)==0){ - if(nchar(Fnm)>0){ - Wfile<<- paste(Fnm,".obj",sep="") - } - } - cat("",file=Wfile,sep="") - Wfile -} - -Closeobj<- function(){ - Wfile="" -} - -Writeobjpoint<- function(P){ - X=sprintf(OBJFMT,P[1]*OBJSCALE) - Y=sprintf(OBJFMT,P[2]*OBJSCALE) - Z=sprintf(OBJFMT,P[3]*OBJSCALE) - Str=paste("v",X,Y,Z,sep=" ") - Printobjstr(Str) - NPOINT<<- NPOINT+1 - return(NPOINT) -} - -Printobjstr<- function(Str){ - cat(Str,"\n",sep="",file=Wfile,append=TRUE) -} - -Objname<- function(){ - if(OBJJOIN==0){ - OBJFIGNO<<- OBJFIGNO+1 - Gname=paste("ketfig",as.character(OBJFIGNO),sep="") - Printobjstr(paste("# ",Gname,sep="")) - Printobjstr(paste("g ",Gname,sep="")) - } -} - -Objjoin<- function(...){ - varargin=list() - if(length(varargin)>0){ - OBJJOIN<<- abs(sign(varargin[[1]])) - } - OBJJOIN -} - -Objsurf<- function(...){ #17.12.18 - Args<- list(...) - Nargs<- length(Args) - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Rf=Args[[1]] - N=2 - Mg=0; Ng=0 - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - U=Args[[N]] - Mg=length(U)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - }else{ - Ag=Args[N]; Bg=Args[N+1] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=grep("=",Tmp0,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1=strsplit(Tmp0,"=") - Tmp0=Tmp1[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - } - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - V=Args[[N]] - Ng=length(V)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - }else{ - Cg=Args[[N]]; Dg=Args[[N+1]] - N=N+2 - } - }else{ # the case of is.character(Args[[N]]) - Tmp0=Args[[N]] - Tmp=grep("=",Tmp0,fixed=TRUE) - if(length(Tmp)>0){ - Tmp2=strsplit(Tmp0,"=") - Tmp0=Tmp2[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - } - if(Mg==0){ - Mg=Args[[N]] - N=N+1 - U=c() - for(J in Looprange(1,Mg+1)){ - U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) - } - } - if(Ng==0){ - Ng=Args[[N]] - V=c() - for(K in Looprange(1,Ng+1)){ - V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) - } - } - Objname() - PL=list() - for(J in Looprange(1,Mg+1)){ - for(K in Looprange(1,Ng+1)){ - P=Rf(U[J],V[K]) - Np=Writeobjpoint(P) - PL=c(PL,list(c(P,Np))) - } - } - Idx=1+(Ng+1)*(0:Mg) - Pus=PL[Idx] - Idx=(Ng+1)*(1:(Mg+1)) - Pue=PL[Idx] - Idx=1:(Ng+1) - Pvs=PL[Idx] - Idx=((Ng+1)*Mg+1):((Ng+1)*(Mg+1)) - Pve=PL[Idx] - Printobjstr("vt 0 0") - Printobjstr("vt 1 0") - Printobjstr("vt 1 1") - Printobjstr("vt 0 1") - for(J in Looprange(1,Mg)){ - for(K in Looprange(1,Ng)){ - P1=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K]])) - P2=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K]])) - P3=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K+1]])) - P4=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K+1]])) - N1=""; N2=""; N3=""; N4="" - if(Sel=="+"){ - Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") - }else{ - Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") - } - Printobjstr(Str) - } - } - list(U,V,Pus,Pue,Pvs,Pve) -} - -Objthicksurf<- function(...){ - Args=list(...) - Nargs=length(Args) - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Selsurf=substring(Sel,1,1) - Selside=c("0","0","0","0") - Tmp=grep("w",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[1]="w" - } - Tmp=grep("e",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[2]="e" - } - Tmp=grep("s",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[3]="s" - } - Tmp=grep("n",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[4]="n" - } - Nfth=Args[[Nargs-2]] - Thick1=Args[[Nargs-1]] - Thick2=Args[[Nargs]] - Nargs=Nargs-3 - Rfth=Args[[1]] - N=2 - Mg=0; Ng=0 - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - U=Args[[N]] - Mg=length(U)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - }else{ - Ag=Args[[N]]; Bg=Args[[N+1]] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=strsplit(Tmp0,"=",fixe=TRUE) - if(length(Tmp)>0){ - Tmp0=Tmp[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - } - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - V=Args[[N]] - Ng=length(V)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - }else{ - Cg=Args[[N]]; Dg=Args[[N+1]] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=strsplit(Tmp0,"=",fixed=TRUE) - if(length(Tmp)>0){ - Tmp0=Tmp[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - } - if(Mg==0){ - Mg=Args[[N]] - N=N+1 - U=c() - for(J in Looprange(1,Mg+1)){ - U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) - } - } - if(Ng==0){ - Ng=Args[[N]] - V=c() - for(K in Looprange(1,Ng+1)){ - V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) - } - } - Objname() - Join=OBJJOIN - OBJJOIN<<- 1 - F1=function(u,v){ - Rfth(u,v)+Thick1*Nfth(u,v) - } - F2=function(u,v){ - Rfth(u,v)+Thick2*Nfth(u,v) - } - Dt1=Objsurf(F1,U,V,Selsurf) - if(Selsurf=="+"){ - Tmp="-" - }else{ - Tmp="+" - } - Dt2=Objsurf(F2,U,V,Tmp); - Out=list(Dt1,Dt2); - - if(Selside[1]!="0"){ - Dt=Objrecs(Op(3,Dt1),Op(3,Dt2),Selside[1]) - Out=c(Out,list(Dt)) - } - if(Selside[2]!="0"){ - Dt=Objrecs(Op(4,Dt1),Op(4,Dt2),Selside[2]) - Out=c(Out,list(Dt)) - } - if(Selside[3]!="0"){ - Dt=Objrecs(Op(5,Dt1),Op(5,Dt2),Selside[3]) - Out=c(Out,list(Dt)) - } - if(Selside[4]!="0"){ - Dt=Objrecs(Op(6,Dt1),Op(6,Dt2),Selside[4]) - Out=c(Out,list(Dt)) - } - OBJJOIN<<- Join -} - -Objrecs<- function(...){ - Eps=10^(-6) - Args=list(...) - Nargs=length(Args) - Tmp=Args[[1]] - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23until - PL1=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL1=c(PL1,list(Tmp[K,])) - } - } - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Objname() - for(J in Looprange(1,length(PL1))){ - P=PL1[[J]] - if((length(P)<4) || (P[4]==0)){ - Np=Writeobjpoint(P) - PL1[[J]]=c(P[1:3],Np) - } - } - Tmp=Args[[2]] - if((is.numeric(Tmp)) && (length(Tmp)==1)){ - Drv=Tmp - Len=Norm(Drv) - PL2=list() - for(J in Looprange(1,length(PL1))){ - Tmp=PL1[[J]] - P=Tmp[1:3]+Drv - Np=Writeobjpoint(P) - PL2=c(PL2,list(c(P[1:3],Np))) - if(J<length(PL1)){ - Vec=PL1[[J+1]]-PL1[[J]] - if(Norm(Vec)>Eps){ - Tmp1=Crossprod(Drv,Vec) - Tmp2=Crossprod(Tmp1,Vec) - Tmp3=Dotprod(Tmp2,Drv) - if(Tmp3<-Eps){ - Tmp2=-Tmp2 - } - Drv=Len/Norm(Tmp2)*Tmp2 - } - } - } - }else{ - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23until - PL2=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL2=c(PL2,list(Tmp[K,])) - } - } - for(J in Looprange(1,length(PL2))){ - P=PL2[[J]] - if((length(P)<4) || (P[4]==0)){ - Np=Writeobjpoint(P) - PL2[[J]]=c(P[1:3],Np) - } - } - } - Printobjstr("vt 0 0") - Printobjstr("vt 1 0") - Printobjstr("vt 1 1") - Printobjstr("vt 0 1") - for(J in Looprange(2,length(PL1))){ - P1=sprintf("%1d",Op(4,PL1[[J-1]])) - P2=sprintf("%1d",Op(4,PL2[[J-1]])) - P3=sprintf("%1d",Op(4,PL2[[J]])) - P4=sprintf("%1d",Op(4,PL1[[J]])) - N1=""; N2=""; N3=""; N4="" - if(Sel=="+"){ - Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") - }else{ - Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") - } - Printobjstr(Str) - } - list(PL1,PL2) -} - -Objpolygon<- function(...){ - Eps=10^(-6) - Args=list(...) - Nargs=length(Args) - Tmp=Args[[1]] - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23until - PL=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL=c(PL,list(Tmp[K,])) - } - } - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Objname() - for(J in Looprange(1,length(PL))){ - P=PL[[J]] - if((length(P)<4) || (P(4)==0)){ - Np=Writeobjpoint(P) - PL[[J]]=c(P[1:3],Np) - } - } - if(Nargs==1){ - Tmp=PL[[1]] - Cen=Tmp[1:3] - Nc=Tmp[4] - }else{ - Tmp=Args[[2]] - if(length(Tmp)==1){ - Tmp1=PL[[Tmp]] - Cen=Tmp1[1:3] - Nc=Tmp[4] - }else{ - Cen=Tmp - Nc=Writeobjpoint(Cen) - } - } - for(J in Looprange(1,length(PL))){ - if(J<length(PL)){ - Je=J+1 - }else{ - Je=1 - } - Pt1=Cen - PLj=PL[[J]]; PLje=PL[[Je]] - Pt2=PLj[1:3]; Pt3=PLje[1:3] - if(Norm(Crossprod(Pt2-Pt1,Pt3-Pt1))<Eps){ - next - } - P1=sprintf("%1d",Nc) - P2=sprintf("%1d",PLj[4]) - P3=sprintf("%1d",PLje[4]) - if(Sel=="+"){ - Str=paste("f",P1,P2,P3,"",sep=" ") - }else{ - Str=paste("f",P1,P3,P2,"",sep=" ") - } - Printobjstr(Str) - } - PL -} - -Objpolyhedron<- function(Vertex,Face){ - OBJFIGNO<<- OBJFIGNO+1 - Ninit=NPOINT - Objname() - for(N in Looprange(1,length(Vertex))){ - P=Vertex[[N]] - Np=Writeobjpoint(P) - Vertex[[N]]=c(P[1:3],Np) - } - for(N in Looprange(1,length(Face))){ - F=Face[[N]]+Ninit - Face[[N]]=F - Str="f" - for(J in Looprange(1,length(F))){ - P=sprintf("%1d",F[J]) - Str=paste(Str,P,sep=" ") - } - Printobjstr(Str) - } - list(Vertex,Face) -} - -Objcurve<- function(...){ - Eps=10^(-6) - Args=list(...) - Nargs=length(Args) - Tmp=Args[[1]] - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23until - PL=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL=c(PL,list(Tmp[K,])) - } - } - Closed=Norm(PL[[length(PL)]]-PL[[1]])<Eps - Pstr="xy" - Tmp=Args[[Nargs]] - if(is.character(Tmp)){ - Pstr=Tmp - Nargs=Nargs-1 - } - Sz=0.1 - Np=4 - if(Nargs>=2){ - Sz=Args[[2]] - } - if(Nargs>=3){ - Np=Args[[3]] - } - Assign("Sz",Sz) - if(Pstr=="xy"){ - Vz=c(0,0,1) - Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)") - } - if(Pstr=="yz"){ - Vz=c(1,0,0) - Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))") - } - if(Pstr=="zx"){ - Vz=c(0,1,0) - Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))") - } - Gc0=Spacecurve(Fs,"t=c(0,2*pi)",paste("Num=",as.character(Np),sep="")) - P=PL[[1]]; Q=PL[[2]]; R=PL[[length(PL)-1]] - PQ1=Q-P - if(!Closed){ - PQ2=PQ1 - }else{ - PQ2=P-R - } - Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2) - Vp1=Vp/Norm(Vp) - Theta=acos(min(Dotprod(Vz,Vp1),1)); - Vj=Crossprod(Vz,Vp1) - if(Norm(Vj)<Eps){ - Vj=Vz - } - Gc1=Rotate3data(Gc0,Vj,Theta) - CL=list(Translate3data(Gc1,P)) - for(J in Looprange(2,length(PL)-1)){ - P=PL[[J]]; Q=PL[[J+1]] - PQ2=Q-P - if(Norm(PQ2)<Eps){ - next - } - Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2) - Vp2=Vp/Norm(Vp) - Theta=acos(min(Dotprod(Vp1,Vp2),1)) - Vj=Crossprod(Vp1,Vp2) - if(Norm(Vj)<Eps){ - Vj=Vp1 - } - Gc2=Rotate3data(Gc1,Vj,Theta) - CL=c(CL,list(Translate3data(Gc2,P))) - PQ1=PQ2 - Vp1=Vp2 - Gc1=Gc2 - } - if(!Closed){ - Vp2=(Q-P)/Norm(Q-P) - Theta=acos(min(Dotprod(Vp1,Vp2),1)) - Vj=Crossprod(Vp1,Vp2) - if(Norm(Vj)<Eps){ - Vj=Vp1 - } - Gc3=Rotate3data(Gc1,Vj,Theta) - CL=c(CL,list(Translate3data(Gc3,Q))) - } - Objname() - Join=Objjoin(); - Objjoin(1) - GL1=CL[[1]] - for(J in Looprange(2,length(CL))){ - GL2=CL[[J]] - Dt=Objrecs(GL1,GL2,"-") - GL1=Dt[[2]] - if(J==2){ - GL0=Dt[[1]] - } - } - if(!Closed){ - Objpolygon(CL[[1]],"-") - N=length(CL) - Objpolygon(CL[[N]],"+") - }else{ - Objrecs(GL1,GL0,"-") - } - Out=CL - OBJJOIN<<- Join -} - -Objsymb<- function(Symb,Thick,Face,Dir){ - for(J in Looprange(1,length(Symb))){ - Objcurve(Op(J,Symb),Thick,Face,Dir) - } -} - -Symb3data<- function(Moji,Size,Kaiten,NV,Pos){ - if(is.character(Moji)){ - #Tmp=Symbdata(Moji) - # GY1=Tmp(2) - }else{ - GY1=Moji - } - GY1=Scaledata(GY1,Size,Size) - GY1=Rotatedata(GY1,Kaiten*pi/180) - A=NV[1]; B=NV[2]; C=NV[3] - if(A^2+B^2==0){ - E1=c(1,0,0) - E2=c(0,1,0) - }else{ - E1=c(B,-A,0) - E2=c(-A*C,-B*C,A^2+B^2) - Tmp=matrix(c(E1,E2,NV),3,3) - D=det(Tmp) - if(D<0){ - E1=-E1 - } - E1=E1/Norm(E1) - E2=E2/Norm(E2) - } - Em<- function(X,Y){ - c(E1[1]*X+E2[1]*Y,E1[2]*X+E2[2]*Y,E1[3]*X+E2[3]*Y) - } - GY1=Embed(GY1,Em) - GY1=Translate3data(GY1,Pos) - Flattenlist(GY1) -} - -############## New Intersect 18.02.01 ############# - -Intersectline<- function(p1,v1,p2,v2){ - Eps0=10^(-5) - tmp=Dotprod(v1,v2) - tmp1=c(tmp,Norm(v1)^2) - tmp2=c(-Norm(v2)^2,-tmp) - tmp3=c(Dotprod(p2-p1,v2),Dotprod(p2-p1,v1)) - d=Crossprod(tmp1,tmp2) - tmp=abs(Crossprod(v1,v2)) - if(tmp>Eps0){ - dt=Crossprod(tmp3,tmp2) - ds=Crossprod(tmp1,tmp3) - t=dt/d - s=ds/d - pt=p1+v1*t - out=list(pt,t,s) - }else{ - tmp1=Crossprod(p2-p1,v1)/Norm(v1) - out=list(abs(tmp1)) - } - return(out) -} - -Intersectseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps0=10^(-4) - Eps1=0.01 - seg1=varargin[[1]] - seg2=varargin[[2]] - if(Nargs>2){Eps1=varargin[[3]]} - p1=Op(1,seg1); q1=Op(2,seg1) - p2=Op(1,seg2); q2=Op(2,seg2) - if((Norm(q1-p1)<Eps0)||(Norm(q2-p2)<Eps0)){ - out=list(-1) - }else{ - tmp=Intersectline(p1,q1-p1,p2,q2-p2) - if(length(Op(1,tmp))>1){ - pt=Op(1,tmp); t=Op(2,tmp); s=Op(3,tmp) - if((t*(t-1)<Eps0)&&(s*(s-1)<Eps0)){ - out=list(0,pt,t,s) - }else{ - t=min(max(t,0),1) - s=min(max(s,0),1) - tmp3=c(Norm(p1-p2),Norm(p1-q2),Norm(q1-p2),Norm(q1-q2)) #180317 - tmp1=c(Op(2,q2-p2),-Op(1,q2-p2)) - tmp=Intersectline(p1,tmp1,p2,q2-p2) - if(length(Op(1,tmp))>1){ - if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){ - tmp3=c(tmp3,Norm(Op(1,tmp)-p1)) - } - } - tmp=Intersectline(q1,tmp1,p2,q2-p2) - if(length(Op(1,tmp))>1){ - if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){ - tmp3=c(tmp3,Norm(Op(1,tmp)-q1)) - } - } - tmp1=c(Op(2,q1-p1),-Op(1,q1-p1)) - tmp=Intersectline(p2,tmp1,p1,q1-p1); - if(length(Op(1,tmp))>1){ - if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){ - tmp3=c(tmp3,Norm(Op(1,tmp)-p2)) - } - } - tmp=Intersectline(q2,tmp1,p1,q1-p1); #180322 - if(length(Op(1,tmp))>1){ - if(Op(3,tmp)*(Op(3,tmp)-1)<Eps0){ - tmp3=c(tmp3,Norm(Op(1,tmp)-q2)) - } - } - out=list(min(tmp3),pt,t,s) - } - }else{ - dist=tmp[[1]] - tmp1=q1-p1 - n=c(tmp1[2],-tmp1[1])/Norm(tmp1) - pts=list() - tmp=Intersectline(p1,n,p2,q2-p2) - if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){ - tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2 - pts=c(pts,list(list(tmp1,0,tmp[[3]]))) - } - tmp=Intersectline(q1,n,p2,q2-p2) - if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){ - tmp1=(1-tmp[[3]])*p2+tmp[[3]]*q2 - pts=c(pts,list(list(tmp1,1,tmp[[3]]))) - } - tmp=Intersectline(p2,n,p1,q1-p1) - if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){ - tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1 - pts=c(pts,list(list(tmp1,tmp[[3]],0))) - } - if((length(tmp)>1)&&(tmp[[3]]*(tmp[[3]]-1)<Eps0)){ - tmp1=(1-tmp[[3]])*p1+tmp[[3]]*q1 - pts=c(pts,list(list(tmp1,tmp[[3]],2))) - } - if(length(pts)==0){ - tmp1=min(Norm(p2-p1),Norm(q2-p1),Norm(p2-q1),Norm(q2-q1)) - out=list(tmp1) - }else{ - if(dist>Eps1){ - out=list(dist) - }else{ - tmp=c(); - for(j in 1:length(pts)){ - tmp=Appendrow(tmp,Op(1,pts[[j]])) - } - tmp1=sum(tmp[,1])/(length(pts)) - tmp2=sum(tmp[,2])/(length(pts)) - tmp3=c(tmp1,tmp2) - tmp=Nearestpt(tmp3,seg1) - tmp1=tmp[[2]] - tmp=Nearestpt(tmp3,seg2) - tmp2=tmp[[2]] - out=list(dist,tmp3,tmp1,tmp2) - } - } - } - } - return(out) -} - -Osplineseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps=10^(-2) - Eps0=10^(-6) - Ptlist=varargin[[1]] - Numstr="Num=20" - if(Nargs>1){ - Numstr=varargin[[2]] - } - p0=Op(1,Ptlist); p1=Op(2,Ptlist); p2=Op(3,Ptlist); p3=Op(4,Ptlist) - tmp=Norm(p2-p0)*Norm(p3-p1) - tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/tmp)/2) - cc=4*Norm(p2-p1)/3/(Norm(p2-p0)+Norm(p3-p1))/tmp - pQ=p1+cc*(p2-p0) - pR=p2+cc*(p1-p3) - ctrL=list(c(pQ,pR)) - out=Bezier(list(p1,p2),ctrL,Numstr) - return(out) -} - -Intersectpartseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - crv1=varargin[[1]] - crv2=varargin[[2]] - ii=varargin[[3]] - jj=varargin[[4]] - Eps1=varargin[[5]] - Eps2=varargin[[6]] - Dist=10*Eps2 - if(Nargs>6){Dist=varargin[[7]]} - Eps00=10^(-8) - Eps0=10^(-4) - out=list() - seg1=Listplot(Op(ii,crv1),Op(ii+1,crv1)) - seg2=Listplot(Op(jj,crv2),Op(jj+1,crv2)) - tmp1=Op(2,seg1)-Op(1,seg1) - tmp2=Op(2,seg2)-Op(1,seg2) - snang=abs(Crossprod(tmp1,tmp2))/(Norm(tmp1)*Norm(tmp2)) - tmp=Intersectseg(seg1,seg2,Eps1) - dst=Op(1,tmp) - if(dst<Eps0){ - out=list(Op(2,tmp),ii+Op(3,tmp),jj+Op(4,tmp),dst,snang) - }else{ - if(dst<Eps2){ - if((Length(crv1)==2)||(Norm(Op(2,seg1)-Op(1,seg1))>Dist-Eps0)){ - os1=seg1 - }else{ - p1=Op(1,seg1); p2=Op(2,seg1) - if(ii==1){ - p3=Op(3,crv1) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p0=Reflectdata(p3,c((p1+p2)/2,tmp)) - }else{ - if(ii==Length(crv1)-1){ - p0=Op(ii-1,crv1) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p3=Reflectdata(p0,c((p1+p2)/2,tmp)) - }else{ - p0=Op(ii-1,crv1); p3=Op(ii+2,crv1) - } - } - os1=Osplineseg(list(p0,p1,p2,p3)) - } - if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps0)){ - os2=seg2 - }else{ - p1=Op(1,seg2); p2=Op(2,seg2) - if(jj==1){ - p3=Op(3,crv2) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p0=Reflectdata(p3,c((p1+p2)/2,tmp)) - }else{ - if(jj==Length(crv2)-1){ - p0=Op(jj-1,crv2) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p3=Reflectdata(p0,c((p1+p2)/2,tmp)) - }else{ - p0=Op(jj-1,crv2); p3=Op(jj+2,crv2) - } - } - os2=Osplineseg(list(p0,p1,p2,p3)) - } - tmp2=list() - for(kk in Looprange(1,Length(os1)-1)){ - for(ll in Looprange(1,Length(os2)-1)){ - seg1=Listplot(Op(kk,os1),Op(kk+1,os1)) - seg2=Listplot(Op(ll,os2),Op(ll+1,os2)) - tmp=Intersectseg(seg1,seg2,Eps1) - if((Op(1,tmp)<Eps1)&&(length(tmp)>1)){ #18.02.05 - if(Op(1,tmp)<dst+Eps00){ - dst=Op(1,tmp) - tmp3=list() - for( nn in Looprange(1,length(tmp2))){ - if(Op(1,tmp2[[nn]])<dst){ - tmp3=c(tmp3,list(tmp2[[nn]])) - } - } - tmp2=c(tmp3,list(list(dst,Op(2,tmp)))) - } - } - } - } - if(length(tmp2)>0){ - tmp1=c() - for(nn in Looprange(1,length(tmp2))){ - tmp1=Appendrow(tmp1,Op(2,tmp2[[nn]])) - } - tmp=sum(tmp1[,1])/length(tmp2) - tmp=c(tmp,sum(tmp1[,2])/length(tmp2)) - out=list(tmp) - p1=Op(ii,crv1); p2=Op(ii+1,crv1) - tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) - tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) - tmp=min(max(Op(3,tmp),0),1) - out=c(out,list(ii+tmp)) - p1=Op(jj,crv2); p2=Op(jj+1,crv2) - tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) - tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) - tmp=min(max(Op(3,tmp),0),1) - out=c(out,list(jj+tmp,dst,snang)) - } - } - } - return(out) -} - -if(1==0){ #start of skip - -Collectnear<- function(ptdL,Eps2){ - gL=list(Op(1,ptdL)) - rL=ptdL[Looprange(2,length(ptdL))] #18.02.07 - for( ii in Looprange(1,length(ptdL)-1)){ - numL=c() - for(jj in Looprange(1,length(rL))){ - tmp1=100 - for(kk in Looprange(1,length(gL))){ - tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]])) - if(tmp<tmp1){tmp1=tmp} - } - if(tmp1<Eps2){numL=c(numL,jj)} - } - if(length(numL)==0){ - break - }else{ - gL=c(gL,rL[numL]) #18.02.05 - tmp=setdiff(1:(length(rL)),numL) - rL=rL[tmp] - } - } - return(list(gL,rL)) -} - -}# end of skip - -Collectsameseg<- function(ptdL){ - Eps00=10^(-8) - if(length(ptdL)==0){ - gL=list();rL=list() - }else{ - tmp1md=ptdL[1] - rL=ptdL[Looprange(2,length(ptdL))] - tmp1=tmp1md[[1]] - kk=floor(Op(2,tmp1)) - if(Op(2,tmp1)<kk+Eps00){ - s1=kk-1-Eps00; e1=s1+2+2*Eps00 - }else{ - s1=kk-Eps00; e1=s1+1+2*Eps00 - } - kk=floor(Op(3,tmp1)) - if(Op(3,tmp1)<kk+Eps00){ - s2=kk-1-Eps00; e2=s2+2+2*Eps00 - }else{ - s2=kk-Eps00; e2=s2+1+2*Eps00 - } - diffL=c() - for(ii in Looprange(1,length(rL))){ - tmp=rL[[ii]] - tmp1=Op(2,tmp);tmp2=Op(3,tmp) - if((tmp1>s1)&&(tmp1<e1)&&(tmp2>s2)&&(tmp2<e2)){ - tmp1md=c(tmp1md,list(tmp)) - }else{ - diffL=c(diffL,ii) - } - } - tmp=c() - for(ii in Looprange(1,length(tmp1md))){ - tmp=c(tmp,Op(4,tmp1md[[ii]])) - } - dst=min(tmp) - gL=list() - for(ii in Looprange(1,length(tmp1md))){ - tmp=tmp1md[[ii]] - if(Op(4,tmp)<dst+Eps00){ - gL=c(gL,list(tmp)) - } - } - tmp1=rL - rL=rL[diffL] - } - return(list(gL,rL)) -} - -Groupnearpt<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps1=varargin[[Nargs]] - plist=varargin[[1]] - qlist=varargin[[2]] - if(!is.list(qlist)){ - qlist=plist - plist=list() - } - if(length(qlist)==0){ - return(plist) - } - pt=qlist[[1]] - qlist=qlist[Looprange(2,length(qlist))] - if(length(plist)==0){ - plist=list(matrix(pt,nrow=1)) - }else{ - flg=0 - for(ii in Looprange(1,length(plist))){ - gL=plist[[ii]] - for(jj in Looprange(1,Length(gL))){ - if(Norm(Op(jj,gL)-pt)<Eps1){ - flg=1 - break - } - } - if(flg==1){ - plist[[ii]]=Appendrow(gL,pt) - break - } - } - if(flg==0){ - plist=c(plist,list(matrix(pt,nrow=1))) - } - } - out=Groupnearpt(plist,qlist,Eps1) - return(out) -} - -IntersectcurvesPp<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps0=10^(-4) - Eps1=0.01 -# Eps2=0.05 - Eps2=0.1 - Dist=10*Eps2 - if(Nargs>2){Eps1=varargin[[3]]} - if(Nargs>3){Eps2=varargin[[4]]} - if(Nargs>4){Dist=varargin[[5]]} - tmp1=varargin[[1]] - crv1=matrix(Op(1,tmp1),nrow=1) - for(ii in Looprange(2,Length(tmp1))){ - tmp=Op(Length(crv1),crv1) - if(Norm(tmp-Op(ii,tmp1))>Eps0){ - crv1=Appendrow(crv1,Op(ii,tmp1)) - } - } - tmp2=varargin[[2]] - crv2=matrix(Op(1,tmp2),nrow=1) - for(ii in Looprange(2,Length(tmp2))){ - tmp=Op(Length(crv2),crv2) - if(Norm(tmp-Op(ii,tmp2))>Eps0){ - crv2=Appendrow(crv2,Op(ii,tmp2)) - } - } - if(Length(crv1)!=Length(crv2)){ - self=0 - }else{ - self=1 - for(ii in Looprange(1,Length(crv1))){ - if(Norm(Op(ii,crv1)-Op(ii,crv2))>0){ - self=0 - break - } - } - } - out=list() - for(ii in Looprange(1,Length(crv1)-1)){ - if(self==0){ - loopL=Looprange(1,Length(crv2)-1) - }else{ - loopL=Looprange(ii+2,Length(crv2)-1) - } - for(jj in loopL){ - tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist) - if(length(tmp)>1){ #18.02.05 - if(length(out)==0){ - out=list(tmp) - }else{ - tmp1=Op(length(out),out) - if(Norm(Op(1,tmp1)-Op(1,tmp))>Eps1){ - out=c(out,list(tmp)) - } - } - if(self==1){ - tmp=list(Op(1,tmp),Op(3,tmp),Op(2,tmp),Op(4,tmp),Op(5,tmp)) - out=c(out,list(tmp)) - } - } - } - } - tmp2=out - out=list() - tmp1=tmp2 - for(ii in Looprange(1,length(tmp2))){ - tmp=Collectsameseg(tmp1) - out=c(out,list(Op(1,tmp))) - if(length(Op(2,tmp))==0){ - break - }else{ - tmp1=Op(2,tmp) - } - } - for(ii in Looprange(1,length(out))){ - tmp1=Op(ii,out) - if(length(tmp1)==1){ - out[[ii]]=Op(1,tmp1) - }else{ - tmp=c() - for(jj in Looprange(1,length(tmp1))){ - tmp=c(tmp,Op(4,tmp1[[jj]])) - } - dst=min(tmp) - tmp=c() - for(jj in Looprange(1,length(tmp1))){ - if(Op(4,tmp1[[jj]])<dst+Eps0){ - tmp=c(tmp,Op(1,tmp1[[jj]])) - } - } - tmp=matrix(tmp,ncol=2,byrow=TRUE) - tmp=c(sum(tmp[,1]),sum(tmp[,2]))/Length(tmp) - tmp2=list(tmp) - tmp=Nearestpt(Op(1,tmp2),crv1) - tmp2=c(tmp2,list(Op(2,tmp))) - tmp=Nearestpt(Op(1,tmp2),crv2) - tmp2=c(tmp2,list(Op(2,tmp))) - tmp2=c(tmp2,list(list(dst,Op(5,tmp1[[1]])))) - out[[ii]]=tmp2 - } - } - return(out) -} - -Intersectcurves<- function(...){ - dtL=IntersectcurvesPp(...) - out=list() - for(jj in Looprange(1,length(dtL))){ - out=c(out,list(Op(1,dtL[[jj]]))) - } - return(out) -} - -############## end of New Intersect ############# - -############## New Enclosing2 ############# - -Enclosing2<- function(...){ - varargin=list(...) - Nargs=length(varargin) - plist=varargin[[1]] - Eps0=10^(-5) - Eps1=0.01 - Eps2=0.1 - Start=c() - flg=0 - for(ii in Looprange(2,Nargs)){ - tmp=varargin[[ii]] - if(length(tmp)>1){ -# Start=tmp - }else{ - if(flg==0){Eps1=tmp} - if(flg==1){Eps2=tmp} - flg=flg+1 - } - } - flg=0 - AnsL=c() - if(length(plist)==1){ - Fdata=plist[[1]] - tmp1=Op(1,Fdata) - tmp2=Op(Length(Fdata),Fdata) - if(Norm(tmp1-tmp2)<Eps0){ - AnsL=Fdata - }else{ - AnsL=Appendrow(Fdata,tmp1) - } - flg=1 - } - if(flg==0){ - Fdata=Op(1,plist) - Gdata=Op(length(plist),plist) - KL=IntersectcurvesPp(Fdata,Gdata) - if(length(KL)==0){ - tmp1=Op(Length(Gdata),Gdata) - tmp2=Op(1,Fdata) - tmp=Listplot(tmp1,tmp2) - plist=c(plist,list(tmp)) - Start=tmp2 - tst=1 -# flg=1 - }else{ - if(length(KL)==1){ - tmp=Op(1,KL) - tst=Op(2,tmp) - Start=crv(tst,Fdata) - } - if(length(KL)>1){ - KL=Quicksort(KL,2) - if(length(Start)==0){ - tmp=Op(1,KL) - tst=Op(2,tmp) - Start=Pointoncurve(tst,Fdata) - }else{ - tmp=c() - for(ii in Looprange(1,length(KL))){ - tmp=c(tmp,Norm(Op(1,KL[[ii]]-Start))) - } - tmp=min(tmp) - tmp1=list() - for(ii in Looprange(1,length(KL))){ - tmp2=Op(1,KL[[ii]]) - if(Norm(tmp2-Start)==tmp){ - tmp1=c(tmp1,list(tmp2)) - } - } - tmp=Op(1,tmp1) - tst=Op(2,tmp) - Start=Pointoncurve(tst,Fdata) - } - } - } - } - if(flg==0){ - t1=tst - for(nn in Looprange(1,length(plist))){ - Fdata=Op(nn,plist) - if(nn==length(plist)){ - nxtno=1 - }else{ - nxtno=nn+1 - } - Gdata=Op(nxtno,plist) - KL=IntersectcurvesPp(Fdata,Gdata) - if(length(KL)==0){ - tmp=matrix(Op(Length(Fdata),Fdata),nrow=1) #18.02.02from - Gdata=Appendrow(tmp,Gdata) - plist[[nxtno]]=Gdata - t2=Length(Fdata) - ss=1 #18.02.02until - }else{ - tmp=Op(1,KL) - t2=Op(2,tmp) - ss=Op(3,tmp) - if(abs(t2-t1)<Eps0){ - if(length(KL)>1){ - tmp=Op(2,KL) - t2=Op(2,tmp) - ss=Op(3,tmp) - }else{ -# println(text(nn)+" and "+text(nn+1)+" not intersect"); -# flg=1 - } - } - } - if(flg==0){ - tmp=Partcrv(t1,t2,Fdata) - if(nn==1){ - AnsL=tmp - }else{ - tmp=tmp[2:Length(tmp),] - AnsL=Appendrow(AnsL,tmp) - } - t1=ss - } - } - } - return(AnsL) -} - -############## end of Enclosing2 ############# - -############## start of surface drawing ############# - -Fullformfunc<- function(FdL){ - ADDPOINT<<- list() #18.02.19 - Out=list(Op(1,FdL)) - N=length(FdL) - for(Jrg in Looprange(1,N)){ - Tmp=grep("c(",Op(Jrg,FdL),fixed=TRUE) - if(length(Tmp)>0){ - break - } - } - Urg=Stripblanks(Op(Jrg,FdL)) - Tmp=strsplit(Urg,"=",fixed=TRUE) - UNAME<<- Tmp[[1]][1] - URNG<<- eval(parse(text=Tmp[[1]][2])) - Urg=paste(UNAME,"=c(",sprintf("%6.7f",URNG[1]),",", - sprintf("%6.7f",URNG[2]),")",sep="") - Vrg=Stripblanks(Op(Jrg+1,FdL)) - Tmp=strsplit(Vrg,"=",fixed=TRUE) - VNAME<<- Tmp[[1]][1] - VRNG<<- eval(parse(text=Tmp[[1]][2])) - Vrg=paste(VNAME,"=c(",sprintf("%6.7f",VRNG[1]),",", - sprintf("%6.7f",VRNG[2]),")",sep="") - if(Jrg==2){ - Xf=UNAME - Yf=VNAME - Tmp=Stripblanks(Op(1,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Zf=Tmp[[1]][2] - Tmp=list(UNAME,VNAME,Zf,Urg,Vrg) - Out=c(Out,Tmp) - }else if(Jrg==4){ - Tmp=Stripblanks(Op(1,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Zf=Tmp[[1]][2] - Tmp=Stripblanks(Op(2,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Xname=Tmp[[1]][1] - Xf=Tmp[[1]][2] - Tmp=Stripblanks(Op(3,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Yname=Tmp[[1]][1] - Yf=Tmp[[1]][2] - Tmp=gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) - Zf=gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) - Tmp=list(Xf,Yf,Zf,Urg,Vrg) - Out=c(Out,Tmp) - }else{ - Tmp=Stripblanks(Op(2,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Xf=Tmp[[1]][2] - Tmp=Stripblanks(Op(3,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Yf=Tmp[[1]][2] - Tmp=Stripblanks(Op(4,FdL)) - Tmp=strsplit(Tmp,"=",fixed=TRUE) - Zf=Tmp[[1]][2] - Tmp=list(Xf,Yf,Zf,Urg,Vrg) - Out=c(Out,Tmp) - } - tmp=paste("Xfunc<<- function(",UNAME,",",VNAME,"){",Xf,"}",sep='') - eval(parse(text=tmp)) - tmp=paste("Yfunc<<- function(",UNAME,",",VNAME,"){",Yf,"}",sep='') - eval(parse(text=tmp)) - tmp=paste("Zfunc<<- function(",UNAME,",",VNAME,"){",Zf,"}",sep='') - eval(parse(text=tmp)) - tmp=paste("XYZfunc<<- function(",UNAME,",",VNAME,"){",sep='') - tmp=paste(tmp,"c(",Xf,",",Yf,",",Zf,")}",sep='') - eval(parse(text=tmp)) - XYZstr<<- c(Xf,Yf,Zf) - DRWS<<- "enws" - BdyL=list() - for(I in Looprange(Jrg+2,length(FdL))){ - Tmp=Op(I,FdL) - if(is.character(Tmp)){ - if(nchar(Tmp)==0){ - Tmp=" " - } - DRWS<<- list(Tmp) - } - if((is.numeric(Tmp))&&(Length(Tmp)>1)){ - BdyL=list(Tmp) - } - } - BDYL<<- BdyL - Tmp=c(DRWS,BDYL) - Out=c(Out,Tmp) - return(Out) -} - -Addpoints<- function(ptlist){ - ADDPOINT<<- ptlist -} - -Makexybdy<- function(Np){ - Eps0=10^(-4) - Xystr=XYZstr[1:2] - Umin=URNG[1]; Umax=URNG[2] - Vmin=VRNG[1]; Vmax=VRNG[2] - Cflg=0 - EhL=list() - Tmp=grep("e",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:2){ - Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),Xystr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",VRNG) - Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[2])) - Tmp=Paramplot(Tmp1,Tmp2,Tmp3) - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - EhL=c(EhL,list(Tmp)) - } - Tmp=grep("n",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:2){ - Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),Xystr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",URNG) - Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[1])) - Tmp=Paramplot(Tmp1,Tmp2,Tmp3) - if(Cflg>0){ - Tmp1=Op(length(EhL),EhL) - Tmp=Joincrvs(Tmp1,Tmp) - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - Tmp1=EhL[Looprange(1,length(EhL)-1)] - EhL=c(Tmp1,Tmp) - }else{ - Cflg=0 - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - EhL=c(EhL,list(Tmp)) - } - } - Tmp=grep("w",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:2){ - Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),Xystr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",VRNG) - Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[2])) - Tmp=Paramplot(Tmp1,Tmp2,Tmp3) - if(Cflg>0){ - Tmp1=Op(length(EhL),EhL) - Tmp=Joincrvs(Tmp1,Tmp) - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - Tmp1=EhL[Looprange(1,length(EhL)-1)] - EhL=c(Tmp1,list(Tmp)) - }else{ - Cflg=0 - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - EhL=c(EhL,list(Tmp)) - } - } - Tmp=grep("s",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:2){ - Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),Xystr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",URNG) - Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[1])) - Tmp=Paramplot(Tmp1,Tmp2,Tmp3) - if(Cflg>0){ - Tmp1=Op(length(EhL),EhL) - Tmp=Joincrvs(Tmp1,Tmp) - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp1=EhL[Looprange(1,length(EhL)-1)] - } - Tmp1=EhL[Looprange(1,length(EhL)-1)] - EhL=c(Tmp1,list(Tmp)) - }else{ - Cflg=0 - if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))<Eps0){ - Cflg=1 - Tmp[Length(Tmp),]=Tmp[1,] - } - EhL=c(EhL,list(Tmp)) - } - } - return(EhL) -} - -Partitionseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Fig=varargin[[1]] - GL=varargin[[2]]; N=3 - if(!is.list(GL)){GL=list(GL)} #18.02.21 - Eps0=10^(-4) - Eps1=0.01 - if(Nargs>2){ - Eps1=varargin[[3]] - } - Eps2=0.1 - if(Nargs>3){ - Eps2=varargin[[4]] - } - if(Nargs>4){ - Ns=varargin[[5]] - if(Ns>0){#18.02.21from - Other=Op(Ns,OTHERPARTITION) - }else{ - Other=c() - }#18.02.21until - }else{ - Ns=1 - Other=c() - } - Npt=Length(Fig) - ParL=c(1,Npt,Other) - for(N in Looprange(max(1,Ns),Length(GL))){ #18.02.21 - G=Op(N,GL) - KouL=IntersectcurvesPp(Fig,G,Eps1,Eps2) - Tmp1=c(); Tmp2=c() - for(jj in Looprange(1,length(KouL))){ - tmp=Op(2,KouL[[jj]]) - if((tmp>1+Eps0)&&(tmp<Npt-Eps0)){ - Tmp1=c(Tmp1,tmp) - } - tmp=Op(3,KouL[[jj]]) - if((tmp>1+Eps0)&&(tmp<Length(G)-Eps0)){ - Tmp2=c(Tmp2,tmp) - } - } - ParL=c(ParL,Tmp1) - if((Ns>0)&&(N>Ns)&&(length(Tmp2)>0)){ #18.02.21 - tmp=OTHERPARTITION[[N]] - OTHERPARTITION[[N]]<<- c(tmp,Tmp2) - } - } - tmp1=sort(ParL) - ParL=c() - tmp2=-1 - for(jj in Looprange(1,length(tmp1))){ - tmp=Op(jj,tmp1) - if(abs(tmp-tmp2)>Eps1){ - ParL=c(ParL,tmp) - tmp2=tmp - } - } - return(ParL) -} - -Evlptablepara<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Tmp=varargin[[1]] - Mdv=50 - Ndv=50 - if(Nargs>=2){ - Tmp=varargin[[2]] - if(is.list(Tmp)){Tmp=Op(1,Tmp)} - if(length(Tmp)>1){ - Mdv=Tmp[1] - Ndv=Tmp[2] - }else{ - Mdv=Tmp - if(Nargs==2){ - Ndv=Mdv - }else{ - Tmp1=varargin[[3]] - if((is.numeric(Tmp1)) && (length(Tmp1)==1)){ - Ndv=Tmp1 - }else{ - Ndv=Mdv - } - } - } - } - U1=URNG[1]; U2=URNG[2] - V1=VRNG[1]; V2=VRNG[2] - Du=(U2-U1)/(Mdv) - Dv=(V2-V1)/(Ndv) - sph=sprintf("%7.7f",sin(PHI)) - cph=sprintf("%7.7f",cos(PHI)) - sth=sprintf("%7.7f",sin(THETA)) - cth=sprintf("%7.7f",cos(THETA)) - xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="") - tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="") - ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="") - dxu=Diff(xstr,UNAME) - dxv=Diff(xstr,VNAME) - dyu=Diff(ystr,UNAME) - dyv=Diff(ystr,VNAME) - I=1 - Zval=c() - for(jj in 1:(Ndv+1)){ - v=V1+(jj-1)*Dv - ZuL=c() - for(ii in 1:(Mdv+1)){ - u=U1+(ii-1)*Du - tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="") - tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="") - Dxu=Funvalue(dxu,tmp1,tmp2) - Dxv=Funvalue(dxv,tmp1,tmp2) - Dyu=Funvalue(dyu,tmp1,tmp2) - Dyv=Funvalue(dyv,tmp1,tmp2) - Tmp=Dxu*Dyv-Dxv*Dyu - ZuL=c(ZuL,Tmp) - } - Zval=Appendrow(Zval,ZuL) - } - Yval=c() - for(jj in 1:(Ndv+1)){ - v=V1+(jj-1)*Dv - Yval=c(Yval,v) - } - Xval=c() - for(ii in 1:(Mdv+1)){ - u=U1+(ii-1)*Du - Xval=c(Xval,u) - } - return(list(Zval,Xval,Yval)) -} - -Evlpfun<- function(u,v){ - tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="") - tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="") - Dxu=Funvalue(dxu,tmp1,tmp2) - Dxv=Funvalue(dxv,tmp1,tmp2) - Dyu=Funvalue(dyu,tmp1,tmp2) - Dyv=Funvalue(dyv,tmp1,tmp2) - Tmp=Dxu*Dyv-Dxv*Dyu - return(Tmp) -} - -Envelopedata<- function(...){ - varargin=list(...) - Eps0=10^(-4) - Nargs=length(varargin) - Fd=varargin[[1]] - Fullformfunc(Fd) - Mdv=50 - Ndv=50 - if(Nargs>=2){ - Tmp=varargin[[2]] - if(is.list(Tmp)){Tmp=Op(1,Tmp)} - if(length(Tmp)>1){ - Mdv=Tmp[1] - Ndv=Tmp[2] - }else{ - Mdv=Tmp - if(Nargs==2){ - Ndv=Mdv - }else{ - Tmp1=varargin[[3]] - if((is.numeric(Tmp1)) && (length(Tmp1)==1)){ - Ndv=Tmp1 - }else{ - Ndv=Mdv - } - } - } - } - sph=sprintf("%7.7f",sin(PHI)) - cph=sprintf("%7.7f",cos(PHI)) - sth=sprintf("%7.7f",sin(THETA)) - cth=sprintf("%7.7f",cos(THETA)) - xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="") - tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="") - ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="") - dxu<<- Diff(xstr,UNAME) - dxv<<- Diff(xstr,VNAME) - dyu<<- Diff(ystr,UNAME) - dyv<<- Diff(ystr,VNAME) - U1=URNG[1]; U2=URNG[2] - V1=VRNG[1]; V2=VRNG[2] - Du=(U2-U1)/Mdv - Dv=(V2-V1)/Ndv - Out=c() - for(J in 1:(Ndv)){ - Vval1=VRNG[1]+(J-1)*Dv - Vval2=VRNG[1]+J*Dv - Uval1=URNG[1] - Eval11=Evlpfun(Uval1,Vval1) - Eval12=Evlpfun(Uval1,Vval2) - for(I in 1:(Mdv)){ -# Uval1=URNG[1]+(I-1)*Du - Uval2=URNG[1]+I*Du -# Eval11=Evlpfun(Uval1,Vval1) -# Eval12=Evlpfun(Uval1,Vval2) - Eval21=Evlpfun(Uval2,Vval1) - Eval22=Evlpfun(Uval2,Vval2) - a1=Uval1;b1=Vval1;c1=Eval11 - a2=Uval2;b2=Vval1;c2=Eval21 - a3=Uval2;b3=Vval2;c3=Eval22 - a4=Uval1;b4=Vval2;c4=Eval12 - PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) - VL=c(c1,c2,c3,c4,c1) - QL=c() - for(K in 1:4){ - if(abs(VL[K])<=Eps0){ - QL=Appendrow(QL,PL[K,]) - }else if(VL[K]>Eps0){ - if(VL[K+1]< -Eps0){ - Tmp=1/(VL[K]-VL[K+1])*(-VL[K+1]*PL[K,]+VL[K]*PL[K+1,]) - QL=Appendrow(QL,Tmp) - } - }else{ - if(VL[K+1]>Eps0){ - Tmp=1/(-VL[K]+VL[K+1])*(VL[K+1]*PL[K,]-VL[K]*PL[K+1,]) - QL=Appendrow(QL,Tmp) - } - } - } - Uval1=Uval2 - Eval11=Eval21 - Eval12=Eval22 - if(Length(QL)==2){ - Out=Appendrow(Out,c(Inf,Inf)) - Out=Appendrow(Out,QL) - } - } - } - Out=Out[2:nrow(Out),] - if(Length(Out)>0){ - Out=Connectseg(Out) - }else{ - Out=c() - } - return(Out) -} - -Dropnumlistcrv<- function(QdL,Eps1){ - Eps0=10^(-4) - if(!is.list(QdL)){ - PdL=list(QdL) - }else{ - PdL=QdL - } - OutL=list() - for(I in Looprange(1,length(PdL))){ - Pd=Op(I,PdL) - PtL=c(1) - P=Op(1,Pd) - for(K in Looprange(2,Length(Pd)-1)){ - if(Norm(P-Op(K,Pd))>Eps1){ - PtL=c(PtL,K) - P=Op(K,Pd) - } - } - K=Length(Pd) - if(Norm(P-Op(K,Pd))>Eps1){ #18.02.12 eps - PtL=c(PtL,K) - } -# if(length(PtL)==1){ #180306 -# } - OutL=c(OutL,list(PtL)) - } - return(OutL) -} - -Cuspsplitpara<- function(...){ - varargin=list(...) - Nargs=length(varargin); - Gdxy=varargin[[1]] - if(!is.list(Gdxy)){ - Gdxy=list(Gdxy) - } - Eps0=10^(-4) - Eps1=0.01 - if(Nargs>2){Eps1=varargin[[2]]} - N=2 - CUSPSPLITPT<<- list() - OutkL=list() - for(Ng in Looprange(1,length(Gdxy))){ - PtxyL=Op(Ng,Gdxy) - PtkL=c() - PthL=c() - for(I in Looprange(1,Length(PtxyL))){ - Tmp=Op(I,PtxyL) - Tmp1=paste(UNAME,'=',sprintf("%7.7f",Tmp[1]),sep="") - eval(parse(text=Tmp1)) - Tmp1=paste(VNAME,'=',sprintf("%7.7f",Tmp[2]),sep="") - eval(parse(text=Tmp1)) - Tmp2=c(eval(parse(text=XYZstr[1]))) - Tmp2=c(Tmp2,eval(parse(text=XYZstr[2]))) - Tmp2=c(Tmp2,eval(parse(text=XYZstr[3]))) - Tmp3=Parapt(Tmp2) - if(I==1){ - PtkL=matrix(Tmp2,nrow=1) - PthL=matrix(Tmp3,nrow=1) - }else{ - Tmp4=Op(Length(PthL),PthL) - if(Norm(Tmp3-Tmp4)>Eps0){ - PtkL=Appendrow(PtkL,Tmp2) - PthL=Appendrow(PthL,Tmp3) - } - } - } - if(Length(PthL)==0){ - return(list()) - } - Ps=Op(1,PthL); Pe=Op(Length(PthL),PthL) - Cflg=0 - if(Norm(Ps-Pe)<Eps1){Cflg=1} - CuspL=c() - Cva=cos(10*pi/180) - for(I in Looprange(1,Length(PthL)-1)){ - if(Length(PthL)==2){break} - Tmp=Op(I,PthL) - if(I==1){ - if(Cflg==0){next} - Tmp1=Op(Length(PthL)-1,PthL) - }else{ - Tmp1=Op(I-1,PthL) - } - Tmp2=Op(I+1,PthL) - V1=Tmp-Tmp1 - V2=Tmp2-Tmp - Tmp3=Dotprod(V1,V2)/(Norm(V1)*Norm(V2)) - Cuspflg=0 - if(Tmp3<Cva){ - P=Op(I,PthL) - Kaku=acos(Tmp3)*180/pi - if(Crossprod(V1,V2)<0){ - Kaku=-Kaku - } - Cuspflg=0 - for(J in Looprange(I+1,Length(PthL)-1)){ - if(abs(Kaku)>90){ - Cuspflg=1 - break - } - Q=Op(J,PthL) - if(Norm(P-Q)>Eps1){ - break - } - V1=Q-Op(J-1,PthL) - V2=Op(J+1,PthL)-Q - Tmp3=Dotprod(V1,V2)/(norm(V1)*norm(V2)) - Tmp=acos(Tmp3)*180/pi - if(Crossprod(V1,V2)<0){ - Tmp=-Tmp - } - Kaku=Kaku+Tmp - } - if(Cuspflg==1){ - Tmp=trunc((I+J)*0.5) - I=J - if(length(CuspL)==0){ - CuspL=c(Tmp) - }else{ - CuspL=c(CuspL,Tmp) - } - } - } - } - if(Cflg==0){ - CuspL=c(1,CuspL,Length(PthL)) - }else if(length(CuspL)==0){ - CuspL=c(1,Length(PthL)) - }else if(Op(1,CuspL)==1){ - CuspL=c(CuspL,Length(PthL)) - }else{ - Tmp=Op(1,CuspL) - Tmp1=PthL[Tmp:Length(PthL),] - Tmp2=PthL[2:Tmp,] - PthL=Appendrow(Tmp1,Tmp2) - Tmp1=PtkL[Tmp:Length(PthL),] - Tmp2=PtkL[2:Tmp,] - PtkL=Appendrow(Tmp1,Tmp2) - CuspL=CuspL-Tmp+1 - CuspL=c(CuspL,Length(PthL)) - } - if(length(CuspL)==2){ - Tmp4=PthL[Length(PthL),] - if(Length(PtkL)>=2){ - CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4)) - OutkL=c(OutkL,list(PtkL)) - } - next - } - Outk=list() - Is=1 - for(I in Looprange(1,length(CuspL)-1)){ - Tmp1=CuspL[Is]; Tmp2=CuspL[I+1] - Tmp3=Op(Tmp1,PthL); Tmp4=Op(Tmp2,PthL) - if(Norm(Tmp3-Tmp4)>Eps1){ - Tmpk=PtkL[Tmp1:Tmp2,] - Outk=c(Outk,list(Tmpk)) - CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4)) - Is=I+1 - } - } - OutkL=c(OutkL,Outk) - } - Tmp1=Dropnumlistcrv(Projpara(OutkL),Eps1*0.5) - Tmp=list() - for(I in Looprange(1,length(OutkL))){ - Tmp2=Op(I,OutkL) - Tmp3=Op(I,Tmp1) - Tmp4=c() - for(J in Looprange(1,Length(Tmp3))){ - Tmp5=Op(Tmp3[J],Tmp2) - Tmp4=Appendrow(Tmp4,Tmp5) - } - if(Length(Tmp4)>0){ - Tmp=c(Tmp,list(Tmp4)) - } - } - return(Tmp) -} - -PthiddenQ<- function(PtA,Vec,Uveq,Np,Eps1,Eps2){ - Eps0=10^(-4) - Out=c() - Vec=1/Norm(Vec)*Vec - if(length(Np)==1){ - Np=c(Np,Np) - } - Tmp=paste("Eqfun<- function(U,V){",sep='') - if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){ - Vstr=sprintf("%6.6f",Vec) - Pstr=sprintf("%6.6f",PtA) - Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='') - Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='') - }else{ - Tmp=paste(Tmp,"Xfunc(U,V)}",sep='') - } - eval(parse(text=Tmp)) - Dx=(URNG[2]-URNG[1])/Np[1] - Dy=(VRNG[2]-VRNG[1])/Np[2] - for(J in Looprange(1,Np[2])){ #180227 - Vval1=VRNG[1]+(J-1)*Dy - Vval2=VRNG[1]+J*Dy - Uval1=URNG[1] #180306(3lines) - Eval11=Eqfun(Uval1,Vval1) - Eval12=Eqfun(Uval1,Vval2) - Uval1=URNG[1] #180305(3lines) - for(I in Looprange(1,Np[1])){ #180227 -# Uval1=URNG[1]+(I-1)*Dx - Uval2=URNG[1]+I*Dx -# Eval11=Eqfun(Uval1,Vval1) -# Eval12=Eqfun(Uval1,Vval2) - Eval21=Eqfun(Uval2,Vval1) - Eval22=Eqfun(Uval2,Vval2) - a1=Uval1;b1=Vval1;c1=Eval11 - a2=Uval2;b2=Vval1;c2=Eval21 - a3=Uval2;b3=Vval2;c3=Eval22 - a4=Uval1;b4=Vval2;c4=Eval12 - PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) - VL=c(c1,c2,c3,c4,c1) - QL=c() - for(K in 1:4){ - P1=Op(K,PL); P2=Op(K+1,PL) - M1=Op(K,VL); M2=Op(K+1,VL) - if(abs(M1)<Eps0){ - QL=Appendrow(QL,P1) - next - } - if(abs(M2)<Eps0){ -# QL=Appendrow(QL,P2) - next - } - if((M1> 0) && (M2> 0)){ - next - } - if((M1< 0) && (M2< 0)){ - next - } - Tmp=1/(M1-M2)*(-M2*P1+M1*P2) - QL=Appendrow(QL,Tmp) - } - Uval1=Uval2 #180306(3lines) - Eval11=Eval21 - Eval12=Eval22 - if(Length(QL)==2){ - Puv1=Op(1,QL); Puv2=Op(2,QL) - Tmp1=Op(1,Puv1) - Tmp2=Op(2,Puv1) - Xv=Xfunc(Tmp1,Tmp2) - Yv=Yfunc(Tmp1,Tmp2) - Zv=Zfunc(Tmp1,Tmp2) - P1=c(Xv,Yv,Zv) - Tmp1=Op(1,Puv2) - Tmp2=Op(2,Puv2) - Xv=Xfunc(Tmp1,Tmp2) - Yv=Yfunc(Tmp1,Tmp2) - Zv=Zfunc(Tmp1,Tmp2) - P2=c(Xv,Yv,Zv) - V1=Vec[1]; V2=Vec[2]; V3=Vec[3] - if(abs(V1)>Eps0){ - M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3] - M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3] - }else if(abs(V2)>Eps0){ - M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3] - M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3] - }else{ - M1=PtA[2]-P1[2] - M2=PtA[2]-P2[2] - } - if(M1*M2>= 0){ - if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ - next - } - if(M1==0){ - Pt=P1; Ptuv=Puv1 - }else{ - Pt=P2; Ptuv=Puv2 - } - }else{ - Pt=1/(M1-M2)*(-M2*P1+M1*P2) - Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2) - } - if(is.character(Uveq)){ - Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='') - Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='') - Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE) - Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE) - Tmp=eval(parse(text=Tmp)) - if(Tmp< -Eps0){ - next - } - } - Tmp1=Crossprod(Pt-PtA,Vec) - if(Norm(Tmp1)<Eps1){ #18.02.19 - if(Zparapt(Pt)>Zparapt(PtA)+Eps2){ - return(list(1,Pt,Zparapt(Pt),Zparapt(PtA))) - }else{ - Out=Appendrow(Out,Pt) - } - } - } - } - } - if(Length(Out)==0){ - return(list(0,c())) - } - return(c(list(0,Out))) -} - -Nohiddenpara2<- function (Par,Fk,Uveq,Np,Eps1,Eps2){ - Eps0=10^(-4) - Fh=Projpara(Fk) - P1=Ptstart(Fh) - P2=Ptend(Fh) - Csp=CUSPPT - if(!is.list(Csp)){Csp=list(Csp)} - Cspflg=1 - for(I in Looprange(1,length(Csp))){ - Tmp=Op(I,Csp) - if(Norm(Tmp-P1)<Eps0){ - if(Cspflg==1){Cspflg=2} - if(Cspflg==3){Cspflg=6} - next - } - if(Norm(Tmp-P2)<Eps0){ - if(Cspflg==1){Cspflg=3} - if(Cspflg==2){Cspflg=6} - next - } - } - PaL=c() - tmp2=-1 - for(jj in Looprange(1,length(Par)-1)){ - tmp1=Op(jj,Par) - if(abs(tmp1-tmp2)>Eps0){ #180227 - PaL=c(PaL,tmp1) - tmp2=tmp1 - } - } - tmp1=PaL[length(PaL)] #18.02.26from - tmp2=Par[length(Par)] - if(abs(tmp1-tmp2)<Eps0){ #180227 - PaL[length(PaL)]=tmp2 - }else{ - PaL=c(PaL,tmp2) - } #18.02.26until - SeL=c() - for(N in Looprange(1,length(PaL)-1)){ - S=(PaL[N]+PaL[N+1])/2 - Tmp=Invparapt(S,Fh,Fk) - PtA=Op(1,Tmp) - PtAp=Parapt(PtA) - Vec=c(sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)) - Flg=PthiddenQ(PtA,Vec,Uveq,Np,Eps1,Eps2) - if(Flg[[1]]==0){ - SeL=c(SeL,N) - } - } - FigL=list() - FigkL=list() - for(I in Looprange(1,length(SeL))){ - Tmp1=Pointoncurve(PaL[SeL[I]],Fh) - Tmp2=Pointoncurve(PaL[SeL[I]+1],Fh) - if(I==1){ - P=Tmp1; SP=PaL[SeL[I]] - Q=Tmp2; SQ=PaL[SeL[I]+1] - }else{ - if(Member(SeL[I]-1,SeL)){ - Q=Tmp2; SQ=PaL[SeL[I]+1] - }else{ - FigL=c(FigL,list(Partcrv(SP,SQ,Fh))) - Tmp3=Invparapt(SP,Fh,Fk) - TP=Op(2,Tmp3) - Tmp3=Invparapt(SQ,Fh,Fk) - TQ=Op(2,Tmp3) - Tmp4=Partcrv3(TP,TQ,Fk) - FigkL=c(FigkL,list(Tmp4)) - P=Tmp1; SP=PaL[SeL[I]] - Q=Tmp2; SQ=PaL[SeL[I]+1] - } - } - } - if(length(SeL)>0){ - if(Norm(P-Q)>Eps0){ #18.02.14 - FigL=c(FigL,list(Partcrv(P,Q,Fh))) - Tmp3=Invparapt(SP,Fh,Fk) - TP=Op(2,Tmp3) - Tmp3=Invparapt(SQ,Fh,Fk) - TQ=Op(2,Tmp3) - FigkL=c(FigkL,list(Partcrv3(TP,TQ,Fk))) - }else{ - FigL=c(FigL,list(Fh)) - FigkL=c(FigkL,list(Fk)) - } - } - Tmp=c() - for(I in Looprange(1,length(PaL)-1)){ - if(!Member(I,SeL)){ - Tmp=c(Tmp,I) - } - } - SeL=Tmp - HIDDENDATA<<- list() - for(I in Looprange(1,length(SeL))){ - Tmp=PaL[SeL[I]] - Tmp1=Pointoncurve(Tmp,Fh) - Tmp=PaL[SeL[I]+1] - Tmp2=Pointoncurve(Tmp,Fh) - if(I==1){ - P=Tmp1; SP=PaL[SeL[I]] - Q=Tmp2; SQ=PaL[SeL[I]+1] - }else{ - if(Member(SeL[I]-1,SeL)){ - Q=Tmp2; SQ=PaL[SeL[I]+1] - }else{ - Tmp=Invparapt(SP,Fh,Fk) - TP=Op(2,Tmp) - Tmp=Invparapt(SQ,Fh,Fk) - TQ=Op(2,Tmp) - HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk))) - P=Tmp1; SP=PaL[SeL[I]] - Q=Tmp2; SQ=PaL[SeL[I]+1] - } - } - } - if(length(SeL)>0){ - if(Norm(P-Q)>Eps0){ #18.02.14 - Tmp=Invparapt(SP,Fh,Fk) - TP=Op(2,Tmp) - Tmp=Invparapt(SQ,Fh,Fk) - TQ=Op(2,Tmp) - HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk))) - }else{ - HIDDENDATA<<- c(HIDDENDATA,list(Fk)) - } - } - return(FigkL) -} - -Borderparadata<- function(...){ - varargin=list(...) - Nargs=length(varargin) - FkL=varargin[[1]] - Np=c(50,50) - Eps1=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(2,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps1=tmp} - if(ctr==2){Eps2=tmp} - } - } - Umin=URNG[1]; Umax=URNG[2] - Vmin=VRNG[1]; Vmax=VRNG[2] - EkL=list() - Tmp=grep("e",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:3){ - Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),XYZstr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",VRNG) - Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[2]),sep="") - Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) - EkL=c(EkL,list(Tmp)) - } - Tmp=grep("n",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:3){ - Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),XYZstr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",URNG) - Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[1]),sep="") - Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) - EkL=c(EkL,list(Tmp)) - } - Tmp=grep("w",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:3){ - Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),XYZstr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",VRNG) - Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[2])) - Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) - EkL=c(EkL,list(Tmp)) - } - Tmp=grep("s",DRWS,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1="c(" - for(jj in 1:3){ - Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),XYZstr[jj]) - Tmp1=paste(Tmp1,Tmp,",",sep="") - } - Tmp=substring(Tmp1,1,Length(Tmp1)-1) - Tmp1=paste(Tmp,")",sep="") - Tmp=sprintf("%6.6f",URNG) - Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') - Tmp3=paste('N=',as.character(Np[1])) - Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) - EkL=c(EkL,list(Tmp)) - } - if(length(EkL)>0){ - FkL=c(FkL,EkL) - } - Fall=Projpara(FkL) - if(is.numeric(Fall)){ - Fall=list(Fall) - } - Fbdxy=Makexybdy(Np) - BORDERPT<<- list() - Tmp1=list() - for(I in Looprange(1,length(Fall))){ - Tmp1=c(Tmp1,list(c())) - } - OTHERPARTITION<<- Tmp1 - FsL=list() - BORDERHIDDENDATA<<- list() - starttime=proc.time() - for(I in Looprange(1,length(FkL))){ - Tmp=Op(I,FkL) - Tmp=Projpara(Tmp) - Par=Partitionseg(Tmp,Fall,Eps1,Eps2,I) - Tmp1=Op(I,FkL) - Tmp=Nohiddenpara2(Par,Tmp1,1,Np,Eps1,Eps2) - if(length(HIDDENDATA)>0){ - BORDERHIDDENDATA<<- c(BORDERHIDDENDATA,HIDDENDATA) - } - if(length(Tmp)>0){ - FsL=c(FsL,Tmp) - } - Tmp=paste('Border',formatC(I,width=2,flag="0"),'/',sep='') - Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') - Tmp1=proc.time()-starttime - print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) - } - return(FsL) -} - -Sfbdparadata<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Fd=varargin[[1]] - FdL=Fullformfunc(Fd) - Np=c(50,50) - Eps0=10^(-4) - Eps1=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(2,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps1=tmp} - if(ctr==2){Eps2=tmp} - } - } - starttime=proc.time() -# tmp=Evlptablepara(Np) -# Zval=tmp[[1]]; Xval=tmp[[2]]; Yval=tmp[[3]] -# Out3=Implicitplot(Zval,Xval,Yval) - Out3=Envelopedata(Fd) #180306 - tmp3=list() - pts=list() #180306 - for(jj in Looprange(1,length(Out3))){ - tmp1=Op(jj,Out3) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) - } - Nlist=Dropnumlistcrv(tmp2,Eps1) - Nlist=Nlist[[1]] - if(Length(Nlist)==1){ #180306from - tmp=Op(1,Nlist) - tmp=Op(tmp,tmp1) - pts=c(pts,list(tmp)) -# pts=c(pts,list(XYZfunc(tmp[1],tmp[2])))#180306until - }else{ - tmp=c() - for(kk in Looprange(1,length(Nlist))){ - tmp=Appendrow(tmp,Op(Nlist[kk],tmp1)) #18.02.18 - } - if(Length(tmp)>0){ - tmp3=c(tmp3,list(tmp)) - } - } - } - Out3=tmp3 - tmp3=pts #180306from - pts=list() - for(ii in Looprange(1,length(tmp3))){ - tmp=Op(ii,tmp3) - tmp1=XYZfunc(tmp[1],tmp2[]) - flg=0 - for(jj in Looprange(1,length(pts))){ - tmp=Op(jj,pts) - tmp2=XYZfunc(tmp[1],tmp2[]) - if(Norm(tmp1-tmp2)<Eps1){ - flg=1; break - } - } - if(flg==0){pts=c(pts,list(Op(ii,tmp3)))} - } - for(ii in Looprange(1,length(pts))){ - tmp=Op(ii,pts) - tmp1=XYZfunc(tmp[1],tmp[2]) - for(jj in Looprange(1,length(Out3))){ - tmp2=Op(jj,Out3) - eps=1 - for(kk in Looprange(1,Length(tmp2)-1)){ - tmp=Op(kk,tmp2) - tmp1=XYZfunc(tmp[1],tmp[2]) - tmp=Op(kk+1,tmp2) - tmp=XYZfunc(tmp[1],tmp[2]) - eps=min(c(eps,Norm(tmp1-tmp))) - } - tmp=Ptstart(tmp2) - if(Norm(tmp1-XYZfunc(tmp[1],tmp[2]))<eps+Eps0){ - Out3[[jj]]=Appendrow(Op(ii,pts),tmp2) - next - } - tmp=Ptend(tmp2) - if(Norm(tmp1-XYZfunc(tmp[1],tmp[2]))<eps+Eps0){ - Out3[[jj]]=Appendrow(tmp2,Op(ii,pts)) - next - } - } - } #180306until - IMPLICITDATA<<- Out3 - Tmp=proc.time()-starttime - print(paste('ImplicitData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep='')) - starttime=proc.time() - Out4=Cuspsplitpara(Out3,Eps1) - CUSPDATA<<- Out4 - CUSPPT<<- CUSPSPLITPT - Tmp=proc.time()-starttime - print(paste('CuspData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep='')) - Out5=Borderparadata(Out4,Np,Eps1,Eps2) - return(Out5) -} - -Meetpoints<- function(PtA,PtB,Uveq,Np,Eps1){ - Eps0=10^(-4) - Vec=PtB-PtA - if(Norm(Vec)<Eps0){return(list())} #18.02.24 - Out=list() - Vec=1/Norm(Vec)*Vec - if(length(Np)==1){ - Np=c(Np,Np) - } - Tmp=paste("Eqfun<- function(U,V){",sep='') - if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){ - Vstr=sprintf("%6.6f",Vec) - Pstr=sprintf("%6.6f",PtA) - Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='') - Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='') - }else{ - Tmp=paste(Tmp,"Xfunc(U,V)}",sep='') - } - eval(parse(text=Tmp)) - Dx=(URNG[2]-URNG[1])/Np[1] - Dy=(VRNG[2]-VRNG[1])/Np[2] - for(J in Looprange(1,Np[2])){ - Vval1=VRNG[1]+(J-1)*Dy - Vval2=VRNG[1]+J*Dy - Uval1=URNG[1] #180305(3lines) - Eval11=Eqfun(Uval1,Vval1) - Eval12=Eqfun(Uval1,Vval2) - for(I in Looprange(1,Np[1])){ -# Uval1=URNG[1]+(I-1)*Dx - Uval2=URNG[1]+I*Dx -# Eval11=Eqfun(Uval1,Vval1) -# Eval12=Eqfun(Uval1,Vval2) - Eval21=Eqfun(Uval2,Vval1) - Eval22=Eqfun(Uval2,Vval2) - a1=Uval1;b1=Vval1;c1=Eval11 - a2=Uval2;b2=Vval1;c2=Eval21 - a3=Uval2;b3=Vval2;c3=Eval22 - a4=Uval1;b4=Vval2;c4=Eval12 - PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) - VL=c(c1,c2,c3,c4,c1) - QL=c() - for(K in 1:4){ - P1=Op(K,PL); P2=Op(K+1,PL) - M1=Op(K,VL); M2=Op(K+1,VL) - if(abs(M1)<Eps0){ - QL=Appendrow(QL,P1) - next - } - if(abs(M2)<Eps0){ -# QL=Appendrow(QL,P2) - next - } - if((M1> 0) && (M2> 0)){ - next - } - if((M1< 0) && (M2< 0)){ - next - } - Tmp=1/(M1-M2)*(-M2*P1+M1*P2) - QL=Appendrow(QL,Tmp) - } - Uval1=Uval2 #180306(3lines) - Eval11=Eval21 - Eval12=Eval22 - if(Length(QL)==2){ - Puv1=Op(1,QL); Puv2=Op(2,QL) - Tmp1=Op(1,Puv1) - Tmp2=Op(2,Puv1) - Xv=Xfunc(Tmp1,Tmp2) - Yv=Yfunc(Tmp1,Tmp2) - Zv=Zfunc(Tmp1,Tmp2) - P1=c(Xv,Yv,Zv) - Tmp1=Op(1,Puv2) - Tmp2=Op(2,Puv2) - Xv=Xfunc(Tmp1,Tmp2) - Yv=Yfunc(Tmp1,Tmp2) - Zv=Zfunc(Tmp1,Tmp2) - P2=c(Xv,Yv,Zv) - V1=Vec[1]; V2=Vec[2]; V3=Vec[3] - if(abs(V1)>Eps0){ - M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3] - M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3] - }else if(abs(V2)>Eps0){ - M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3] - M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3] - }else{ - M1=PtA[2]-P1[2] - M2=PtA[2]-P2[2] - } - if(M1*M2>= 0){ #18.02.21 - if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ - next - } - if(M1==0){ - Pt=P1; Ptuv=Puv1 - }else{ - Pt=P2; Ptuv=Puv2 - } - }else{ - Pt=1/(M1-M2)*(-M2*P1+M1*P2) - Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2) - } - if(is.character(Uveq)){ - Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='') - Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='') - Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE) - Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE) - Tmp=eval(parse(text=Tmp)) - if(Tmp< -Eps0){ - next - } - } - Tmp1=Crossprod(Pt-PtA,Vec) - if(Norm(Tmp1)<Eps1){ #18.02.19 - Tmp1=Dotprod(Pt-PtA,Vec) #18.02.21 - if((Tmp1>-Eps0)&&(Tmp1<Norm(PtB-PtA)+Eps0)){ - Out=c(Out,list(Pt)) - } - } - } - } - } - tmp1=Groupnearpt(Out,Eps1) - Out=list() - for(jj in Looprange(1,length(tmp1))){ - tmp=Op(jj,tmp1) - tmp=c(sum(tmp[,1]),sum(tmp[,2]),sum(tmp[,3]))/Length(tmp) - Out=c(Out,list(tmp)) - } - return(Out) -} - -Clipindomain<- function(ObjL,FigL){ - Eps0=10^(-4) - Eps1=0.01 - Eps2=0.05 - Bdy=Kyoukai(FigL) - if(length(Bdy)>=2){ - Fbdy=Joincrvs(FigL) - }else{ - Fbdy=Op(1,FigL) - } - if(!is.list(ObjL)){ - ObjL=list(ObjL) - } - if(!is.list(FigL)){ - FigL=list(FigL) - } - OutL=list() - for(Nobj in Looprange(1,length(ObjL))){ - Obj=Op(Nobj,ObjL) - ParL=c(1,Length(Obj)) - Tmp=IntersectcurvesPp(Obj,Fbdy,Eps1,Eps2) - for(J in Looprange(1,length(Tmp))){ - Tmp1=Op(J,Tmp) - ParL=c(ParL,Op(2,Tmp1)) - } - ParL=sort(ParL) - Tmp=c(1) - for(I in Looprange(1,length(ParL))){ - Tmp1=Op(length(Tmp),Tmp) - Tmp2=ParL[I] - if(Tmp2-Tmp1>Eps0){ - Tmp=c(Tmp,Tmp2) - } - } - ParL=Tmp - Tmp1=Op(length(ParL),ParL) - Tmp2=Length(Obj) - if(abs(Tmp1-Tmp2)<Eps1){ - ParL=c(ParL[Looprange(1,length(ParL)-1)],Tmp2) - } - Fig=list() - for(N in Looprange(1,length(ParL)-1)){ - Tmp=(ParL[N]+ParL[N+1])*0.5 - Tmp=Pointoncurve(Tmp,Obj) - Tmp=Naigai(Tmp,Bdy) - Tmp1=sum(Tmp)%%2 - if(Tmp1==0){ - next - } - Fig=c(Fig,list(Partcrv(ParL[N],ParL[N+1],Obj))) - } - OutL=c(OutL,Fig) - } - return(OutL) -} - -Crvsfparadata<- function(...){ - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - Sepflg=0 - Tmp=varargin[[Nargs]] - if((is.numeric(Tmp))&&(Tmp<=0)){ - Sepflg=1 - Nargs=Nargs-1 - } - Fk=varargin[[1]] - if(!is.list(Fk)){ - FkL=list(Fk) - }else{ - FkL=Fk - } - Fbdy=Projpara(varargin[[2]]) - Fd=varargin[[3]]; - Fullformfunc(Fd) #18.02.17 - Np=c(50,50) - Eps0=10^(-4) - Eps1=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(4,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps1=tmp} - if(ctr==2){Eps2=tmp} - } - } - Out=list() - CRVSFHIDDENDATA<<- list() - for(Nn in Looprange(1,length(FkL))){ - Fk=Op(Nn,FkL) - Tmp=Projpara(Fk) - Par=Partitionseg(Tmp,Fbdy,Eps1,Eps2,0) - if(Sepflg==0){ - for(I in Looprange(1,Length(Fk)-1)){ - Pa=Op(I,Fk) - Pb=Op(I+1,Fk) - PtL=Meetpoints(Pa,Pb,1,Np,Eps1) - for(J in Looprange(1,Length(PtL))){ - Tmp=Op(J,PtL) - Tmp=Parapt(Tmp) - Tmp1=Paramoncurve(Tmp,I,Projpara(Fk)) - Tmp2=min(abs(Par-Tmp1)) - if(Tmp2*Norm(Parapt(Pb-Pa))>Eps0) { #180227 - Par=c(Par,Tmp1) - } - } - Par=sort(Par) - } - } - for(jj in Looprange(1,length(ADDPOINT))){ #18.02.19from - tmp=Parapt(Op(jj,ADDPOINT)) - tmp=Nearestpt(tmp,Projpara(Fk)) - if(tmp[[3]]<Eps1){ - Par=c(Par,tmp[[2]]) - } - } #18.02.19until - tmp1=sort(Par) - Par=c() - tmp2=-1 - for(jj in Looprange(1,length(tmp1))){ - tmp=Op(jj,tmp1) - if(abs(tmp-tmp2)>Eps0){ #180227 - Par=c(Par,tmp) - tmp2=tmp - } - } - Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps1,Eps2) - Out=c(Out,Tmp1) - CRVSFHIDDENDATA<<- c(CRVSFHIDDENDATA,HIDDENDATA) - Tmp=paste('Crvsfdata',formatC(Nn,width=2,flag="0"),'/',sep='') - Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') - Tmp1=proc.time()-starttime - print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) - } - return(Out) -} - -Crv3onsfparadata<- function(...){ - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - Fk=varargin[[1]] - if(!is.list(Fk)){ - FkL=list(Fk) - }else{ - FkL=Fk - } - Fbdy=Projpara(varargin[[2]]) - Fd=varargin[[3]] - Fullformfunc(Fd) #18.02.17 - Np=c(50,50) - Eps1=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(4,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps1=tmp} - if(ctr==2){Eps2=tmp} - } - } - Out=list() - CRVONSFHIDDENDATA<<- list() - for(Nn in Looprange(1,length(FkL))){ - Fk=Op(Nn,FkL) - Tmp=Projpara(Fk) - Par=Partitionseg(Tmp,Fbdy,Eps1,Eps2,0) - for(jj in Looprange(1,length(ADDPOINT))){ - tmp=Parapt(Op(jj,ADDPOINT)) - tmp=Nearestpt(tmp,Projpara(Fk)) - if(tmp[[3]]<Eps1){ - Par=c(Par,tmp[[2]]) - } - } - Par=sort(Par) - Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps1,Eps2) - Out=c(Out,Tmp1) - CRVONSFHIDDENDATA<<- c(CRVONSFHIDDENDATA,HIDDENDATA) - Tmp=paste('Crvonsfdata',formatC(Nn,width=2,flag="0"),'/',sep='') - Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') - Tmp1=proc.time()-starttime - print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) - } - return(Out) -} - -Crvonsfparadata<- function(...){ - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - Fuv=varargin[[1]] - Fbdy3=varargin[[2]] - Fd=varargin[[3]] - Fullformfunc(Fd) - if(!is.list(Fuv)){ - Fuv=list(Fuv) - } - FkL=list() - for(jj in Looprange(1,length(Fuv))){ - tmp1=Op(jj,Fuv) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) - } - FkL=c(FkL,list(tmp2)) - } - Np=c(50,50) - Eps1=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(4,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps1=tmp} - if(ctr==2){Eps2=tmp} - } - } - Out=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2) - return(Out) -} - -Wireparadata<- function(...){ - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - Fbdy3=varargin[[1]] - Fd=varargin[[2]] - FdL=Fullformfunc(Fd) - DuL=varargin[[3]] - DvL=varargin[[4]] - Np=c(50,50) - Eps1=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(5,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps1=tmp} - if(ctr==2){Eps2=tmp} - } - } - if(is.numeric(DuL)){ - tmp1=DuL - DuL=list() - for(jj in Looprange(1,tmp1)){ - tmp=jj*(URNG[2]-URNG[1])/(tmp1+1) - DuL=c(DuL,list(tmp)) - } - } - if(is.numeric(DvL)){ - tmp1=DvL - DvL=list() - for(jj in Looprange(1,tmp1)){ - tmp=jj*(VRNG[2]-VRNG[1])/(tmp1+1) - DvL=c(DvL,list(tmp)) - } - } - Fuv=list() - for(jj in Looprange(1,length(DuL))){ - tmp1=paste("c(",as.character(Op(jj,DuL)),",",VNAME,")",sep="") - tmp2=paste("N=",as.character(Np[2]),sep="") - tmp1=Paramplot(tmp1,Op(6,FdL),tmp2) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,tmp) - } - Fuv=c(Fuv,list(tmp2)) - } - FkL=list() - for(jj in Looprange(1,length(Fuv))){ - tmp1=Op(jj,Fuv) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) - } - FkL=c(FkL,list(tmp2)) - } - Tmp1=proc.time()-starttime - cat(UNAME,"direction started","\n") - Out1=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2) - WIREHIDDENDATA<<- CRVONSFHIDDENDATA - Fuv=list() - for(jj in Looprange(1,length(DvL))){ - tmp1=paste("c(",UNAME,",",as.character(Op(jj,DvL)),")",sep="") - tmp2=paste("N=",as.character(Np[2]),sep="") - tmp1=Paramplot(tmp1,Op(5,FdL),tmp2) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,tmp) - } - Fuv=c(Fuv,list(tmp2)) - } - FkL=list() - for(jj in Looprange(1,length(Fuv))){ - tmp1=Op(jj,Fuv) - tmp2=c() - for(kk in Looprange(1,Length(tmp1))){ - tmp=Op(kk,tmp1) - tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) - } - FkL=c(FkL,list(tmp2)) - } - cat(VNAME,"direction started","\n") - Out2=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2) - WIREHIDDENDATA<<- c(WIREHIDDENDATA, CRVONSFHIDDENDATA) - Out=c(Out1,Out2) - return(Out) -} - -Intersectcrvsf<- function(...){ - # bdyeq is the equation of boundary f(x,y,z) =0 - starttime=proc.time() - varargin=list(...) - Nargs=length(varargin) - crv=varargin[[1]] - Fd=varargin[[2]] - Fullformfunc(Fd) - bdyflg=0 - bdyeq=varargin[[Nargs]] - if(is.character(bdyeq)){ - Nargs=Nargs-1 - bdyflg=1 - tmp=strsplit(bdyeq,"=",fixed=TRUE) - tmp=tmp[[1]] - if(length(tmp)>1){ - bdyeq=paste("(",tmp[1],")-(",tmp[2],")",sep="") - } - tmp=paste("bdyeq<- function(P){x=P[1];y=P[2];z=P[3];",bdyeq,"}",sep="") - eval(parse(text=tmp)) - } - Eps0=10^(-4) - Np=c(50,50) - Eps1=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(3,Nargs)){ - tmp=varargin[[jj]] - if((length(tmp)>1)||(tmp>1)){ - Np=tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps1=tmp} - if(ctr==2){Eps2=tmp} - } - } - PtL=list() - for(I in Looprange(1,Length(crv)-1)){ - Pa=Op(I,crv) - Pb=Op(I+1,crv) - if(bdyflg==0){ - tmp=Meetpoints(Pa,Pb,1,Np,Eps1) - }else{ - M1=bdyeq(Pa); M2=bdyeq(Pb) - if(M1*M2>= 0){ #18.02.21 - if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ - next - } - if(M1==0){ - tmp=list(Pa) - }else{ - tmp=list(Pb) - } - }else{ - while(Norm(Pb-Pa)>Eps0){ - if(bdyeq(Pa)==0){ - tmp=list(Pa) - break - } - if(bdyeq(Pa)*bdyeq((Pa+Pb)/2)>0){ - Pa=(Pa+Pb)/2 - }else{ - Pb=(Pa+Pb)/2 - } - } - tmp=list(1/(M1-M2)*(-M2*Pa+M1*Pb)) - } - } - PtL=c(PtL,tmp) - } - Tmp=paste('Intersectcrvsf obtained : Time =',sep='') - Tmp1=proc.time()-starttime - print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) - return(PtL) -} - -Sfcutparadata<- function(...){ - varargin=list(...) - Nargs=length(varargin) - CutD=varargin[[1]] - Fbdy3=varargin[[2]] - Fd=varargin[[3]] - FdL=Fullformfunc(Fd) - Np=c(50,50) - Eps0=10^(-4) - Eps1=0.01 - Eps2=0.05 - ctr=0 - for(jj in Looprange(4,Nargs)){ - Tmp=varargin[[jj]] - if((length(Tmp)>1)||(Tmp>1)){ - Np=Tmp - if(length(Np)==1){ - Np=c(Np,Np) - } - }else{ - ctr=ctr+1 - if(ctr==1){Eps1=Tmp} - if(ctr==2){Eps2=Tmp} - } - } - starttime=proc.time() - Tmp=strsplit(CutD,'=') - Tmp=Tmp[[1]] - if(length(Tmp)==1){ - Eq=CutD - }else{ - Eq=paste("(",Tmp[1],")-(",Tmp[2],")",sep="") - } - Eq=gsub("x","Xfunc(U,V)",Eq,fixed=TRUE) - Eq=gsub("y","Yfunc(U,V)",Eq,fixed=TRUE) - Eq=gsub("z","Zfunc(U,V)",Eq,fixed=TRUE) - Tmp=paste("Eqfun<<- function(U,V){",Eq,"}",sep="") - eval(parse(text=Tmp)) - Du=(URNG[2]-URNG[1])/Np[1] - Dv=(VRNG[2]-VRNG[1])/Np[2] - Out=list();Out2=list() - for(J in Looprange(1,Np[2])){ - Vval1=VRNG[1]+(J-1)*Dv - Vval2=VRNG[1]+J*Dv - Uval1=URNG[1] #180305(3lines) - Eval11=Eqfun(Uval1,Vval1) - Eval12=Eqfun(Uval1,Vval2) - for(I in Looprange(1,Np[1])){ -# Uval1=URNG[1]+(I-1)*Du - Uval2=URNG[1]+I*Du -# Eval11=Eqfun(Uval1,Vval1) -# Eval12=Eqfun(Uval1,Vval2) - Eval21=Eqfun(Uval2,Vval1) - Eval22=Eqfun(Uval2,Vval2) - a1=Uval1;b1=Vval1;c1=Eval11 - a2=Uval2;b2=Vval1;c2=Eval21 - a3=Uval2;b3=Vval2;c3=Eval22 - a4=Uval1;b4=Vval2;c4=Eval12 - PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) - VL=c(c1,c2,c3,c4,c1) - QL=c() - for(K in 1:4){ - P1=Op(K,PL); P2=Op(K+1,PL) - M1=Op(K,VL); M2=Op(K+1,VL) - if(abs(M1)<Eps0){ - QL=Appendrow(QL,P1) - next - } - if(abs(M2)<Eps0){ -# QL=Appendrow(QL,P2) - next - } - if((M1> 0) && (M2> 0)){ - next - } - if((M1< 0) && (M2< 0)){ - next - } - Tmp=1/(M1-M2)*(-M2*P1+M1*P2) - QL=Appendrow(QL,Tmp) - } - Uval1=Uval2 #180306(3lines) - Eval11=Eval21 - Eval12=Eval22 - if(Length(QL)==2){ - q11=QL[1,1];q12=QL[1,2];q21=QL[2,1];q22=QL[2,2] - if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){ - if(((q21==b1)&&(q22==b1))||((q21==b3)&&(q22==b3))){ - Out2=c(Out2,list(QL)) - }else{ - Out=c(Out,list(QL)) - } - next - } - if(((q12==b1)&&(q22==b1))||((q12==b3)&&(q22==b3))){ - if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){ - Out2=c(Out2,list(QL)) - }else{ - Out=c(Out,list(QL)) - } - next - } - Out=c(Out,list(QL)) - } - } - } - while(length(Out2)>0){ - tmp1=Out2[[1]] - Out=c(Out,list(tmp1)) - Out2=Out2[-1] - rmv=c() - for(jj in Looprange(1,length(Out2))){ - tmp2=Out2[[jj]] - diff1=Norm(tmp2[1,]-tmp1[1,])+Norm(tmp2[2,]-tmp1[2,]) - diff2=Norm(tmp2[1,]-tmp1[2,])+Norm(tmp2[2,]-tmp1[1,]) - if((diff1<Eps0)||(diff2<Eps0)){ - rmv=c(rmv,jj) - next - } - } - Out2=Out2[-rmv] - } - Out=Connectseg(Out,Eps1) - Tmp1=Out - Out=list() - for(ii in Looprange(1,length(Tmp1))){ - Tmp2=Op(ii,Tmp1) - Tmp3=c() - for(jj in Looprange(1,Length(Tmp2))){ - Tmp=Op(jj,Tmp2) - Tmp=XYZfunc(Tmp[1],Tmp[2]) - if(Length(Tmp3)>0){ - if(Norm(Op(Length(Tmp3),Tmp3)-Tmp)<Eps1){next} - } - Tmp3=Appendrow(Tmp3,Tmp) - } - Out=c(Out,list(Tmp3)) - } - Out=Crv3onsfparadata(Out,Fbdy3,Fd,Np,Eps1,Eps2) - return(Out) -} diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r b/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r deleted file mode 100644 index 37033948..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r +++ /dev/null @@ -1,580 +0,0 @@ -# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -# -#This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/> - - -######################################### - -ThisVersion<- "2ev5_2_3(17.10.28)" - -# 2017.10.28 -# Drwpt debugged ( Flattenlist ) -# 2017.10.07 -# - -############################################# - -Dottedline<- function(...) -{ - varargin <- list(...) - Nall <- length(varargin) - Nagasa <- 0.1 - Ookisa <- PenThick*2 #17.10.07 - I <- Nall - Tmp <- varargin[[I]] - while (mode(Tmp)=="numeric" && length(Tmp)==1 ) { - I <- I-1 - Tmp <- varargin[[I]] - } - if (I==Nall-1) { - Nagasa<-Nagasa*varargin[[Nall]] - Nall <- Nall-1 - } - if (I==Nall-2) { - Nagasa <- Nagasa*varargin[[Nall-1]] - Ookisa <- round(Ookisa*varargin[[Nall]]) - Nall <- Nall-2 - } - Nagasa <- 1000/2.54/MilliIn*Nagasa - Ra=Ookisa/MilliIn - for (N in 1:Nall) { - Pdata <- varargin[[N]] - if (mode(Pdata)=="numeric") { - Pdata <- list(Pdata) - } - for (II in 1:length(Pdata)) { - Clist <- MakeCurves(Op(II,Pdata)) - DinM <- Dataindex(Clist) - Mojisu=0 - for (n in Looprange(1,Nrow(DinM))) { - Tmp <- DinM[n,] - Data <- Clist[Tmp[1]:Tmp[2],] - Len <- 0 - Lenlist <- c(0) - for (I in Looprange(2,Nrow(Data))) { - Len <- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist <- c(Lenlist,Len) - } - Lenall <- Lenlist[length(Lenlist)] - if (Lenall==0) { - next - } - Naga <- Nagasa - Nten <- round(Lenall/Naga)+1 - if (Nten > 1) { - Seg <- Lenall/(Nten-1) - } - else { - Seg <- Lenall - } - Eps <- 10^(-6)*Seg - PPd<-c() - Hajime <- 1 - for (I in Looprange(0,Nten-1)) { - Len <- Seg*I - if (I>0) { - J <- Hajime - while( Len>=Lenlist[J]+Eps) { - J <- J+1 - } - Hajime <- J-1 - } - T <- (Len-Lenlist[Hajime])/ - (Lenlist[Hajime+1]-Lenlist[Hajime]) - P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - PPd<-Appendrow(PPd,P) - if (I==Nten-1) { - if (Norm(P-Data[1,])<Eps) { - next - } - } - } - for (I in Looprange(1,Nrow(PPd))){ - P<- Op(I,PPd) - if (Nrow(PPd)==1){ - V<- c(1,0) - } - else if (I==1){ - Tmp<- Op(I+1,PPd)-P - V<- 1/Norm(Tmp)*Tmp - } - else if (I==Nrow(PPd)){ - Tmp<- P-Op(I-1,PPd) - V<- 1/Norm(Tmp)*Tmp - } - else{ - Tmp1<- Op(I+1,PPd)-P - Tmp2<- P-Op(I-1,PPd) - Tmp3<-1/Norm(Tmp1)*Tmp1+1/Norm(Tmp2)*Tmp2 - V<- 1/Norm(Tmp3)*Tmp3 - } - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu=Mojisu+nchar(Str) - if(Mojisu>80){ - cat("\n",file=Wfile,append=TRUE) - Mojisu=0 - } - } - } - } - if(Mojisu>0){ - cat("\n",file=Wfile,append=TRUE) - } - } - Tmp<-PenThick/PenThickInit - Setpen(Tmp) -} - - -########################################### - -Drwline<-function(...) -{ - varargin<-list(...) - Nall<-length(varargin) - Thick<-0 - Tmp<-varargin[[Nall]] - if (mode(Tmp)=="numeric" && length(Tmp)==1){ - Setpen(Tmp) - Nall<-Nall-1 - } - for (N in 1:Nall){ - Pdata<-varargin[[N]] - if (length(Pdata)==0) next - if (mode(Pdata)!="list") Pdata<-list(Pdata) - while(Mixtype(Pdata)==3){ - Tmp1<- list() - for(II in Looprange(1,length(Pdata))){ - Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) - } - Pdata<- Tmp1 - } - for (II in Looprange(1,length(Pdata))){ - Clist<-MakeCurves(Pdata[[II]]) - DinM<-Dataindex(Clist) - for (n in Looprange(1,Nrow(DinM))){ - Tmp<-DinM[n,] - Data<-Clist[Tmp[1]:Tmp[2],] - Mojisu<-0 - for (I in Looprange(1,Nrow(Data))){ - Tmp<-Data[I,] - X=sprintf('%5.5f',Tmp[1]) - Y=sprintf('%5.5f',Tmp[2]) - Pt=paste('(',X,',',Y,')',sep="") - if(I==1){ - Str=paste('\\polyline',Pt,sep="") - }else{ - Str=Pt - } - cat(Str,file=Wfile,append=TRUE) - Mojisu<-Mojisu+nchar(Str) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<-0 - } - } - if (Mojisu!=0){ - cat("%\n",file=Wfile,append=TRUE) - } - cat("%\n",file=Wfile,append=TRUE) - } - } - } - if (Thick>0){ - Tmp<-PenThick/PenThickInit - Setpen(Tmp) - } -} - -########################################### - -Drwpt<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - All=Nargs - if (TenSize>TenSizeInit){ - N<- round(6*sqrt(TenSize/TenSizeInit)) - } - else{ - N<-4 - } - Tmp<- varargin[[All]] - Iro=c(0,0,0,1) - Iroflg=0 - if(is.character(Tmp)){ - Iro=Ratiocmyk(Tmp) - Iroflg=1 - All=All-1 - } - Tmp<- varargin[[All]] - if (mode(Tmp)=="numeric"){ - if (length(Tmp)>1){ - Kosa<- 1; All<- Nargs - } - else{ - Kosa<- Tmp; All<- All-1 - } - } - else if (mode(Tmp)=="list"){ - Kosa<- 1; All<- Nargs - } - Ra=TenSize*1000/2.54/MilliIn - if(Iroflg>0){ - Str='{\\color[cmyk]{' - for(J in 1:4){ - Str=paste(Str,as.character(Kosa*Iro[J]),sep="") - if(J<4){ - Str=paste(Str,',',sep="") - } - } - Str=paste(Str,'}%',sep="") - cat(Str,file=Wfile,append=TRUE) - } - -# CL<-c() -# for (J in 0:N){ -# Tmp<- TenSize*0.5*1000/2.54/MilliIn -# Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) -# CL<- append(CL,Tmp) -# } -# CL<- matrix(CL,nrow=2) -# CL<- t(CL) - Mojisu=0 - for (II in Looprange(1,All)){ - MS<- varargin[[II]] - MS=Flattenlist(MS) #17.10.28 - if (mode(MS)=="numeric"){ - MS<- list(MS) - } - for (I in Looprange(1,length(MS))){ - P<- MS[[I]] - if (InWindow(P)!="i") next - P<- Doscaling(P) - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu=Mojisu+nchar(Str) - if(Mojisu>80){ - cat("\n",file=Wfile,append=TRUE) - Mojisu=0 - } - } - } - Str="%" - if(Iroflg>0){ - Str='}%' - } - if(Mojisu>0){ - Str=paste('\n',Str,'\n',sep="") - }else{ - Fmt=paste(Str,'\n',sep="") - } - cat(Str,file=Wfile,append=TRUE) -} - -# PL<-c() -# for (J in 0:N){ -# PL<- c(PL,P+CL[J+1,]) -# } -# PL<-matrix(PL,nrow=2) -# PL<-t(PL) -# Mojisu<-0 -# for (J in 1:Nrow(PL)){ -# Q<- PL[J,] -# X<- as.character(round(MilliIn*Q[1])) -# Y<- as.character(-round(MilliIn*Q[2])) -# Str<- paste("\\special{pa ",X," ",Y,"}",sep="") -# cat(Str,file=Wfile,append=TRUE) -# Mojisu<- Mojisu+nchar(Str) -# if (Mojisu>80){ -# cat("#\n",file=Wfile,append=TRUE) -# } -# Mojisu=0 -# } -# Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") -# Str2<- "\\special{fp}%\n" -# cat(Str1,file=Wfile,append=TRUE) -# cat(Str2,file=Wfile,append=TRUE) -# } -# } -#} - -###################################### - -Makehasen<- function(Figdata,Sen,Gap,Ptn) -{ - Eps<- 10.0^(-6) - Clist<- MakeCurves(Figdata) - DinM<- Dataindex(Clist) - for (N in Looprange(1,Nrow(DinM))){ - Tmp<- DinM[N,] - Data<- Clist[Tmp[1]:Tmp[2],] - Dtall<- Nrow(Data) - Len<- 0 - Lenlist<- c(0) - for (I in Looprange(2,Dtall)){ - Len<- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist<- c(Lenlist,Len) - } - Lenall<- Lenlist[Dtall] - if (Lenall==0){ - next - } - Kari<- (Sen+Gap)*0.1 - Naga<- Sen*0.1 - Tobi<- Gap*0.1 - if (Norm(Data[1,]-Data[Dtall,])<Eps){ - Nsen<- max(ceiling(Lenall/Kari),3) - SegUnit<- Lenall/Nsen - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit)) - } - else{ - if (Ptn==0){ - Nsen<- max(ceiling((Lenall+Tobi)/Kari),3) - SegUnit<- Lenall*(Sen+Gap)/(Nsen*Sen+(Nsen-1)*Gap) - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(0,(Nsen-1)*SegUnit,by=SegUnit)) - } - else{ - Nsen<- max(ceiling((Lenall+Naga)/Kari),3) - SegUnit<- Lenall*(Sen+Gap)/((Nsen-1)*Sen+Nsen*Gap) - Naga<- SegUnit*Sen/(Sen+Gap) - Tobi<- SegUnit*Gap/(Sen+Gap) - SegList<- c(seq(Tobi,Tobi+(Nsen-2)*SegUnit,by=SegUnit)) - } - } - Hajime<- 1; Owari<- 1 - Mojisu<- 0 - for (I in Looprange(1,length(SegList))){ - Len<- SegList[I] - J<- Owari - while (Len>=Lenlist[J]-Eps){ - if (J==Dtall){ - break - } - J<- J+1 - } - Hajime<- J-1 - J<- Hajime - while (Len+Naga>Lenlist[J]-Eps){ - if (J==Dtall){ - break - } - J<- J+1 - } - Owari<- J-1 - T<- (Len-Lenlist[Hajime]) - T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) - P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - X0=sprintf('%5.5f',P[1]) - Y0=sprintf('%5.5f',P[2]) - Pt0=paste('(',X0,',',Y0,')',sep="") - Str=paste('\\polyline',Pt0,sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - for (J in Looprange(Hajime+1,Owari)){ - P=Data[J,] - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Pt=paste('(',X,',',Y,')',sep="") - Str=Pt - cat(Str,file=Wfile,append=TRUE) - Pt0=Pt - Mojisu=Mojisu+nchar(Str) - } - T<- (Len+Naga-Lenlist[Owari]) - T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) - P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Pt=paste('(',X,',',Y,')',sep="") - Str=Pt - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - cat("%\n%\n",file=Wfile,append=TRUE); -} - -######################################### - -Beginpicture<-function(ul) -{ ## Scaling is implemented - Tmp<- Doscaling(c(XMIN,YMIN)) - Xm<- Tmp[1] - Ym<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - XM<- Tmp[1] - YM<- Tmp[2] - Dx<- XM-Xm - Dy<- YM-Ym - Sym<-".0123456789 +-*/" - SL<-Sym - OL<-"+-*/" - if (ul!=""){ - ULEN<<-ul; - } - Is<-1; - VL<-""; - Ucode<-ULEN - for (I in Looprange(1,nchar(Ucode))){ - C<-substring(Ucode,I,I); - if (length(grep(C,SL,fixed=TRUE))>0){ - if (length(grep(C,OL,fixed=TRUE))>0){ - Tmp<-substring(Ucode,Is,I-1); - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1; - } - } - else{ - Unit<-substring(Ucode,I,I+1); - Str<-substring(Ucode,Is,I-1); - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)); - Str<-as.character(Valu); - ULEN<<- paste(Str,Unit,sep=""); - if (Unit=="cm") MilliIn<<-1000/2.54*Valu - if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if (Unit=="in") MilliIn<<-1000*Valu - if (Unit=="pt") MilliIn<<-1000/72.27*Valu - if (Unit=="pc") MilliIn<<-1000/6.022*Valu - if (Unit=="bp") MilliIn<<-1000/72*Valu - if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; - if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; - Str<-paste("{\\unitlength=",ULEN,"%\n",sep=""); - cat(Str,file=Wfile,append=TRUE); - cat("\\begin{picture}%\n",file=Wfile,append=TRUE); - Str<-"("; - Tmp<-as.character(round(Dx,digits=6)); - Str<-paste(Str,Tmp,",",sep=""); - Tmp<-as.character(round(Dy,digits=6)); - Str<-paste(Str,Tmp,")(",sep=""); - Tmp<-as.character(round(Xm,digits=6)); - Str<-paste(Str,Tmp,",",sep=""); - Tmp<-as.character(round(Ym,digits=6)); - Str<-paste(Str,Tmp,")%\n",sep=""); - cat(Str,file=Wfile,append=TRUE); - Str=paste('\\linethickness{',as.character(PenThickInit/1000),'in}%',sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################################### - -Setpen<-function(Width) -{ - PenThick<<-round(PenThickInit*Width) - Str=paste('\\linethickness{',as.character(PenThick/1000),'in}%',sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################################### - -Shade<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg=0 - if(Nargs>1){ - Iro=varargin[[Nargs]] - if(is.character(Iro)){ - Iroflg=1 - if(length(grep("{",Iro,fixed=TRUE))>0){ - Str=paste("{\\color",Iro,sep="") - } - else{ - Str=paste("{\\color{",Iro,"}",sep="") - } - } - else{ - if(length(Iro)==1){ - Kosa=Iro - } - else{ - Iroflg=1 - if(length(Iro)==4){ - Str="{\\color[cmyk]{" - } - else{ - if(length(Iro)==3){ - Str="{\\color[rgb]{" - } - } - for(J in 1:length(Iro)){ - Str=paste(Str,as.character(Iro[J]),sep="") - if(J<length(Iro)){ - Str=paste(Str,",") - } - } - Str=paste(Str,"}") - } - } - if(Iroflg==1){ - Str=paste(Str,"%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - } - } - Mojisu=0 - Tmp=varargin[[1]] - Data=Kyoukai(Tmp) - for (I in Looprange(1, length(Data))){ - PL<- Op(I,Data) - Mojisu<- 0 - for (J in 1:Nrow(PL)){ - P<- Doscaling(Op(J,PL)) - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Pt=paste('(',X,',',Y,')',sep="") - if(J==1){ - Str=paste('\\polygon*',Pt,sep="") - }else{ - Str=Pt - } - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - if(Iroflg==1){ - Str='}%' - if(Mojisu>0){ - Str=paste('\n',Str,'\n',sep="") - }else{ - Str=paste(Str,'\n') - } - cat(Str,file=Wfile,append=TRUE) - } -} diff --git a/texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max b/texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max deleted file mode 100644 index c70f7f46..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/maximaL/fourier_sec.max +++ /dev/null @@ -1,260 +0,0 @@ -/* -Package fourier_sec, to study piecewise defined functions -(sectionally defined, hence the name). - -Author: Jose A. Vallejo - Faculty of Sciences - Universidad Autonoma de San Luis Potosi (Mexico) - http://galia.fc.uaslp.mx/~jvallejo - -It is assumed that the functions are defined using the format - if ... then ... else ... -as, for example, -(%i1) absolute(x):=if (x<=0) then -x elseif (x>0) then x$ -(it will not work with 'abs'). -It provides three functions: -1. 'paritycheck', to check if a given piecewise defined - function is even or odd (or none). For instance, - (%i2) paritycheck(absolute(x),x); - (%o2) 0 - A '0' means 'even', '1' is 'odd', and '-1' is 'none' -2. 'fourier_sec_coeff', to compute the Fourier sine and cosine - coefficients. The function must have compact support.For - instance, for the unit step we have: - (%i3) h(x):=if (-%pi<=x and x<0) then 0 elseif (0<=x and x<=%pi) then 1$ - (%i4) fourier_sec_coeff(h(x),x); - (%o4) [1/2,0,-((-1)^n-1)/(%pi*n)] -3. 'fourier_sec_series', to compute the Fourier series, truncated - or not. The series for the unit step to the 10th order: - (%i5) fourier_sec_series(h(x),x,10); - (%o5) (2*sin(9*x))/(9*%pi)+(2*sin(7*x))/(7*%pi)+(2*sin(5*x))/(5*%pi)+(2*sin(3*x))/(3*%pi)+(2*sin(x))/%pi+1/2 - and the whole Fourier series - (%i6) fourier_sec_series(h(x),x,inf); - (%o6) (sum(((1/n-(-1)^n/n)*sin(n*x))/%pi,n,1,inf))+1/2 -*/ - - -load(fourie)$ - -load(simplify_sum)$ - -paritycheck(funvar,x):=block([subintervals,subvalues,tmp1,tmp2,token1,token0,tmp3, - subvalues_list,subintervals_list,icentral:0,middle,minusmiddle,token2, - side_subintervals_list,L,side_subvalues_list, - zero_subintervals,tmp4,tmp5,non_zero_side_subvalues_list, - non_zero_side_subintervals_list,LL,token3,expr1,expr2], - local(M,N,P,Q,count1,count2,count3,count4), - subintervals:makelist(part(funvar,i),i,makelist(2*k-1,k,1,(length(funvar)-2)/2)), - subvalues:makelist(part(funvar,i),i,makelist(2*k,k,1,(length(funvar)-2)/2)), - for j:1 thru length(subintervals) do (if operatorp(subintervals[j],["<",">","<=",">="]) then tmp1[j]:1 else tmp1[j]:0), - tmp1:makelist(tmp1[j],j,1,length(subintervals)), - tmp2:sublist_indices(tmp1,lambda([x],x=1)), - - /* if length(tmp2)=0 all the subintervals in the domain of funvar are bounded! */ - - if is(equal(length(tmp2),0)) then - ( - subvalues_list:copylist(subvalues), - tmp3:copylist(subintervals), - for j:1 thru length(tmp3) do - ( - M[j]:makelist(part(tmp3[j],k),k,1,length(tmp3[j])), - for m:1 thru 2 do N[j,m]:makelist(part(M[j],m,n),n,1,length(M[j])), - P[j]:append(N[j,1],N[j,2]),Q[j]:sort(delete(x,P[j]),"<") - ), - subintervals_list:makelist(Q[j],j,1,length(tmp3)), - for i:1 thru length(subintervals_list) do (if is(lmin(subintervals_list[i])*lmax(subintervals_list[i])<0) then icentral:i), - if is(icentral>0) then middle:subvalues_list[icentral], - if is(icentral>0) then - (if evenfunp(middle,x) then token2:0 elseif oddfunp(middle,x) then token2:1 else return(-1)) - else - - /* now we analyze what happens if icentral=0, so there are only side intervals */ - - ( - /* as before, there must be an even number of symmetric intervals, otherwise -1 */ - side_subintervals_list:copylist(subintervals_list), - if not(evenp(length(side_subintervals_list))) then return(-1), - L:length(side_subintervals_list)/2, - for k:1 thru L do count1[k]:charfun(is(equal(side_subintervals_list[k],reverse(map("-",side_subintervals_list[2*L+1-k]))))), - if sum(count1[j],j,1,L)#L then return(-1), - side_subvalues_list:copylist(subvalues_list), - for k:1 thru L do count2[k]:charfun(is(equalp(side_subvalues_list[k],ratsubst(-x,x,side_subvalues_list[2*L+1-k])))), - if is(equal(sum(count2[j],j,1,L),L)) then token3:0, - for k:1 thru L do count3[k]:charfun(is(equalp(side_subvalues_list[k],-ratsubst(-x,x,side_subvalues_list[2*L+1-k])))), - if is(equal(sum(count3[j],j,1,L),L)) then token3:1, - if is(not(equalp(token3,0)) and not(equalp(token3,1))) then return(-1) , - return(token3) - ), - - /* and what happens if icentral#0 */ - - side_subintervals_list:delete(subintervals_list[icentral],subintervals_list), - if is(equal(length(side_subintervals_list),0)) then (if is(equal(token1,token2)) then return(token1*token2) else return(-1)), - if not(evenp(length(side_subintervals_list))) then return(-1), - L:length(side_subintervals_list)/2, - for k:1 thru L do count1[k]:charfun(is(equal(side_subintervals_list[k],reverse(map("-",side_subintervals_list[2*L+1-k]))))), - if sum(count1[j],j,1,L)#L then return(-1), - side_subvalues_list:delete(subvalues_list[icentral],subvalues_list), - - /* remove those subintervals in which funvar vanishes */ - - zero_subintervals:sublist_indices(side_subvalues_list,lambda([x],x=0)), - tmp4:copylist(side_subintervals_list), - for j:1 thru length(zero_subintervals) do - (tmp4:delete(side_subintervals_list[zero_subintervals[j]],tmp4)), - non_zero_side_subintervals_list:tmp4, - tmp5:copylist(side_subvalues_list), - for j:1 thru length(zero_subintervals) do - (tmp5:delete(side_subvalues_list[zero_subintervals[j]],tmp5)), - non_zero_side_subvalues_list:tmp5, - - /* if length(non_zero_side_subintervals_list)=0 then we are done just with token2 */ - - if is(equal(length(non_zero_side_subintervals_list),0)) then return(token2), - - /* otherwise, we must also take into account token3 */ - LL:length(non_zero_side_subintervals_list)/2, - for k:1 thru LL do count2[k]:charfun(is(equalp(non_zero_side_subvalues_list[k],ratsubst(-x,x,non_zero_side_subvalues_list[2*LL+1-k])))), - if is(equal(sum(count2[j],j,1,LL),LL)) then token3:0, - for k:1 thru LL do count3[k]:charfun(is(equalp(non_zero_side_subvalues_list[k],-ratsubst(-x,x,non_zero_side_subvalues_list[2*LL+1-k])))), - if is(equal(sum(count3[j],j,1,LL),LL)) then token3:1, - if is(not(equal(token3,0) or equal(token3,1))) then return(-1) elseif - is(token2#token3) then return(-1) - elseif is(equal(token2,0)) then return(0) - elseif is(equal(token2,1)) then return(1) - - ), - - /* we continue here with unbounded intervals */ - - expr1:subvalues[tmp2[1]], - expr2:ratsubst(-x,x,subvalues[tmp2[2]]), - if is(equalp(expr1,expr2)) then token1:0 - elseif is(equalp(expr1,-expr2)) then token1:1 - else return(-1), - - /* the problem when defining token1 is that if the asymptotic value is 0, then it is always token1:0 */ - /* although the function could be odd. To cope with this, we define token0 below */ - - tmp3:makelist(subintervals[i],i,sublist_indices(tmp1,lambda([x],x=0))), - if is(equal(length(tmp3),0)) then return(token1), - subvalues_list:makelist(subvalues[i],i,sublist_indices(tmp1,lambda([x],x=0))), - token0:if member(0,makelist(subvalues[i],i,tmp2)) then 0 else 7, - for j:1 thru length(tmp3) do - ( - M[j]:makelist(part(tmp3[j],k),k,1,length(tmp3[j])), - for m:1 thru 2 do N[j,m]:makelist(part(M[j],m,n),n,1,length(M[j])), - P[j]:append(N[j,1],N[j,2]),Q[j]:sort(delete(x,P[j]),"<") - ), - subintervals_list:makelist(Q[j],j,1,length(tmp3)), - for i:1 thru length(subintervals_list) do (if is(lmin(subintervals_list[i])*lmax(subintervals_list[i])<0) then icentral:i), - if is(icentral>0) then middle:subvalues_list[icentral], - if is(icentral>0) then - (if evenfunp(middle,x) then token2:0 elseif oddfunp(middle,x) then token2:1 else return(-1)) - else - - /* now we analyze what happens if icentral=0, so there are only non-bounded intervals and side intervals */ - - ( - /* as before, there must be an even number of symmetric intervals, otherwise -1 */ - side_subintervals_list:copylist(subintervals_list), - if not(evenp(length(side_subintervals_list))) then return(-1), - L:length(side_subintervals_list)/2, - for k:1 thru L do count1[k]:charfun(is(equal(side_subintervals_list[k],reverse(map("-",side_subintervals_list[2*L+1-k]))))), - if sum(count1[j],j,1,L)#L then return(-1), - side_subvalues_list:copylist(subvalues_list), - for k:1 thru L do count2[k]:charfun(is(equalp(side_subvalues_list[k],ratsubst(-x,x,side_subvalues_list[2*L+1-k])))), - if is(equal(sum(count2[j],j,1,L),L)) then token3:0, - for k:1 thru L do count3[k]:charfun(is(equalp(side_subvalues_list[k],-ratsubst(-x,x,side_subvalues_list[2*L+1-k])))), - if is(equal(sum(count3[j],j,1,L),L)) then token3:1, - if is(not(equal(token3,0)) and not(equal(token3,1))) then return(-1) elseif - is(not(equal(token1,token3)) and not(equal(token0,0))) then return(-1) - elseif is( equal(token0,0) and equal(token3,0)) then return(0) - elseif is( equal(token0,0) and equal(token3,1)) then return(1) - elseif is(not(equal(token0,0)) and equal(token1,token3)) then return(token3) - elseif is(not(equal(token0,0)) and not(equal(token1,token3))) then return(-1) - ), - - /* and what happens if icentral#0 */ - - side_subintervals_list:delete(subintervals_list[icentral],subintervals_list), - if is(equal(length(side_subintervals_list),0)) then (if is(equal(token1,token2)) then return(token1*token2) else return(-1)), - if not(evenp(length(side_subintervals_list))) then return(-1), - L:length(side_subintervals_list)/2, - for k:1 thru L do count1[k]:charfun(is(equal(side_subintervals_list[k],reverse(map("-",side_subintervals_list[2*L+1-k]))))), - if sum(count1[j],j,1,L)#L then return(-1), - side_subvalues_list:delete(subvalues_list[icentral],subvalues_list), - - /* remove those subintervals in which funvar vanishes */ - - zero_subintervals:sublist_indices(side_subvalues_list,lambda([x],x=0)), - tmp4:copylist(side_subintervals_list), - for j:1 thru length(zero_subintervals) do - (tmp4:delete(side_subintervals_list[zero_subintervals[j]],tmp4)), - non_zero_side_subintervals_list:tmp4, - tmp5:copylist(side_subvalues_list), - for j:1 thru length(zero_subintervals) do - (tmp5:delete(side_subvalues_list[zero_subintervals[j]],tmp5)), - non_zero_side_subvalues_list:tmp5, - - /* if length(non_zero_side_subintervals_list)=0 then we are done just with token1 and token2 */ - - if is(equal(length(non_zero_side_subintervals_list),0)) then (if is(equal(token1,token2)) then return(token1*token2) else return(-1)), - - /* otherwise, we must also take into account token3 */ - LL:length(non_zero_side_subintervals_list)/2, - for k:1 thru LL do count2[k]:charfun(is(equalp(non_zero_side_subvalues_list[k],ratsubst(-x,x,non_zero_side_subvalues_list[2*LL+1-k])))), - if is(equal(sum(count2[j],j,1,LL),LL)) then token3:0, - for k:1 thru LL do count3[k]:charfun(is(equalp(non_zero_side_subvalues_list[k],-ratsubst(-x,x,non_zero_side_subvalues_list[2*LL+1-k])))), - if is(equal(sum(count3[j],j,1,LL),LL)) then token3:1, - if is(not(equal(token0,0)) and is(not(equal(token1,token2)) or not(equal(token1,token3)) or not(equal(token2,token3))) ) then return(-1) - elseif is(not(equal(token0,0)) and is(equal(token1,0)) ) then return(0) - elseif is(not(equal(token0,0)) and is(equal(token1,1)) ) then return(1) - elseif is( equal(token0,0) and equal(token3,0) and equal(token2,0)) then return(0) - elseif is( equal(token0,0) and equal(token3,1) and equal(token2,1)) then return(1) - else return(-1) - -)$ - -fourier_sec_coeff(fuvar,x):= -block([pp,LL,lm,a0,coeff], - local(a,b,n,MM,NN,PP,QQ), - declare(n,integer), - pp:((length(fuvar)/2)-1), - LL:makelist(part(fuvar,i),i,makelist(2*s-1,s,1,pp)), - for j:1 thru length(LL) step 1 do - ( - MM[j]:makelist(part(LL[j],r),r,1,length(LL[j])), - for r:1 thru 2 do NN(j,r):=makelist(part(MM[j],r,k),k,1,length(MM[j])), - PP[j]:append(NN(j,1),NN(j,2)),QQ[j]:delete(x,PP[j]) - ), - for i:1 thru pp step 1 do partsums[i]:sort(QQ[i],"<"), - for i:1 thru pp step 1 do partfunc[i]:part(fuvar,2*i), - lm:lmax(unique(flatten(makelist(QQ[q],q,1,length(LL))))), - a0:(1/(2*lm))*sum(integrate(partfunc[i],x,partsums[i][1],partsums[i][2]),i,1,pp), - if is(equal(paritycheck(fuvar,x),1)) then a(n):=0 else a(n):=(1/lm)*sum(adefint(partfunc[i]*cos(%pi*n*x/lm),x,partsums[i][1],partsums[i][2]),i,1,pp), - if is(equal(paritycheck(fuvar,x),0)) then b(n):=0 else b(n):=(1/lm)*sum(adefint(partfunc[i]*sin(%pi*n*x/lm),x,partsums[i][1],partsums[i][2]),i,1,pp), - coeff:[a0,simplify_sum(a(n)),simplify_sum(b(n))], - factor(ratsimp(coeff)) -)$ - -fourier_sec_series(fuvar,x,u):= -block([pp,LL,lm,a0,coeff], - local(a,b,n,MM,NN,PP,QQ), - declare(n,integer), - pp:((length(fuvar)/2)-1), - LL:makelist(part(fuvar,i),i,makelist(2*s-1,s,1,pp)), - for j:1 thru length(LL) step 1 do - ( - MM[j]:makelist(part(LL[j],r),r,1,length(LL[j])), - for r:1 thru 2 do NN(j,r):=makelist(part(MM[j],r,k),k,1,length(MM[j])), - PP[j]:append(NN(j,1),NN(j,2)),QQ[j]:delete(x,PP[j]) - ), - for i:1 thru pp step 1 do partsums[i]:sort(QQ[i],"<"), - for i:1 thru pp step 1 do partfunc[i]:part(fuvar,2*i), - lm:lmax(unique(flatten(makelist(QQ[q],q,1,length(LL))))), - a0:(1/(2*lm))*sum(integrate(partfunc[i],x,partsums[i][1],partsums[i][2]),i,1,pp), - if is(equal(paritycheck(fuvar,x),1)) then a(n):=0 else a(n):=(1/lm)*sum(adefint(partfunc[i]*cos(%pi*n*x/lm),x,partsums[i][1],partsums[i][2]),i,1,pp), - if is(equal(paritycheck(fuvar,x),0)) then b(n):=0 else b(n):=(1/lm)*sum(adefint(partfunc[i]*sin(%pi*n*x/lm),x,partsums[i][1],partsums[i][2]),i,1,pp), - a0+intosum(sum(a(n)*cos(%pi*n*x/lm),n,1,u))+intosum(sum(b(n)*sin(%pi*n*x/lm),n,1,u)))$
\ No newline at end of file diff --git a/texmf-dist/scripts/ketcindy/ketlib/maximaL/matoperation.max b/texmf-dist/scripts/ketcindy/ketlib/maximaL/matoperation.max deleted file mode 100644 index 512a9ffb..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/maximaL/matoperation.max +++ /dev/null @@ -1,47 +0,0 @@ -/* Maxima tips http://www.cymric.jp/maxima/tips.html */ - -rowmult(X, n, c) := block([M], - M:matrix(), - for i:1 thru length(X) do - if i=n then M:addrow(M, c*row(X, i)) - else M:addrow(M, row(X, i)), - M -); -rowadd(X, n, m, c) := block([M], - M:matrix(), - for i:1 thru length(X) do - if i=n then M:addrow(M, c * row(X, m) + row(X, i)) - else M:addrow(M, row(X, i)), - M -); -rowch(X, m, n) := block([M], - M:matrix(), - for i:1 thru length(X) do - if i=m then M:addrow(M, row(X, n)) - else if i=n then M:addrow(M, row(X, m)) - else M:addrow(M, row(X, i)), - M -); - -colmult(X, n, c) := block([M], - M:matrix(), - for i:1 thru length(transpose(X)) do - if i=n then M:addcol(M, c*col(X, i)) - else M:addcol(M, col(X, i)), - M -); -coladd(X, n, m, c) := block([M], - M:matrix(), - for i:1 thru length(transpose(X)) do - if i=n then M:addcol(M, c * col(X, m) + col(X, i)) - else M:addcol(M, col(X, i)), - M -); -colch(X, m, n) := block([M], - M:matrix(), - for i:1 thru length(transpose(X)) do - if i=m then M:addcol(M, col(X, n)) - else if i=n then M:addcol(M, col(X, m)) - else M:addcol(M, col(X, i)), - M -); diff --git a/texmf-dist/scripts/ketcindy/ketlib/maximaL/poincare.mac b/texmf-dist/scripts/ketcindy/ketlib/maximaL/poincare.mac deleted file mode 100644 index aefab3a2..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/maximaL/poincare.mac +++ /dev/null @@ -1,71 +0,0 @@ -/* Poincare.mac is a set of routines for the computation -of Poincare surfaces of sections of Hamiltonian systems */ - -/* Author: Jose A Vallejo -Universidad Autonoma de San Luis Potosi (Mexico) -josanv@gmail.com */ - -/* To avoid messages when loading draw, execute -with_stdout("/dev/null",load(draw))$ (in Linux) -with_stdout("NUL",load(draw))$ (in Windows) */ - -/* Poincare.mac requires a compiled version of -rkfun.lisp, a LISP implementation of the RK4 -algorithm due to Richard Fateman. The original -code can be downloaded from -https://people.eecs.berkeley.edu/~fateman/lisp/rkfun.lisp */ - -/*load("rkfun.fasl");*/ -/*load("rkfun.lisp");*/ - - -hameqs(H,name):=block( -[vv,t,tvv,n,Q,P,eqq,eqp,eqs], -vv:args(lhs(apply(fundef,[H]))), -tvv:cons(t,vv), -n:length(vv)/2, -Q:makelist(vv[2*j-1],j,1,n), -P:makelist(vv[2*k],k,1,n), -eqq:makelist(float(diff(apply(H,vv),P[j])),j,1,n), -eqp:makelist(float(-diff(apply(H,vv),Q[j])),j,1,n), -eqs:join(eqq,eqp), -for j:1 thru 2*n do define(funmake(concat(name,j),tvv),block([],mode_identity(float,vv),eqs[j])), -apply(compile,makelist(concat(name,j),j,1,2*n)), -[makelist(apply(concat(name,j),tvv),j,1,2*n),vv,makelist(concat(name,j),j,1,2*n)] -)$ - -lextract(ll,n):=block([l,a,b], -l:length(ll), -a:rest(ll,n), -b:rest(ll,n-l-1), -append(b,a) -)$ - -poincare3d(H,name,inicond,timestep,coord):=block( -[heq,vars,tvars,hfuns,c,sol], -heq:hameqs(H,name), -vars:heq[2], -tvars:cons(t,vars), -hfuns:heq[3], -c:first(sublist_indices(vars,lambda([x],x=coord))), -sol:rkfun(hfuns,tvars,float(inicond),timestep), -map(lambda([x],lextract(x,c)),map(lambda([x],rest(x)),sol)) -)$ - -poincare2d(H,name,inicond,timestep,scene):=block( -[heq,vars,tvars,hfuns,solu,c,soluc,sola,solb,subind,sol,e,f], -heq:hameqs(H,name), -vars:heq[2], -tvars:cons(t,vars), -hfuns:heq[3], -solu:rkfun(hfuns,tvars,float(inicond),timestep), -c:first(sublist_indices(vars,lambda([x],x=first(scene)))), -soluc:map(lambda([x],x[c+1]),solu), -sola:rest(soluc,-1)-second(scene), -solb:rest(soluc)-second(scene), -subind:sublist_indices(sola*solb,lambda([x],is(x < 0))), -sol:makelist(solu[k],k,subind), -e:first(sublist_indices(vars,lambda([x],x=third(scene))))+1, -f:first(sublist_indices(vars,lambda([x],x=fourth(scene))))+1, -makelist([j[e],j[f]],j,sol) -)$
\ No newline at end of file diff --git a/texmf-dist/scripts/ketcindy/ketlib/maximaL/rkfun.lisp b/texmf-dist/scripts/ketcindy/ketlib/maximaL/rkfun.lisp deleted file mode 100644 index 70aafc7f..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/maximaL/rkfun.lisp +++ /dev/null @@ -1,99 +0,0 @@ -;; variation on runge-kutta (rk) routine in complex_dynamics.lisp by villate@fe.up.pt -;; this one with changed by fateman@berkeley.edu - -#| rkfun may be much faster than rk because it calls compiled programs. - rkfun (this file) should also be compiled to speed it up. - how to use: - - - first, read and understand the documentation for rk(). - next, define the ODE right hand sides as functions as shown below - -fun1(y,x,x0):= x0$ -fun2(y,x,x0):= block([], mode_declare([y, x0,x],float),(1-x^2)*x0-x); -compile(fun1)$ -compile(fun2)$ -showtime:all$ - -last(rkfun([fun1,fun2],[x,xdot],[0.0,0.6],[t,0,50,0.01])); - -/* which is, in one test, 18 times faster than */ - -last(rk([xdot,(1-x^2)*xdot -x],[x,xdot],[0.0,0.6],[t,0,50,0.01])); - -|# - -(defun $rkfun (funs vars initial domain ;; taken from complex_dynamics.lisp - &aux d u funlist k1 k2 k3 k4 r1 r2 r3 traj r - (it (mapcar #'coerce-float (cddr domain)))) - (unless ($listp funs) (setq funs `((mlist) ,funs))) - (unless ($listp initial) (setq initial `((mlist) ,initial))) - (unless ($listp vars) (setq vars `((mlist) ,vars))) - (dolist (var (cdr vars)) - (unless (symbolp var) - (merror (intl:gettext "rk: variable name expected; found: ~M") var))) - (unless (symbolp (cadr domain)) - (merror (intl:gettext "rk: variable name expected; found: ~M") - (cadr domain))) - (setq vars (append '((mlist)) (list (cadr domain)) (cdr vars))) - (setq r (append `(,(car it)) (mapcar #'coerce-float (cdr initial)))) - (setq funlist (cdr funs)) - - (setq d (/ (- (cadr it) (car it)) (caddr it))) - (setq traj (list (cons '(mlist) r))) - (do ((m 1 (1+ m))) ((> m d)) - (progn ;;; was ignore-errors - (setq k1 (mapcar #'(lambda (x) (apply x r)) funlist)) - (setq r1 (map 'list #'+ (cdr r) (mapcar #'(lambda (x) (* 0.5d0 (caddr it) x)) k1))) - (push (+ (car r) (/ (caddr it) 2)) r1) - (setq k2 (mapcar #'(lambda (x) (apply x r1)) funlist)) - (setq r2 (map 'list #'+ (cdr r) (mapcar #'(lambda (x) (* 0.5d0(caddr it) x)) k2))) - (push (+ (car r) (/ (caddr it) 2)) r2) - (setq k3 (mapcar #'(lambda (x) (apply x r2)) funlist)) - (setq r3 (map 'list #'+ (cdr r) (mapcar #'(lambda (x) (* (caddr it) x)) k3))) - (push (+ (car r) (caddr it)) r3) - (setq k4 (mapcar #'(lambda (x) (apply x r3)) funlist)) - (setq u (map 'list #'+ - (mapcar #'(lambda (x) (* #.(/ 1.0 6.0d0) x)) k1) - (mapcar #'(lambda (x) (* #.(/ 1.0 3.0d0) x)) k2) - (mapcar #'(lambda (x) (* #.(/ 1.0 3.0d0) x)) k3) - (mapcar #'(lambda (x) (* #.(/ 1.0 6.0d0) x)) k4))) - (setq r - (append - `(,(+ (car it) (* m (caddr it)))) - (map 'list #'+ (cdr r) (mapcar #'(lambda (x) (* (caddr it) x)) u)))) - (push (cons '(mlist) r) traj))) - (when (< (car r) (cadr it)) - (let ((s (- (cadr it) (car r))) ) - (declare(double-float s)(special s)(optimize (speed 3)(safety 0))) - (progn ;; was ignore-errors - (setq k1 (mapcar #'(lambda (x) (mapply x r nil)) funlist)) - (setq r1 (map 'list #'+ (cdr r) (mapcar #'(lambda (x) - (declare(double-float x)) - (* s 0.5d0 x)) k1))) - (push (+ (car r) (* 0.5d0 s)) r1) - (setq k2 (mapcar #'(lambda (x) (mapply x r1 nil)) funlist)) - (setq r2 (map 'list #'+ (cdr r) (mapcar #'(lambda (x)(declare(double-float x)) - (* s 0.5d0 x)) k2))) - (push (+ (car r) (* 0.5d0 s)) r2) - (setq k3 (mapcar #'(lambda (x) (mapply x r2 nil)) funlist)) - (setq r3 (map 'list #'+ (cdr r) (mapcar #'(lambda (x)(declare(double-float x)) - (* s x)) k3))) - (push (+ (car r) s) r3) - (setq k4 (mapcar #'(lambda (x) (mapply x r3 nil)) funlist)) - (setq u (map 'list #'+ - (mapcar #'(lambda (x)(declare(double-float x)) - (* #.(/ 1.0d0 6.0d0) x)) k1) - (mapcar #'(lambda (x)(declare(double-float x)) - (* #.(/ 1.0d0 3.0d0) x)) k2) - (mapcar #'(lambda (x) (declare(double-float x)) - (* #.(/ 1.0d0 3.0d0) x)) k3) - (mapcar #'(lambda (x)(declare(double-float x)) - (* #.(/ 1.0d0 6.0d0) x)) k4))) - (setq r - (append - `(,(cadr it)) - (map 'list #'+ (cdr r) (mapcar #'(lambda (x)(declare(double-float x)) - (* s x)) u)))) - (push (cons '(mlist) r) traj)))) - (cons '(mlist) (nreverse traj)))
\ No newline at end of file diff --git a/texmf-dist/scripts/ketcindy/ketlib/oshima/os_muldif.pdf b/texmf-dist/scripts/ketcindy/ketlib/oshima/os_muldif.pdf Binary files differdeleted file mode 100644 index 33864232..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/oshima/os_muldif.pdf +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/ketlib/oshima/os_muldif.rr b/texmf-dist/scripts/ketcindy/ketlib/oshima/os_muldif.rr deleted file mode 100644 index ba7131ab..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/oshima/os_muldif.rr +++ /dev/null @@ -1,19295 +0,0 @@ -/* The latest version will be at ftp://akagi.ms.u-tokyo.ac.jp/pub/math/muldif - scp os_muldif.[dp]* ${USER}@lemon.math.kobe-u.ac.jp:/home/web/OpenXM/Current/doc/other-docs -*/ -#define USEMODULE 1 -/* #undef USEMODULE */ - -/* os_muldif.rr (Library for Risa/Asir) - * Toshio Oshima (Nov. 2007 - Aug. 2017) - * - * For polynomials and differential operators with coefficients - * in rational funtions (See os_muldif.pdf) - * - * "Tab = 4 column" is best - */ - -ord([zz,dz,dy,dx])$ - -#ifdef USEMODULE -module os_md; -static Muldif.rr$ -static TeXEq$ -static TeXLim$ -static DIROUT$ -static DIROUTD$ -static DVIOUTL$ -static DVIOUTA$ -static DVIOUTB$ -static DVIOUTH$ -static DVIOUTF$ -static LCOPT$ -static COLOPT$ -static LPOPT$ -static LFOPT$ -static ErMsg$ -static FLIST$ -static IsYes$ -static XYPrec$ -static XYcm$ -static TikZ$ -static XYLim$ -static Canvas$ -static ID_PLOT$ -static Rand$ -static LQS$ -localf spType2$ -localf erno$ -localf chkfun$ -localf makev$ -localf shortv$ -localf makenewv$ -localf vweyl$ -localf mycat$ -localf mycat0$ -localf fcat$ -localf findin$ -localf countin$ -localf mycoef$ -localf mydiff$ -localf myediff$ -localf m2l$ -localf m2ll$ -localf mydeg$ -localf pfctr$ -localf mymindeg$ -localf m1div$ -localf mulsubst$ -localf cmpsimple$ -localf simplify$ -localf monotos$ -localf minustos$ -localf monototex$ -localf vnext$ -localf ldict$ -localf ndict$ -localf nextsub$ -localf nextpart$ -localf transpart$ -localf trpos$ -localf sprod$ -localf sinv$ -localf slen$ -localf sord$ -localf vprod$ -localf dvangle$ -localf dvprod$ -localf dnorm$ -localf mulseries$ -localf pluspower$ -localf vtozv$ -localf dupmat$ -localf matrtop$ -localf mytrace$ -localf mydet$ -localf mperm$ -localf mtranspose$ -localf mtoupper$ -localf mydet2$ -localf myrank$ -localf meigen$ -localf transm$ -localf vgen$ -localf mmc$ -localf lpgcd$ -localf mdivisor$ -localf mdsimplify$ -localf m2mc$ -localf easierpol$ -localf paracmpl$ -localf mykernel$ -localf myimage$ -localf mymod$ -localf mmod$ -localf ladd$ -localf lchange$ -localf llsize$ -localf llbase$ -localf lsort$ -localf lmax$ -localf lmin$ -localf lgcd$ -localf llcm$ -localf ldev$ -localf lsol$ -localf lnsol$ -localf l2p$ -localf m2v$ -localf lv2m$ -localf m2lv$ -localf s2m$ -localf c2m$ -localf m2diag$ -localf myinv$ -localf madjust$ -localf mpower$ -localf mrot$ -localf texlen$ -localf isdif$ -localf fctrtos$ -localf texlim$ -localf fmult$ -localf radd$ -localf getel$ -localf ptol$ -localf rmul$ -localf mtransbys$ -localf drawopt$ -localf execdraw$ -localf execproc$ -localf myswap$ -localf mysubst$ -localf evals$ -localf myval$ -localf myeval$ -localf mydeval$ -localf myfeval$ -localf myf2eval$ -localf myf3eval$ -localf myfdeval$ -localf myf2deval$ -localf myf3deval$ -localf myexp$ -localf mycos$ -localf mysin$ -localf mytan$ -localf myarg$ -localf myasin$ -localf myacos$ -localf myatan$ -localf mylog$ -localf mypow$ -localf scale$ -localf arg$ -localf sqrt$ -localf gamma$ -localf lngamma$ -localf digamma$ -localf dilog$ -localf zeta$ -localf eta$ -localf jell$ -localf frac$ -localf erfc$ -localf orthpoly$ -localf schurpoly$ -localf fouriers$ -localf todf$ -localf f2df$ -localf df2big$ -localf compdf$ -localf fzero$ -localf fmmx$ -localf flim$ -localf fcont$ -localf fresidue$ -localf mmulbys$ -localf appldo$ -localf appledo$ -localf muldo$ -localf jacobian$ -localf hessian$ -localf wronskian$ -localf adj$ -localf laplace1$ -localf laplace$ -localf mce$ -localf mc$ -localf rede$ -localf ad$ -localf add$ -localf vadd$ -localf addl$ -localf cotr$ -localf rcotr$ -localf muledo$ -localf mulpdo$ -localf transpdosub$ -localf transpdo$ -localf translpdo$ -localf rpdiv$ -localf mygcd$ -localf mylcm$ -localf sftpexp$ -localf applpdo$ -localf tranlpdo$ -localf divdo$ -localf qdo$ -localf sqrtdo$ -localf ghg$ -localf ev4s$ -localf b2e$ -localf sftpow$ -localf sftpowext$ -localf polinsft$ -localf pol2sft$ -localf polroots$ -localf fctri$ -localf binom$ -localf expower$ -localf seriesHG$ -localf seriesMc$ -localf seriesTaylor$ -localf evalred$ -localf toeul$ -localf fromeul$ -localf sftexp$ -localf fractrans$ -localf soldif$ -localf chkexp$ -localf sqrtrat$ -localf getroot$ -localf expat$ -localf polbyroot$ -localf polbyvalue$ -localf pcoef$ -localf prehombf$ -localf prehombfold$ -localf sub3e$ -localf fuchs3e$ -localf okubo3e$ -localf eosub$ -localf even4e$ -localf odd5e$ -localf extra6e$ -localf rigid211$ -localf solpokuboe$ -localf stoe$ -localf dform$ -localf polinvsym$ -localf polinsym$ -localf tohomog$ -localf substblock$ -localf okuboetos$ -localf heun$ -localf fspt$ -localf abs$ -localf sgn$ -localf calc$ -localf isint$ -localf israt$ -localf iscrat$ -localf isalpha$ -localf isnum$ -localf isalphanum$ -localf isdecimal$ -localf isvar$ -localf isyes$ -localf isall$ -localf iscoef$ -localf iscombox$ -localf sproot$ -localf spgen$ -localf chkspt$ -localf cterm$ -localf terms$ -localf polcut$ -localf redgrs$ -localf cutgrs$ -localf mcgrs$ -localf mc2grs$ -localf mcmgrs$ -localf anal2sp$ -localf delopt$ -localf str_char$ -localf str_pair$ -localf str_cut$ -localf str_str$ -localf str_subst$ -localf str_times$ -localf str_tb$ -localf strip$ -localf i2hex$ -localf sjis2jis$ -localf jis2sjis$ -localf s2os$ -localf l2os$ -localf r2os$ -localf s2euc$ -localf s2sjis$ -localf r2ma$ -localf evalma$ -localf ssubgrs$ -localf verb_tex_form$ -localf tex_cuteq$ -localf my_tex_form$ -localf texket$ -localf smallmattex$ -localf divmattex$ -localf dviout0$ -localf myhelp$ -localf isMs$ -localf showbyshell$ -localf readcsv$ -localf tocsv$ -localf getbyshell$ -localf show$ -localf dviout$ -localf rtotex$ -localf mtotex$ -localf ltotex$ -localf texbegin$ -localf texcr$ -localf texsp$ -localf getbygrs$ -localf mcop$ -localf shiftop$ -localf conf1sp$ -localf pgen$ -localf diagm$ -localf mgen$ -localf madj$ -localf newbmat$ -localf unim$ -localf pfrac$ -localf cfrac$ -localf cfrac2n$ -localf sqrt2rat$ -localf s2sp$ -localf sp2grs$ -localf fimag$ -localf trig2exp$ -localf intpoly$ -localf integrate$ -localf simplog$ -localf fshorter$ -localf isshortneg$ -localf intrat$ -localf powsum$ -localf bernoulli$ -localf lft01$ -localf linfrac01$ -localf nthmodp$ -localf issquaremodp$ -localf rootmodp$ -localf rabin$ -localf primroot$ -localf varargs$ -localf ptype$ -localf pfargs$ -localf average$ -localf sint$ -localf frac2n$ -localf xyproc$ -localf xypos$ -localf xyput$ -localf xybox$ -localf xyline$ -localf xylines$ -localf xycirc$ -localf xybezier$ -localf lbezier$ -localf draw_bezier$ -localf tobezier$ -localf velbezier$ -localf ptbezier$ -localf cutf$ -localf fsum$ -localf fint$ -localf periodicf$ -localf cmpf$ -localf areabezier$ -localf saveproc$ -localf xygraph$ -localf xy2graph$ -localf addIL$ -localf xy2curve$ -localf xygrid$ -localf xyarrow$ -localf xyarrows$ -localf xyang$ -localf xyoval$ -localf ptcommon$ -localf ptcopy$ -localf ptaffine$ -localf ptlattice$ -localf ptpolygon$ -localf ptwindow$ -localf ptbbox$ -localf lninbox$ -localf ptcombezier$ -localf ptcombz$ -localf lchange$ -localf init$ -localf powprimroot$ -localf distpoint$ -localf ntable$ -localf keyin$ -localf mqsub$ -localf msort$ -#else -extern Muldif.rr$ -extern TeXEq$ -extern TeXLim$ -extern DIROUT$ -extern DIROUTD$ -extern DVIOUTL$ -extern DVIOUTA$ -extern DVIOUTB$ -extern DVIOUTH$ -extern DVIOUTF$ -static LCOPT$ -static COLOPT$ -static LPOPT$ -static LFOPT$ -extern TikZ$ -extern ErMsg$ -extern FLIST$ -extern IsYes$ -extern XYPrec$ -extern XYcm$ -extern TikZ$ -extern XYLim$ -extern Canvas$ -extern ID_PLOT$ -extern Rand$ -extern LQS$ -#endif -static S_Fc,S_Dc,S_Ic,S_Ec,S_EC,S_Lc$ -static S_FDot$ -extern AMSTeX$ -Muldif.rr="00170825"$ -AMSTeX=1$ -TeXEq=5$ -TeXLim=80$ -TikZ=0$ -XYcm=0$ -XYPrec=3$ -XYLim=4$ -Rand=0$ -DIROUT="%HOME%\\tex"$ -DVIOUTL="%ASIRROOT%\\bin\\risatex0.bat"$ -DVIOUTA="%ASIRROOT%\\bin\\risatex.bat"$ -DVIOUTB="%ASIRROOT%\\bin\\risatex1%TikZ%.bat"$ -DVIOUTH="start dviout -2 -hyper=0x90 \"%ASIRROOT%\\help\\os_muldif.dvi\" #%LABEL%"$ -DVIOUTF=0$ -LCOPT=["red","green","blue","yellow","cyan","magenta","black","white","gray"]$ -COLOPT=[0xff,0xff00,0xff0000,0xffff,0xffff00,0xff00ff,0,0xffffff,0xc0c0c0]$ -LPOPT=["above","below","left","right"]$ -LFOPT=["very thin","thin","dotted","dashed"]$ -Canvas=[400,400]$ -LQS=[[1,0]]$ - -ErMsg = newvect(3,[ - "irregal argument", /* 0 */ - "too big size", /* 1 */ - "irregal option" /* 2 */ -])$ -FLIST=0$ -IsYes=[]$ -ID_PLOT=-1$ - -def erno(N) -{ - /* extern ErMsg; */ - print(ErMsg[N]); -} - -def chkfun(Fu, Fi) -{ - /* extern FLIST; */ - /* extern Muldif.rr; */ - - if(type(Fu) <= 1){ - if(Fu==1) - mycat(["Loaded os_muldif Ver.", Muldif.rr, "(Toshio Oshima)"]); - else - mycat(["Risa/Asir Ver.", version()]); - return 1; - } - if(type(FLIST) < 4) - FLIST = flist(); - if(type(Fu) == 4){ - for(; Fu != [] ;Fu = cdr(Fu)) - if(chkfun(car(Fu),Fi) == 0) return 0; - return 1; - } - if(findin(Fu, FLIST) >= 0) - return 1; - FLIST = flist(); - if(findin(Fu, FLIST) >= 0) - return 1; - if(type(Fi)==7){ - mycat0(["load(\"", Fi,"\") -> try again!\n"],1); - load(Fi); - } - return 0; -/* - if(type(Fi) == 7) - Fi = [Fi]; - for( ; Fi != []; Fi = cdr(Fi)) - load(car(Fi)); - FLIST = flist(); - return (findin(Fu,FLIST)>=0)?1:0; -*/ -} - -def makev(L) -{ - S = ""; - Num=getopt(num); - while(length(L) > 0){ - VL = car(L); L = cdr(L); - if(type(VL) == 7) - S = S+VL; - else if(type(VL) == 2 || VL < 10) - S = S+rtostr(VL); - else if(VL<46 && Num!=1) - S = S+asciitostr([VL+87]); - else - S = S+rtostr(VL); - } - return strtov(S); -} - -def makenewv(L) -{ - if((V=getopt(var))<2) V="z_"; - else if(isvar(V)) V=rtostr(V); - if(type(N=getopt(num))!=1) N=0; - Var=varargs(L|all=2); - for(XX=[],I=J=0;;I++){ - X=strtov(V+rtostr(I)); - if(findin(X,Var)<0){ - XX=cons(X,XX); - if(++J>N) return X; - else if(J==N) return reverse(XX); - } - } -} - -def shortv(P,L) -{ - V=vars(P); - if(type(T=getopt(top))==2) T=strtoascii(rtostr(T))[0]-87; - else T=10; - for(;L!=[];L=cdr(L)){ - for(J=0;J<36;J++){ - if(findin(X=makev([car(L),J]|num=1),V)>=0){ - while(findin(Y=makev([T]),V)>=0) T++; - if(T>35) return P; - P=subst(P,X,Y); - T++; - }else if(J>0) break; - } - } - return P; -} - -def vweyl(L) -{ - if(type(L) == 4){ - if(length(L) == 2) - return L; - else - return [L[0],makev(["d",L[0]])]; - } - /* else if(type(L)<2) return L; */ - return [L,makev(["d", L])]; -} - -def mycat(L) -{ - if(type(L) != 4){ - print(L); - return; - } - Opt = getopt(delim); - Del = (type(Opt) >= 0)?Opt:" "; - Opt = getopt(cr); - CR = (type(Opt) >= 0)?0:1; - while(L != []){ - if(Do==1) - print(Del,0); - print(car(L),0); - L=cdr(L); - Do = 1; - } - if(CR) print(""); -} - -def fcat(S,X) -{ - if(type(S)!=7){ - if(type(DIROUTD)!=7){ - DIROUTD=str_subst(DIROUT,["%HOME%","%ASIRROOT%","\\"], - [getenv("HOME"),get_rootdir(),"/"])+"/"; - if(isMs()) DIROUTD=str_subst(DIROUTD,"/","\\"|sjis=1); - } - if(S==-1) return; - T="fcat"; - if(S>=2&&S<=9) T+=rtostr(S); - T=DIROUTD+T+".txt"; - if(S==-1) return T; - if(S!=0&&access(T)) remove_file(T); - S=T; - } - R=output(S); - print(X); - output(); - if(getopt(exe)==1) shell("\""+S+"\""); - return R; -} - -def mycat0(L,T) -{ - Opt = getopt(delim); - Del = (type(Opt) >= 0)?Opt:""; - if(type(L)!=4) L=[L]; - while(L != []){ - if(Do==1) - print(Del,0); - print(car(L),0); - L=cdr(L); - Do = 1; - } - if(T) print(""); -} - -def findin(M,L) -{ - if(type(L)==4){ - for(I = 0; L != []; L = cdr(L), I++) - if(car(L) == M) return I; - }else if(type(L)==5){ - K=length(L); - for(I = 0; I < K; I++) - if(L[I] == M) return I; - }else return -2; - return -1; -} - -def countin(S,M,L) -{ - Step=getopt(step); - if(type(Step)==1){ - N=(Step>0)?Step:-Step; - if(type(L)==5) L=vtol(L); - L=qsort(L); - while(car(L)<S&&L!=[]) L=cdr(L); - S+=M; - for(R=[],C=I=0;L!=[];){ - if(car(L)<S||(Step>0&&car(L)==S)){ - C++; - L=cdr(L); - }else{ - R=cons(C,R);C=0;S+=M; - if(N>1&&++I>=N) break; - } - } - if(C>0) R=cons(C,R); - if(N>1&&(N-=length(R))>0) while(N-->0) R=cons(0,R); - return reverse(R); - } - if(type(L)==4){ - for(N=0; L!=[]; L=cdr(L)) - if(car(L)>=S && car(L)<=M) N++; - }else if(type(L)==5){ - K=length(L); - for(I = 0; I < K; I++) - if(L[I]>=S && L[I]<=M) N++; - }else return -2; - return N; -} - -def mycoef(P,N,X) -{ - if(type(P)<3 && type(N)<3) - return coef(P,N,X); - if(type(P) >= 4) -#ifdef USEMODULE - return map(os_md.mycoef,P,N,X); -#else - return map(mycoef,P,N,X); -#endif - if(type(N)==4){ - for(;N!=[];N=cdr(N),X=cdr(X)) - P=mycoef(P,car(N),car(X)); - return P; - } - if(deg(dn(P), X) > 0){ - P = red(P); - if(deg(dn(P), X) > 0) - return 0; - } - return red(coef(nm(P),N,X)/dn(P)); -} - -def mydiff(P,X) -{ - if(X == 0) - return 0; - if(type(P)<3 && type(X)<3) - return diff(P,X); - if(type(P) >= 4) -#ifdef USEMODULE - return map(os_md.mydiff,P,X); -#else - return map(mydiff,P,X); -#endif - if(type(X)==4){ - for(;X!=[];X=cdr(X)) P=mydiff(P,car(X)); - return P; - } - if(ptype(dn(P),X)<2) - return red(diff(nm(P),X)/dn(P)); - return red(diff(P,X)); -} - -def myediff(P,X) -{ - if(X == 0) - return 0; - if(type(P) < 3) - return ediff(P,X); - if(type(P) >= 4) -#ifdef USEMODULE - return map(os_md.myediff,P,X); -#else - return map(myediff,P,X); -#endif - if(deg(dn(P),X) == 0) - return red(ediff(nm(P),X)/dn(P)); - return red(X*diff(P,X)); -} - -def m2l(M) -{ - if(type(M) < 4) - return [M]; - if(type(M) == 4){ - if(type(car(M))==4 && getopt(flat)==1){ - for(MM = []; M!=[]; M=cdr(M)) - MM = append(MM,car(M)); - return MM; - } - return M; - } - if(type(M) == 5) - return vtol(M); - S = size(M); - for(MM = [], I = S[0]-1; I >= 0; I--) - MM = append(vtol(M[I]), MM); - return MM; -} - -def mydeg(P,X) -{ - if(type(P) < 3) - return deg(P,X); - II = -1; - Opt = getopt(opt); - if(type(P) >= 4){ - S=(type(P) == 6)?size(P)[0]:0; - P = m2l(P); - for(I = 0, Deg = -3; P != []; P = cdr(P), I++){ - if( (DT = mydeg(car(P),X)) == -2) - return -2; - if(DT > Deg){ - Deg = DT; - II = I; - } - } - return (Opt==1)?([Deg,(S==0)?II:[idiv(II,S),irem(II,S)]]):Deg; - } - P = red(P); - if(deg(dn(P),X) == 0) - return deg(nm(P),X); - return -2; -} - -def pfctr(P,X) -{ - P=red(P); - if((T=ptype(P,X))>3) return []; - if(T==3){ - G=pfctr(dn(P),X); - F=pfctr(nm(P),X); - R=[[car(F)[0]/car(G)[0],1]]; - for(F=cdr(F);F!=[];F=cdr(F)) R=cons(car(F),R); - for(G=cdr(G);G!=[];G=cdr(G)) R=cons([car(G)[0],-car(G)[1]],R); - return reverse(R); - } - F=fctr(nm(P)); - for(R=[],C=1/dn(P);F!=[];F=cdr(F)) - if(mydeg(car(F)[0],X)>0) R=cons(car(F),R); - else C*=car(F)[0]^car(F)[1]; - return cons([C,1],reverse(R)); -} - -def mymindeg(P,X) -{ - if(type(P) < 3) - return mindeg(P,X); - II = -1;T=60; - Opt = getopt(opt); - if(type(P) >= 4){ - S=(type(P) == 6)?size(P)[0]:0; - P = m2l(P); - for(I = 0, Deg = -3; P != []; P = cdr(P), I++){ - if(car(P) == 0) - continue; - if( (DT = mydeg(car(P),X)) == -2) - return -2; - if(DT < Deg || Deg == -3){ - if(DT==0){ - if(type(car(P))>=T) continue; - T=type(car(P)); - } - Deg = DT; - II = I; - } - } - return (Opt==1)?([Deg,(S==0)?II:[idiv(II,S),irem(II,S)]]):Deg; - } - P = red(P); - if(deg(dn(P),X) == 0) - return mindeg(nm(P),X); - return -2; -} - -def m1div(M,N,L) -{ - L = (type(L) <= 3)?[0,L]:vweyl[L]; - DX = L[1]; X = L[0]; - if(mydeg(N,DX) != 0) - return 0; - DD = mydeg(M,DX); - MM = M; - while( (Deg=mydeg(MM,DX)) > 0){ - MC = mycoef(MM,Deg,DX)*DX^(Deg-1); - MS = radd(MC, MS); - MM = radd(MM, muldo(MC,radd(-DX,N),L)); - } - return [MM, MS]; -} - - -def mulsubst(F,L) -{ - N = length(L); - if(N == 0) - return F; - if(type(L[0])!=4) L=[L]; - if(getopt(inv)==1){ - for(R=[];L!=[];L=cdr(L)) R=cons([car(L)[1],car(L)[0]],R); - L=reverse(R); - } - if(length(L)==1) return mysubst(F,L); - L1 = newvect(N); - for(J = 0; J < N ; J++) - L1[J] = uc(); - L2 = newvect(N); - for(J = 0; J < N; J++){ - S = L[J][1]; - for(I = 0; I < N; I++) - S = mysubst(S,[L[I][0],L1[I]]); - L2[J] = S; - } - for(J = 0; J < N; J++) - F = mysubst(F, [L[J][0],L2[J]]); - for(J = 0; J < N; J++) - F = mysubst(F, [L1[J],L[J][0]]); - return F; -} - -def cmpsimple(P,Q) -{ - T = getopt(comp); - if(P == Q) - return 0; - D = 0; - if(type(T) < 0) - T = 7; - if(iand(T,1)) - D = length(vars(P)) - length(vars(Q)); - if(!D && iand(T,2)) - D = nmono(P) - nmono(Q); - if(!D && iand(T,4)) - D = str_len(rtostr(P)) - str_len(rtostr(Q)); - if(!D){ - if(P > Q) D++; - else D--; - } - return D; -} - -def simplify(P,L,T) -{ - if(type(P) > 3) -#ifdef USEMODULE - return map(os_md.simplify,P,L,T); -#else - return map(simplify,P,L,T); -#endif - if(type(L[0]) == 4){ - if(length(L[0]) > 1) -#if USEMODULE - return fmult(os_md.simplify,P,L,[T]); -#else - return fmult(simplify,P,L,[T]); -#endif - L = L[0]; - } - if(type(Var=getopt(var)) == 4 && Var!=[]){ - if(type(P) == 3) - return simplify(nm(P),P,L,T|var=Var)/simplify(dn(P),P,L,T|var=Var); - V = car(Var); - if((I = mydeg(P,V)) > 0){ - Var = cdr(Var); - for(Q=0; I>=0 ; I--) - Q += simplify(mycoef(P,I,V), L, T|var=Var)*V^I; - return Q; - } - } - if(length(L) == 1){ - L = car(L); - for(V = vars(L); V != []; V = cdr(V)){ - VT = car(V); - if(deg(L,VT) != 1) continue; - P = simplify(P, [VT, -red(coef(L,0,VT)/coef(L,1,VT))], T); - } - return P; - } - Q = mysubst(P,[L[0],L[1]]); - return (cmpsimple(P,Q|comp=T) <= 0)?P:Q; -} - -def monotos(P) -{ - if(nmono(P) <= 1) - return rtostr(P); - return "("+rtostr(P)+")"; -} - - -def monototex(P) -{ - Q=my_tex_form(P); - if(nmono(P)<2 && (getopt(minus)!=1 || str_str(Q,"-"|top=0,end=0)<0)) - return Q; - return "("+Q+")"; -} - -def minustos(S) -{ - if(str_str(S,"-"|top=0,end=0)<0) return S; - return "("+S+")"; -} - -def vnext(V) -{ - S = length(V); - for(I = S-1; I > 0; I--){ - if(V[I-1] < V[I]){ - V0 = V[I-1]; - for(J = I+1; J < S; J++) - if(V0 >= V[J]) break; - V[I-1] = V[--J]; - V[J] = V0; - for(J = S-1; I < J; I++, J--){ - V0 = V[I]; - V[I] = V[J]; - V[J] = V0; - } - return 1; - } - } - return 0; -} - -def ldict(N, M) -{ - Opt = getopt(opt); - R = S = []; - for(I = 2; N > 0; I++){ - R = cons(irem(N,I), R); - N = idiv(N,I); - } - L = LL = length(R); - T=newvect(LL+1); - while(L-- > 0){ - V = car(R); R = cdr(R); - for(I = J = 0; J <= V ; I++){ - if(T[I] == 0) - J++; - } - T[I-1] = 1; - S = cons(LL-I+1, S); - } - for(I = 0; I <= LL; I++){ - if(T[I] == 0){ - S = cons(LL-I, S); - break; - } - } - if(M == 0) - return S; - if(M <= LL){ - print("too small size"); - return 0; - } - T = []; - for(I = --M; I > LL; I--) - T = cons(I,T); - S = append(S,T); - if(Opt == 2 || Opt == 3) - S = reverse(S); - if(Opt != 1 && Opt != 3) - return S; - for(T = []; S != []; S = cdr(S)) - T = cons(M-car(S),T); - return T; -} - -def ndict(L) -{ - Opt = getopt(opt); - R = []; - if(Opt != 1 && Opt != 2) - L = reverse(L); - T = (Opt == 1 || Opt == 3)?1:0; - for( ; L != []; L = cdr(L)){ - for(I = 0, V = car(L), LT = cdr(L); LT != []; LT = cdr(LT)) - if(T == 0){ - if(V < car(LT)) I++; - }else if (V > car(LT)) I++; - R = cons(I, R); - } - R = reverse(R); - for(V = 0, I = length(R); I > 0; R = cdr(R), I--) - V = V*I + car(R); - return V; -} - -def nextsub(L,N) -{ - if(type(L) == 1){ - for(LL = [], I = L-1; I >= 0; I--) - LL = cons(I,LL); - return LL; - } - M = length(L = ltov(L)); - K = N-M; - for(I = M-1; I >= 0; I--) - if(L[I] < I+K) break; - if(I < 0) - return 0; - for(J = L[I]+1; I < M; I++, J++) - L[I] = J; - return vtol(L); -} - -def nextpart(L) -{ - if(car(L) <= 1) - return 0; - for(I = 0, L = reverse(L); car(L) == 1; L=cdr(L)) - I++; - I += (K = car(L)); - R = irem(I,--K); - R = (R==0)?[]:[R]; - for(J = idiv(I,K); J > 0; J--) - R = cons(K,R); - L = cdr(L); - while(L!=[]){ - R = cons(car(L), R); - L = cdr(L); - } - return R; -} - -def transpart(L) -{ - L = reverse(L); - for(I=1, R=[]; L!= []; I++){ - R = cons(length(L), R); - while(L != [] && car(L) <= I) - L = cdr(L); - } - return reverse(R); -} - -def trpos(A,B,N) -{ - S = newvect(N); - for(I = 0; I < N; I++) - S[I]=(I==A)?B:((I==B)?A:I); - return S; -} - -def sprod(S,T) -{ - L = length(S); - V = newvect(L); - while(--L >= 0) - V[L] = S[T[L]]; - return V; -} - -def sinv(S) -{ - L = length(S); - V = newvect(L); - while(--L >= 0) - V[S[L]] = L; - return V; -} - -def slen(S) -{ - L = length(S); - for(V = 0, J = 2; J < L; i++){ - for(I = 0; I < J; I++) - if(S[I] > S[J]) V++; - } - return V; -} - -def sord(W,V) -{ - L = length(W); - W0 = nevect(L); - V0 = newvect(L); - for(I = F = C = 0; I < L; I++){ - C = 0; - if( (W1 = W[I]) > (V1 = V[I]) ){ - if(F < 0) C = 1; - else if(F==0) F = 1; - }else if(W1 < V1){ - if(F > 0) C = 1; - else if(F==0) F = -1; - } - for(J = I;--J >= 0 && W0[J] > W1; ) W0[J+1] = W0[J]; - W0[J+1] = W1; - for(J = I;--J >= 0 && V0[J] > V1; ) V0[J+1] = V0[J]; - V0[J+1] = V1; - if(C){ - for(J = I; J >= 0; J--){ - if((W1=W0[J]) == (V1=V0[J])) continue; - if(W1 > V1){ - if(F < 0) return 2; - } - else if(F > 0) return 2; - } - } - } - return F; -} - -def vprod(V1,V2) -{ - for(R = 0, I = length(V1)-1; I >= 0; I--) - R = radd(R, rmul(V1[I], V2[I])); - return R; -} - -def dnorm(V) -{ - if(type(V)<2) return dabs(V); - R=0; - if(type(V)!=4) - for (I = length(V)-1; I >= 0; I--) R+= V[I]^2; - else{ - if(type(V[0])>3){ - V=ltov(V[0])-ltov(V[1]); - return dnorm(V); - } - for(;V!=[]; V=cdr(V)) R+=car(V)^2; - } - return dsqrt(R); -} - -def dvprod(V1,V2) -{ - if(type(V1)<2) return V1*V2; - R=0; - if(type(V1)!=4) - for(I = length(V1)-1; I >= 0; I--) - R += V1[I]*V2[I]; - else{ - for(; V1!=[]; V1=cdr(V1),V2=cdr(V2)) - R+=car(V1)*car(V2); - } - return R; -} - -def dvangle(V1,V2) -{ - if(V2==0 && type(V1)==4 && length(V1)==3 && - (type(V1[0])==4 || type(V1[0])==5 || type(V1[1])==4 || type(V1[1])==5 || - type(V1[2])==4 || type(V1[2])==5) ){ - if(V1[0]==0 || V1[1]==0 || V1[2]==0) return 1; - PV2=V1[1]; - if(type(PV2)==4){ - PV2=ltov(PV2); - return dvangle(PV2-ltov(V1[0]),ltov(V1[2])-PV2); - }else - return dvangle(PV2-V1[0],V1[2]-PV2); - } - if((L1=dnorm(V1))==0 || (L2=dnorm(V2))==0) return 1; - return dvprod(V1,V2)/(L1*L2); -} - -def mulseries(V1,V2) -{ - L = length(V1); - if(size(V2) < L) - L = size(V2); - VV = newvect(L); - for(J = 0; J < L; J++){ - for(K = R = 0; K <= J; K++) - R = radd(R,rmul(V1[K],V2[J-K])); - VV[J] = R; - } - return VV; -} - -def scale(L) -{ - T=0;LS=1; - Pr=getopt(prec); - if(type(L)!=4){ - if(L==2){ - L=(Pr!=1)? - [[[1,2,1/20],[2,5,1/10],[5,10,1/5], [10,20,1/2],[20,50,1],[50,100,2]], - [[1,2,1/10],[2,5,1/2], [10,20,1],[20,50,5]], - [[1,2,1/2],[2,10,1], [10,20,5],[20,100,10]]]: - [[[1,2,1/50],[2,5,1/20],[5,10,1/10], [10,20,1/5],[20,50,1/2],[50,100,1]], - [[1,5,1/10],[5,10,1/2], [10,20,1],[50,100,5]], - [[1,5,1/2],[5,10,1], [10,50,5],[50,100,10]]]; - LS=2; - }else if(L==3){ - L=(Pr!=1)? - [[[1,2,1/20],[2,5,1/10],[5,10,1/5], [10,20,1/2],[20,50,1],[50,100,2], - [100,200,5],[200,500,10],[500,1000,20]], - [[1,2,1/10],[2,5,1/2], [10,20,1],[20,50,5], [100,200,10],[200,500,50]], - [[1,2,1/2],[2,10,1], [10,20,5],[20,100,10], [100,200,50],[200,1000,100]]]: - [[[1,2,1/50],[2,5,1/20],[5,10,1/10],[10,20,1/5],[20,50,1/2],[50,100,1], - [100,200,2],[200,500,5],[500,1000,10]], - [[1,5,1/10],[5,10,1/2], [10,50,1],[50,100,5], [100,500,10],[500,1000,50]], - [[1,5,1/2],[5,10,1], [10,50,5],[50,100,10], [100,500,50],[500,1000,100]]]; - LS=3; - }else{ - L=(Pr!=1)? - [[[1,2,1/50],[2,5,1/20],[5,10,1/10]], - [[1,5,1/10],[5,10,1/2]], - [[1,5,1/2],[5,10,1]]]: - [[[1,2,1/100],[2,5,1/50],[5,10,1/20]], - [[1,2,1/20],[2,10,1/10]], - [[1,2,1/10],[2,10,1/2]]]; - } - }else if(type(L[0])!=4){ - L=[L]; - if(length(L)!=3||L[0]+L[2]>L[1]) T=L; - } - if(T==0){ - if(type(L[0][0])!=4) L=[L]; - for(R=[];L!=[];L=cdr(L)){ - for(RR=[],LT=car(L);LT!=[];LT=cdr(LT)) - for(I=car(LT)[0];I<=car(LT)[1];I+=car(LT)[2]) RR=cons(I,RR); - RR=lsort(RR,[],1); - R=cons(RR,R); - } - R=reverse(R); - for(T=[];R!=[];R=cdr(R)){ - if(length(R)>1) T=cons(lsort(R[0],R[1],"setminus"),T); - else T=cons(R[0],T); - } - } - V0=dlog(10); - S0=S1=1;D0=D1=0; - SC=getopt(scale); - if(type(SC)==4){ - S0=SC[0];S1=SC[1]; - }else if(type(SC)==1){ - S0=SC;S1=0; - }else return T; - if(type(D=getopt(shift))==4){ - D0=D[0];D1=D[1]; - } - if(type(F=getopt(f))>1) F=f2df(F); - else F=0; - for(M=M0=[],I=length(T);T!=[];T=cdr(T),I--){ - for(S=car(T);S!=[];S=cdr(S)){ - V=((!F)?dlog(car(S))/dlog(10)/LS:myfdeval(F,car(S)))*S0; - if(S1!=0){ - M=cons([V+D0,D1],M); - M=cons([V+D0,I*((length(SC)>2)?SC[I]:S1)+D1],M); - M=cons(0,M); - }else M0=cons(V+D0,M0); - } - if(S1==0) M=cons(reverse(M0),M); - } - if(S1!=0) M=cdr(M); - if(S1==0||getopt(TeX)!=1) return M; - M=reverse(M); - if(type(U=getopt(line))==4) - M=cons([U[0]+D0,D1],cons([U[1]+D0,D1],cons(0,M))); - if(type(Col=getopt(col))<1) S=xylines(M); - else S=xylines(M|opt=Col); - if(type(Mes=getopt(mes))==4){ - S3=car(Mes); - if(type(S3)==4){ - Col=S3[1]; - S3=car(S3); - }else Col=0; - V=car(scale(cdr(Mes))); - if(!F) Mes=scale(cdr(Mes)|scale=[S0/LS,0],shift=[D0,D1]); - else Mes=scale(cdr(Mes)|f=F,scale=[S0,0],shift=[D0,D1]); - for(M=car(Mes);M!=[];M=cdr(M),V=cdr(V)){ - VT=deval(car(V)); - if(Col!=0) VT=[Col,VT]; - S+=xyput([car(M),S3,VT]); - } - } - return S; -} - -def pluspower(P,V,N,M) -{ - RR = 1; - for(K = R = 1; K < M-1; I++){ - R = R*(N-K+1)*P/K; - RR = radd(RR,R); - } - VV = newvect(M); - for(K = 0; K < M-1; K++) - VV[K] = red(mycoef(RR,K,V)); -} - -def vtozv(V) -{ - if(type(V)<4) V=newvect(1,[V]); - S = length(V); - VV = newvect(S); - Lcm = 1; - for(K = 0; K < S; K++){ - VV[K] = red(V[K]); - Lcm = lcm(Lcm,dn(VV[K])); - C = ptozp(nm(VV[K])|factor=0); - if(K == 0){ - Dn = dn(C[1]); - Nm = nm(C[1]); - PNm = nm(C[0]); - }else{ - Dn = ilcm(Dn,dn(C[1])); - Nm = igcd(Nm,nm(C[1])); - PNm = gcd(PNm,nm(C[0])); - } - } - if(!(M=Nm*PNm)) return [VV,0]; - Mul = (Lcm*Dn)/M; - for(K = 0; K < S; K++) - VV[K] = rmul(VV[K],Mul); - return [VV,Mul]; -} - -def dupmat(M) -{ - if(type(M) == 6){ - Size = size(M); - MM = newmat(Size[0],Size[1]); - for(I = 0; I < Size[0]; I++){ - for(J = 0; J < Size[1]; J++) - MM[I][J] = M[I][J]; - } - return MM; - } - if(type(M) == 5) - return ltov(vtol(M)); - return M; -} - -def matrtop(M) -{ - S = size(M); - MM = dupmat(M); - Lcm = newvect(S[0]); - for(J = 0; J < S[0]; J++){ - U = vtozv(M[J]); - for(K = -1, I = 0; I < S[1]; I++) - MM[J][I] = U[0][I]; - Lcm[J] = U[1]; - } - return [MM,Lcm]; -} - -def mytrace(M) -{ - S=size(M); - if(S[0]!=S[1]) return 0; - for(I=V=0; I<S[0]; I++){ - V+=M[I][I]; - } - return V; -} - -def mydet(M) -{ - MM = matrtop(M); - if(type(MM[0]) == 6){ - S = size(M); - for(Dn = 1, I = 0; I < S[0]; I++) - Dn *= MM[1][I]; - return (!Dn)?0:red(det(MM[0])/Dn); - } -} - -def mperm(M,P,Q) -{ - if(type(M) == 6){ - S = size(M); - if(type(P) <= 1) - P=(P==1)?Q:trpos(0,0,S[0]); - if(type(P) > 3 && type(P[0]) >= 4) - P = trpos(P[0][0],P[0][1],S[0]); - else if(type(P) == 4){ - if(length(P)==2 && type(P[1])==4){ - P0=P[0];P1=car(P[1]);P=newvect(P1); - for(I=0;I<P1;I++) P[I]=P0+I; - }else P = ltov(P); - } - if(type(Q) <= 1) - Q=(Q==1)?P:trpos(0,0,S[1]); - if(type(Q) > 3 && type(Q[0]) >= 4) - Q = trpos(Q[0][0],Q[0][1],S[1]); - if(type(Q) == 4){ - if(length(Q)==2 && type(Q[1])==4){ - P0=Q[0];P1=car(Q[1]);Q=newvect(P1); - for(I=0;I<P1;I++) Q[I]=P0+I; - }else Q = ltov(Q); - } - MM = newmat(S0=length(P),S1=length(Q)); - for(I = 0; I < S0; I++){ - MMI = MM[I]; MPI = M[P[I]]; - for(J = 0; J < S1; J++) - MMI[J] = MPI[Q[J]]; - } - return MM; - } - if((type(M) == 5 || type(M) == 4) && type(P) >= 4){ - if(length(P) == 1 && type(car(P)) == 4) - P = trpos(car(P)[0],car(P)[1],length(M)); - MM = newvect(S = length(P)); - for(I = 0; I < S; I++) - MM[I] = M[P[I]]; - if(type(M) == 4) - MM = vtol(MM); - return MM; - } - return M; -} - -def mtranspose(M) -{ - if(type(M)==4){ - MV=ltov(M); - II=length(MV); - for(I=L=0; I<II; I++){ - if(type(MV[I])!=4) return M; - MV[I]=ltov(MV[I]); - } - for(R=[],J=0; ;J++){ - for(T=[],I=F=0; I<II; I++){ - if(length(MV[I])>J){ - F=1; - T=cons(MV[I][J],T); - } - } - if(F==0) return reverse(R); - if(F==1) R=cons(reverse(T),R); - } - } - if(type(M) != 6) - return M; - S = size(M); - MM = newmat(S[1],S[0]); - for(I = 0; I < S[0]; I++){ - for(J = 0; J < S[1]; J++) - MM[J][I] = M[I][J]; - } - return MM; -} - -def mtoupper(MM, F) -{ - TeXs=["\\ -=\\ ","\\ +=\\ "]; - Lins=[" -= line"," += line"]; - Assume=["If","Assume"]; - if(type(St = getopt(step))!=1) St=0; - Opt = getopt(opt); - if(type(Opt)!=1) Opt=0; - TeX=getopt(dviout); - if(type(Tab=getopt(tab))!=1 && Tab!=0) Tab=2; - Line="\\text{line}"; - if(type(TeX)!=1 || !St) TeX=0; - Size = size(MM); - if(F==-1){ - M = newmat(Size[0], Size[1]+1); - for(I = 0; I < Size[0]; I++){ - for(J = 0; J < Size[1]; J++) - M[I][J] = MM[I][J]; - M[I][Size[1]] = zz^I; - } - Size = size(M); - F = 1; - }else if(F<0){ - F=Size[0]; - M = newbmat(1,2,[[MM,mgen(F,0,[1],0)]]); - Size=[Size[0],F+Size[1]]; - }else - M = dupmat(MM); - if(St){ - if(TeX) Lout=[[dupmat(M)]]; - else mycat0([M,"\n\n"],0); - } - Top=""; - if(Opt>3){ - for(I=Opt; I>4; I--) - Top+=(TeX)?"\\ ":" "; - } - PC=IF=1; - for(K = JJ = 0; K < Size[1] - F; K++){ - for(J = JJ; J < Size[0]; J++){ - if(M[J][K] != 0){ /* search simpler element */ - if(Opt>2 && (Mul=M[J][K])!=1){ - for(FF=0,JT=J; JT<Size[0]; JT++){ - if((Val=M[JT][K])==1){ /* 1 */ - Mul=1;J=JT; break; - } - if(Val==0 || type(Val)>type(Mul)) continue; - if(type(Val)<type(Mul) || (Val==-1 && Mul!=-1)){ - Mul=Val; J=JT; /* smaller type */ - } - else if(Opt>3){ - if(isint(Val)==1){ /* integer elememt */ - if(isint(Mul)!=1){ - Mul=Val; J=JT; /* integer */ - } - if(FF<3||(FF==3&&Val>0)){ - for(JK=K+1;;){ - if(JK>=Size[1]-F){ - J=JT; - FF=((Mul=Val)>0)?4:3; - break; /* divisible int => 4: pos_int 3: neg_int */ - } - if(isint(M[JT][JK++]/Val)!=1) break; - } - } - }else if(!FF){ - for(JK=K+1; JK<Size[1]-F; JK++){ - if(isint(M[JT][JK]/Val)!=1) break; - J=JT; FF=1; /* divisible => 1: non integer */ - } - } - } - } - if(FF==0 && Opt>3 && Mul!=1 && Mul!=-1){ /* FF > 0 => divisible */ - for(FF=0,J0=J; J0<Size[0]-1 && FF!=9; J0++){ - VV0=M[J0][K]; - if(VV0==0 || isint(VV0)==0) continue; - for(J1=J0+1;J1<Size[0] && FF!=9; J1++){ - VV1=M[J1][K]; - if(VV1==0 || isint(VV1)==0) continue; - for(C=FT=0,V0=VV0,V1=VV1; C<2 && FF!=10; C++,V1=V0,V0=VV1){ - for(CC=0,RC=ceil(V0/V1);CC<2;CC++,RC--){ - if((CD=V0-RC*V1)==0 && (RC==1 || RC==-1)){ - FT=1; FF=10; /* 10: vanish by +- */ - }else if(CD==1){ - FV=(vars(M[J0])==[]&&vars(M[J1])==[])?1:0; - if((RC==1 || RC==-1) && FF<8+FV){ - FT=1; FF=8+FV; /* 8/9: 1 by +- */ - }else if(FF<6+VF){ - FT=1; FF=6+FV; /* 6/7: 1 by times */ - } - }else if(CD==-1){ - FV=(vars(M[J0])==[]&&vars(M[J1])==[])?1:0; - if((RC==1 || RC==-1) && FF<4+FV){ - FT=1; FF=4+FV; /* 4/5: 1 by +- */ - }else if(FF<2+VF){ - FT=1; FF=2+FV; /* 2/3: 1 by times */ - } - } - if(FT==1){ - FT=0; KRC=RC; - if(C==0){ - KJ0=J0; KJ1=J1; - }else{ - KJ0=J1; KJ1=J0; - } - } - } - } - } - } - if(FF>0){ - for(I=K;I<Size[1];I++) - M[KJ0][I]=radd(M[KJ0][I],rmul(M[KJ1][I],-KRC)); - if(KRC<0){ - KRC=-KRC;Sgn=1; - }else - Sgn=0; - if(St){ - if(TeX){ - if(KRC==1) - Lout=cons([Top+"\\xrightarrow{", Line,KJ0+1,TeXs[Sgn], - Line,KJ1+1,"}",dupmat(M)],Lout); - else - Lout=cons([Top+"\\xrightarrow{", Line,KJ0+1,TeXs[Sgn], - Line,KJ1+1,"\\times\\left(",KRC,"\\right)}", - dupmat(M)],Lout); - - }else{ - if(KRC==1) - mycat([Top+"line",KJ0+1,Lins[Sgn],KJ1+1,"\n",M,"\n"]); else - mycat([Top+"line",KJ0+1,Lins[Sgn],KJ1+1," * (",KRC,")\n",M,"\n"]); - } - } - Mul=M[KJ0][K]; J=KJ0; - if(FF==10){ - J--; continue; - } - } - } - } - /* a parameter Var */ - Var=0; - if(St && Opt>4 && length(Var=vars(nm(M[J][K])))==1){ - J0=J;Jv=mydeg(nm(M[J0][K]),car(Var)); - for(I=JJ;I<Size[0]; I++){ - if((MIK=M[I][K])==0) continue; - if((T=vars(MIK=nm(MIK)))==[]){ /* 1/poly */ - J=I;Var=[]; break; - } - if(length(T)>1) continue; - if(mydeg(MIK,T[0])<Jv){ - J0=I;Jv=mydeg(MIK);Var=T; /* search minimal degree */ - } - } - if(length(Var)==1){ - Var=car(Var); - Q=nm(M[J0][K]); - for(I=JJ; I<Size[0]; I++){ - if(I==J0 || mydeg(nm(M[I][K]),Var)<0) continue; - T=rpdiv(nm(M[I][K]),Q,Var); - if(T[0]!=0 && (vars(T)==[] || vars(T)==[Var])) break; /* dec. deg */ - } - } - } - if(type(Var)==2){ /* 1 variable */ - if(I==Size[0]){ - for(QF=0,Q0=1,QR=getroot(Q,Var|mult=1);QR!=[];QR=cdr(QR)){ - if(deg(T=QR[0][1],Var)>0){ - QF=1;Q0*=T; continue; - } - if(subst(PC,Var,T)==0) continue; - Q0*=(Var-(T=QR[0][1])); - if(type(T)<2){ - M0=subst(M,Var,T); - if(TeX){ - Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", - Var,"=",T,","] ,Lout); - Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab),Lout); - }else{ - mycat([str_times(" ",St-1)+"If",Var,"=",T,","]); - mtoupper(M0,F|step=St+1,opt=Opt); - } - } - } - if(Q0!=1){ - if(TeX) - Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{"+Assume[QF]+" }", - Q0/=fctr(Q0)[0][0],"\\ne0,"],Lout); - else - mycat([str_times(" ",St-1)+Assume[QF],Q0,"!=0,"]); - PC*=Q0; - } - IF=0;St++; - }else{ - KRC=-red((T[2]*dn(M[J0][K]))/(T[1]*dn(M[I][K]))); - for(II=K;II<Size[1];II++) - M[I][II]=radd(M[I][II],rmul(M[J0][II],KRC)); - if(TeX) - Lout=cons([Top+"\\xrightarrow{", Line,I+1,"\\ +=\\ ",Line, - J0+1,"\\times\\left(",KRC,"\\right)}",dupmat(M)],Lout); - else - mycat([Top+"line",I+1,"+=",Line,J0+1," * (",KRC,")\n",M,"\n"]); - J=JJ-1; - continue; - } - } - if(J != JJ){ - for(I = K; I < Size[1]; I++){ - Temp = M[JJ][I]; - M[JJ][I] = M[J][I]; - M[J][I] = (Opt>=2)?Temp:-Temp; - } - if(St){ - if(TeX) - Lout=cons([Top+"\\xrightarrow{",Line,JJ+1,"\\ \\leftrightarrow\\ ", - Line,J+1,"}",dupmat(M)],Lout); - else - mycat0([Top+"line",JJ+1," <-> line",J+1,"\n",M,"\n\n"],0); - } - } - /* Assume PC != 0 */ - if(Opt>1){ - Mul = M[JJ][K]; - if(Opt > 5 && St && IF && (Var=vars(MIK=nm(Mul)))!=[]){ - TF=fctr(MIK); - for(FF=0,Q0=1,TP=cdr(TF);TP!=[];TP=cdr(TP)){ - if(type(dn(red(PC/(TP0=car(car(TP))))))<2) continue; /* divisible */ - Q0*=TP0; - for(Var=vars(TP0);Var!=[];Var=cdr(Var)){ - if(mydeg(TP0,X=car(Var))==1 && type(dn(red(PC/mycoef(TP0,1,X))))<2){ - /* TP0=A*X+B with non-vanishing A */ - T=red(-mycoef(TP0,0,X)/mycoef(TP0,1,X)); - M0=mysubst(M,[X,T]); - if(TeX){ - Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", - X,"=",T,","] ,Lout); - Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab), - Lout); - }else{ - mycat([str_times(" ",St-1)+"If",X,"=",T,","]); - mtoupper(M0,F|step=St+1,opt=Opt); - } - break; - } - } - if(Var==[] && Opt>6){ - for(Var=vars(TP0);Var!=[];Var=cdr(Var)){ - if(mydeg(TP0,X=car(Var))==1){ - /* TP0=A*X+B, A is a poly of X0 with rational funct */ - T=nm(mycoef(TP0,1,X)); - for(Var0=vars(T);Var0!=[]; Var0=cdr(Var0)){ - X0=car(Var0); - if(type(dn(red(PC/type(mycoef(T,mydeg(T,X0),X0)))))>1) continue; - TR=getroot(T,X0|mult=1); - if(findin(X0,vars(TR))<0) break; - } - if(Var0==[]) continue; - for(;TR!=[0];TR=cdr(TR)){ - if(TR==[]){ - TR=[0,0]; - T0=-mycoef(TP0,0,X)/mycoef(TP0,1,X); - X0=X; - }else T0=car(TR)[1]; - M0=mysubst(M,[X0,T0]); - if(TeX){ - Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", - X0,"=",T0,","] ,Lout); - Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab), - Lout); - }else{ - mycat([str_times(" ",St-1)+"If",X0,"=",T0,","]); - mtoupper(M0,F|step=St+1,opt=Opt); - } - } - - } - break; - } - } - if(Var==[]){ - FF=1; - } - } - if(Q0!=1){ - if(FF) FF=1; - if(TeX) Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{"+Assume[FF]+" }",Q0/=fctr(Q0)[0][0],"\\ne0,"], - Lout); - else mycat([str_times(" ",St-1)+Assume[FF],Q0,"!=0,"]); - PC*=Q0;St++; - } - } - IF=M[JJ][K]=1; - if(Mul!=1){ - for(L=K+1; L<Size[1]; L++) - M[JJ][L]=red(M[JJ][L]/Mul); - if(St){ - if(TeX) - Lout=cons([Top+"\\xrightarrow{",Line,JJ+1, - "\\ \\times=\\ \\left(",red(1/Mul),"\\right)}", - dupmat(M)],Lout); - else - mycat0([Top+"line",JJ+1, " *= (",red(1/Mul), ")\n",M,"\n\n"],0); - } - } - - } - for(J = (Opt>0)?0:(JJ+1); J < Size[0]; J++){ - if(J == JJ) - continue; - Mul = -M[J][K]; - if(Mul!=0){ - if(Opt!=2) Mul=rmul(Mul,1/M[JJ][K]); - for(I = K+1; I < Size[1]; I++) - M[J][I] = radd(M[J][I],rmul(M[JJ][I],Mul)); - M[J][K] = 0; - if(St){ - if(Mul<0){ - Mul=-Mul;Sgn=0; - }else Sgn=1; - if(TeX){ - if(Mul==1) - Lout=cons([Top+"\\xrightarrow{", Line,J+1,TeXs[Sgn],Line,JJ+1, - "}",dupmat(M)],Lout); - else Lout=cons([Top+"\\xrightarrow{", Line,J+1,TeXs[Sgn],Line,JJ+1, - "\\times\\left(",Mul,"\\right)}",dupmat(M)],Lout); - }else{ - if(Mul==1) - mycat0([Top+"line",J+1, Lins[Sgn],JJ+1,"\n",M,"\n\n"],0); - else - mycat0([Top+"line",J+1, Lins[Sgn],JJ+1," * (",Mul,")\n",M,"\n\n"],0); - } - } - } - } - JJ++; - } - } - } - if(TeX){ - if(TeX==-2) return Lout; - Lout=reverse(Lout); - Br="\\allowdisplaybreaks"; - Cr="\\\\\n &"; - if(getopt(pages)==1) Cr=Br+Cr; - if(type(S=getopt(cr))==7) Cr=S; - if(type(Lim=getopt(lim))==1){ - if(Lim>0){ - if(Lim<30) Lim=TeXLim; - Lim*=2; - } - }else Lim=0; - Out = ltotex(Lout|opt=["cr","spts0"],str=1,cr=Cr,lim=Lim); - if(TeX<0) return Out; - dviout(Out|eq=(str_str(Cr,Br)>=0)?6:5,keep=(TeX==1)?0:1); - } - return M; -} - -def mydet2(M) -{ - S = size(M); - Det = 1; - MM = mtoupper(M,0); - for(I = 0; I < S[0]; I++) - Det = rmul(Det,MM[I][I]); - return Det; -} - -def myrank(MM) -{ - S = size(MM); - M = dupmat(MM); - M = mtoupper(M,0); - C = 0; - for(I = K = 0; I < S[0]; I++){ - for(J = K; J < S[1]; J++){ - if(M[I][J] != 0){ - C++; K++; - break; - } - } - } - return C; -} - -def meigen(M) -{ - F = getopt(mult); - if(type(M)==4 || type(M)==5){ - II=length(M); - for(R=[],I=II-1; I>=0; I--){ - if(F==1) - R=cons(meigen(M[I]|mult=1),R); - else - R=cons(meigen(M[I]),R); - } - return R; - } - S = size(M)[0]; - P = mydet2(mgen(S,0,[zz],0)-M); - return (F==1)?getroot(P,zz|mult=1):getroot(P,zz); -} - -def transm(M) -{ - if(type(M)!=6) M=s2m(M); - if(type(M)!=6){ - errno(0); - return 0; - } - L=[M];TeX=""; - Line=["\\text{line}","\\text{col}"]; - if((DVI=getopt(dviout)) !=1) DVI=0; - else dviout(M); - for(;;){ - print(L0=dupmat(car(L))); - Sz=size(L0); - S=keyin("? "); - N=0; - if(str_len(S)<=1){ - if(S=="q") return L; - if(S=="t"){ - N=mtranspose(L0); - TeX=["\\text{transpose}"]; - } - else if(S=="f"){ - if(length(L)>1){ - if(LF!=0) TeX=""; - L=cdr(L);LF=L0; - if(DVI){ - dviout0(-1); - dviout(" "); - } - } - }else if(S=="g"){ - if(LF!=0) N=LF; - }else if(S=="0"){ - N=M;L=[];TeX=[]; - }else if(S=="a"||S=="A"){ - if(DVI&&S=="A") mtoupper(L0,0|step=1,opt=10,dviout=1); - else mtoupper(L0,0|step=1,opt=10); - }else{ - mycat0([ - "2,5 : line2 <-> line5", - "2,5,-2 ; line2 += (-2)*line5", - "2,2,-2 : line2 *= -2", - "2,5,0 : line2 += (?)*line5 for reduction", - "r,2,5 : raw2 <-> raw5 (r,2,5,-2 etc.)", - "s,x,2 : subst(*,x,2)", - "t : transpose", - "0 : first matrix", - "f : previous matrix", - "g : next matrix (only after f)", - "A : auto (a : without TeX)", - "q : quit" - ],1|delim="\n"); - } - }else{ - FR=0; - S=evals(S|del=","); - if(S[0]==r){ - FR=1; S=cdr(S); - } - if((LL=length(S))>=2){ - S0=S[0]-1;S1=S[1]-1; - if(S[0]==s){ - if(length(S)==3) N=subst(L0,S[1],S[2]); - if(DVI) TeX=[S[1],"\\mapsto",S[2]]; - }else if(FR==0){ - if(S0<0 || S0>=Sz[0] || S1<0 || S1>=Sz[0]) continue; - if(LL==2){ - N=rowx(L0,S0,S1); - if(DVI) TeX=[Line[0],S[0],"\\ \\leftrightarrow\\ ",Line[0],S[1]]; - }else{ - S2=S[2]; - if(S0==S1){ - N=rowm(L0,S0,S2); - if(DVI) TeX=[Line[0],S[0],"\\ \\times=\\ ",S2]; - }else{ - if(S2==0){ - for(J=0;J<Sz[1] && L0[S1][J]==0;J++); - if(J<Sz[1]) S2=-L0[S0][J]/L0[S1][J]; - } - if(S2!=0){ - N=rowa(L0,S0,S1,S2); - if(DVI) TeX=[Line[0],S[0],"\\ +=\\ ",Line[0], - S[1],"\\ \\times\\ (",S2,")"]; - } - } - } - }else{ - if(S0<0 || S0>=Sz[1] || S1<0 && S1>=Sz[1]) continue; - if(LL==2){ - N=colx(L0,S0,S1); - if(DVI) TeX=[Line[1],S[0],"\\ \\leftrightarrow\\ ",Line[1],S[1]]; - }else{ - S2=S[2]; - if(S0==S1){ - N=colm(L0,S0,S2); - if(DVI) TeX=[Line[1],S[0],"\\ \\times=\\ ",S[2]]; - }else{ - if(S2!=0){ - for(J=0; I1<Sz[0] && L0[I1][J]==0; J++); - if(J<Sz[0]) S2=-L0[J][S0]/L0[J][S1]; - }if(S2!=0){ - N=cola(L0,S0,S1,S2); - if(DVI) TeX=[Line[1],S[0],"\\ +=\\ ",Line[1], - S[1],"\\ \\times\\ (",S2,")"]; - } - } - } - } - } - } - if(N!=0){ - LF=0;L=cons(N,L); - if(DVI) dviout("\\xrightarrow{"+ltotex(TeX|opt="spts0",str=1)+"}"+mtotex(N)|eq=8); - } - } -} - -def vgen(V,W,S) -{ - IM=length(V); - I=(getopt(opt)==0)?IM:0; - for(SS=0; I<IM && (SS==0 || V[I]<=W[I]); I++) - SS += W[I]; - if(I<IM){ - W[I]++; - SS--; - }else - SS=S; - for(J=0;J<I;J++){ - W[J] = (SS<=V[J])?SS:V[J]; - SS -= W[J]; - } - if(SS>0) - return -1; - return(I==IM)?0:I; -} - -def mmc(M,X) -{ - Mt=getopt(mult); - if(type(M)==7) M=os_md.s2sp(M); - if(type(M)!=4||type(M[0])!=6) return 0; - if(type(M[0])!=6){ /* spectre type -> GRS */ - G=s2sp(M|std=1); - L=length(G); - for(V=[],I=L-2;I>=0;I--) V=cons(makev([I+10]),V); - V=cons(makev([L+9]),V); - G=sp2grs(G,V,[1,length(G[0]),-1]|mat=1); - if(getopt(short)!=0){ - V=append(cdr(V),[V[0]]); - G=shortv(G,V); - } - R=chkspt(G|mat=1); - if(Mt!=1) Mt=0; - if(R[2]!=2 || R[3]!=0 || !(R=getbygrs(G,1|mat=1))) return 0; - MZ=newmat(1,1); - SS=length(G); - if(Mt==1) SS=SS*(SS-1)/2; - for(M=[],I=0;I<SS;I++) M=cons(MZ,M); - for(RR=R; RR!=[]; RR=cdr(RR)){ - RT=car(RR)[0]; - if(type(RT)==4){ - if(RT[0]!=0) M=mmc(M,[RT[0]]|simplify=Simp); - M=mmc(M,[cdr(RT)]); - } - } -/* for(R=cdr(R);R!=[];R=cdr(R)) M=mmc(M,[car(R)[0]]|mult=Mt); */ - } - if(X==0) return M; - L=length(M); - if((L>=6 && Mt!=0)||(L==3&&Mt==1)){ - for(SS=2,I=3; I<L; I+=(++SS)); - if(I!=L) return -1; - Mt=1; - }else{ - SS=L;Mt=0; - } - if(length(X)==SS+1){ - if(car(X)!=0&&(M=mmc(M,[car(X)]|mult=Mt))==0) return M; - return mmc(M,cdr(X)|mult=Mt); - } - for(I=X;I!=[];I=cdr(I)) if(I[0]!=0) break; - if(I==[]) return M; - Simp=getopt(simplify); - if(Simp!=0 && type(Simp)!=1) Simp=2; - N=newvect(L); - for(I=0;I<L;I++) N[I]=dupmat(M[I]); - S=size(N[0])[0]; - if(type(X)==4&&length(X)>SS){ /* addition */ - for(I=0;I<SS;I++,X=cdr(X)) if(X[I] != 0) N[I] = radd(N[I],car(X)); - } - if(length(X)!=1) return 0; - X=X[0]; - MZ = newmat(S,S); - MM = newvect(L); - for(M1=J=0; J<SS; J++){ - for(R=[],I=SS-1; I>=0; I--){ - if(I==J){ - for(RR=[],K=SS-1; K>=0; K--) - RR=cons((K==I)?N[K]+diagm(S,[X]):N[K],RR); - R=cons(RR,R); - }else R=cons([MZ],R); - } - MM[J]=newbmat(SS,SS,R); - if(J==0) M1=MM[0]; - else M1=radd(M1,MM[J]); - } - /* middle convolution */ - for(P=0,Q=1;J<L;J++){ /* A_{P,Q} */ - for(R=[],I=SS-1; I>=0; I--){ - for(RR=[],K=SS-1;K>=0;K--){ - MT=MZ; - if(I==K){ - MT=N[J]; - if(I==P) MT-=N[Q]; - else if(I==Q) MT-=N[P]; - }else if(I==P && K==Q) MT=N[Q]; - else if(I==Q && K==P) MT=N[P]; - RR=cons(MT,RR); - } - R=cons(RR,R); - } - MM[J]=newbmat(SS,SS,R); - if(++Q==SS){ - P++;Q=P+1; - } - } - for(R=[],I=SS-1; I>=0; I--){ - for(RR=[N[I]],J=0; J<I; J++) RR=cons(MZ,RR); - R=cons(RR,R); - } - M0 = newbmat(SS,SS,R); - KE = append(mykernel(M0|opt=1),mykernel(M1|opt=1)); - if(length(KE) == 0) return MM; - KK = mtoupper(lv2m(KE),0); - for(I=0;I<L;I++) MM[I] = mmod(MM[I],KK); - if(Simp!=0) MM = mdsimplify(MM|type=Simp); - return MM; -} - -def lpgcd(L) -{ - for(F=[]; L!=[]; L=cdr(L)){ - if((P=car(L))==0) continue; - if(F==[]){ - F=fctr(P); - S=length(F); - S--; - V=newvect(S); - M=newvect(S); - for(I=0; I<S; I++){ - M[I] = F[I+1][1]; - V[I] = F[I+1][0]; - } - N=nm(ptozp(P|factor=1)[1]); - continue; - } - N=igcd(ptozp(P|factor=1)[1],N); - for(I=0; I<S; I++){ - for(Q=P,CT=0; CT<M[I]; CT++) - if((Q=tdiv(Q,V[I])) == 0) break; - if(CT<M[I]) M[I]=CT; - } - } - if(F==[]) return 0; - for(Q=N,I=0;I<S; I++){ - while(M[I]>0){ - Q *= V[I]; - M[I]--; - } - } - return Q; -} - -def mdivisor(M,X) -{ - S=size(M=dupmat(M)); - XX=(type(X)==4||X==0)?X:[0,X]; - S0=S[0]; S1=S[1]; - if((Tr=getopt(trans))==1||Tr==2){ - Tr0=1; - GR=mgen(S0,0,1,0); GC=mgen(S1,0,1,0); - }else Tr=Tr0=0; - /* 0,a,b : (a,b)->(1,1) - 1 : (1,1) invertible - 2,i,M : line 0,i by M - 3,j,M : col 0,j by M - 4,j : col 1 += col j - 5,j,T : line j by T - 6,j,T : col 1 += col j by T (non-com) - 7,j : line 2<->j (non-com) - */ - if(type(V=getopt(dviout))==1){ - if(type(XX)==4 && type(XX[0])>1) Var=[XX[1],"\\partial"]; - else Var=0; - Tr=(abs(V)==3)?0:1; - MM=dupmat(M); - II=((S[0]>S[1])?S[1]:S[0])+1; - if(abs(V)>1){ - Is1=Js1=S[0]+S[1]; - Is=Js=[0,[Is1]]; - }else{ - Is=[0,[Is1=S[0]]];Js=[0,[Js1=S[1]]]; - } - VV=V; - V=newvect(II); - for(I=0;I<II;I++) V[I]=[]; - N=newbmat(2,2,[[M,mgen(S[0],0,[1],0)],[mgen(S[1],0,[1],0)]]); - mdivisor(M,X|step=1,dviout=V); - L=S[0]+S[1]; - if(Tr){ - NN=mperm(N,Is1,Js1); - for(K=S[0];K<Is1;K++){ - for(L=S[1];L<Js1;L++) - NN[K][L]=" "; - } - Out=[[mperm(NN,Is,Js)]]; - } - for(I=1;I<II;I++){ - I0=I-1; - if(V[I]==[]) continue; - for(T=reverse(V[I]);T!=[];T=cdr(T)){ - St=[]; - C=car(R=car(T)); - if(C==0){ - N=mperm(N,(R[1]==0)?0:[[R[1]+I0,I0]],(R[2]==0)?0:[[R[2]+I0,I0]]); - - if(Tr){ - if(R[2]!=0) St=append(["C",I,"\\leftrightarrow C",R[2]+I],St); - if(R[1]!=0){ - if(R[2]!=0) St=cons(",\\ ",St); - St=append(["L",I,"\\leftrightarrow L",R[1]+I],St); - } - Out=cons(St,Out); - } - }else if(C==1){ - P=1/N[I0][I0];N[I0][I0]=1; - if(P!=1){ - for(J=I;J<L;J++) - N[I0][J]=muldo(P,N[I0][J],XX); - - if(Tr){ - St=append(["L",I,"\\leftarrow(",P,")","\\times L",I],St); - Out=cons(St,Out); - NN=mperm(N,Is1,Js1); - for(K=S[0];K<Is1;K++){ - for(L=S[1];L<Js1;L++) - NN[K][L]=" "; - } - Out=cons(["\\to",mperm(NN,Is,Js)],Out); - } - } - for(F=0,J=I;J<S[0];J++){ - if((P=N[J][I0])==0) continue; - F++; - N[J][I0]=0; - for(K=I;K<L;K++) - N[J][K]=red(N[J][K]-muldo(P,N[I0][K],XX)); - - } - if(F){ - if(Tr){ - Out=cons(["Li\\ -\\!=\\ \\circ\\times L",I,"\\quad(i>",I,")"],Out); - NN=mperm(N,Is1,Js1); - for(K=S[0];K<Is1;K++){ - for(L=S[1];L<Js1;L++) - NN[K][L]=" "; - } - Out=cons(["\\to",mperm(NN,Is,Js)],Out); - } - } - for(F=0,J=I;J<S[1];J++){ - if((P=N[I0][J])==0) continue; - F++; - N[I0][J]=0; - for(K=I;K<L;K++) - N[K][J]=red(N[K][J]-muldo(N[K][I0],P,XX)); - } - if(F&&Tr) Out=cons(["Cj\\ -\\!=\\ C",I,"\\times\\circ\\quad(j>",I,")"],Out); - else continue; - }else if(C==2){ - C=mat(N[I0],N[R[1]+I0]);C=muldo(R[2],C,XX); - for(J=0;J<L;J++){ - N[I0][J]=C[0][J];N[R[1]+I0][J]=C[1][J]; - } - if(Tr) Out=cons([dupmat(R[2]),"\\begin{pmatrix}L",I,"\\\\L",R[1]+I, - "\\end{pmatrix}"],Out); - }else if(C==3){ - C=newmat(L,2); - for(J=0;J<L;J++){ - C[J][0]=N[J][I0];C[J][1]=N[J][R[1]+I0]; - } - C=muldo(C,R[2],XX); - for(J=0;J<L;J++){ - N[J][I0]=C[J][0];N[J][R[1]+I0]=C[J][1]; - } - if(Tr) Out=cons(["\\begin{pmatrix}C",I,"&C",R[1]+I,"\\end{pmatrix}", - dupmat(R[2])],Out); - }else if(C==4){ - for(J=0;J<L;J++) - N[J][I0]=red(N[J][I0]+N[J][R[1]+I0]); - if(Tr) Out=cons(["C",I,"\\ +\\!=\\ C",R[1]+I],Out); - }else if(C==5){ - for(J=0;J<L;J++) - N[I0+R[1]][J]=red(R[2]*N[I0+R[1]][J]); - if(Tr) Out=cons(["L",I+R[1],"\\leftarrow(", R[2],")\\times L",I+R[1]], - Out); - }else if(C==6){ - for(J=0;J<L;J++) - N[J][I0]=N[J][I0]+muldo(N[J][I0+R[1]],R[2],XX); - if(Tr) Out=cons(["C",I,"\\ +\\!=\\ C",I+R[1],"\\times(", R[2],")"], - Out); - }else if(C==7){ - mycat(["line",I+1,"\\leftrightarrow",R[1]+I]); - for(J=0;J<L;J++){ - C=N[I][J];N[I][J]=N[R[1]+I0][J];N[R[1]+I0][J]=C; - } - if(Tr) Out=cons(["L",I+1,"\\leftrightarrow L",R[1]+I],Out); - } - if(Tr){ - NN=mperm(N,Is,Js); - for(K=S[0];K<Is1;K++){ - for(L=S[1];L<Js1;L++) - NN[K][L]=" "; - } - Out=cons(["\\to",NN],Out); - } - } - } - if(!Tr){ - NN=mperm(N,Is,Js); - Out=[]; - } - if(S[0]+S[1]==Is1){ - N1=mperm(NN,[0,[S[0]]],[S[1],[S[0]]]); - N2=mperm(NN,[S[0],[S[1]]],[0,[S[1]]]); - N3=mperm(NN,[0,[S[0]]],[0,[S[1]]]); - R1=mdivisor(N1,X|trans=1)[1]; - R2=mdivisor(N2,X|trans=1)[1]; - if(Tr){ - Out=cons(["\\text{As a result,}"],Out); - Out=cons([N3,"=",N1,MM,N2],Out); - if(S[0]==S[1] && N3==mgen(S[0],0,1,0)){ - Out=cons(["=",muldo(N2,N1,XX),MM,"."],Out); - }else{ - Out=cons([N1,"^{-1}=",R1,","],Out); - Out=cons([N2,"^{-1}=",R2,"."],Out); - } - }else{ - Out=cons([N3,"=P",MM,"Q,"],Out); - Out=cons(["P=",N1,"=",R1,"^{-1},"],Out); - Out=cons(["Q=",N2,"=",R2,"^{-1}."],Out); - } - } - Out = ltotex(reverse(Out)|opt=["cr","spts0"],str=1,cr=15,var=Var); - if(S[0]+S[1]==Is1) - Out=str_subst(Out,"\\texttt{ }",""); - if(VV>0){ - dviout(Out|eq=6); - return NN; - } - return Out; - }else if(type(V)!=5) V=0; - - if(type(St=getopt(step))!=1) St=0; - for(FF=": start";;){ - if(St && V==0){ - if(Tr){ - mycat0([St,FF,"\n"],0); - mycat([GR,"\n"]);mycat([M,"\n"]);mycat([GC,"\n"]); - } - else mycat0([St,FF,"\n",M,"\n"],0); - } - if(X==0||X==[0,0]){ /* search minimal non-zero element */ - for(K=F=I=0; I<S0; I++){ - for(J=0; J<S1; J++){ - if((P=abs(M[I][J]))!=0 && (K>P || K==0)){ - K=P; R=[I,J]; - } - } - } - R=cons(K-1,[R]); - } - else R=mymindeg(M,XX[1]|opt=1); - if(R[0]<0){ /*zero matrix */ - if(Tr) return [[],mgen(S0,0,1,0),mgen(S1,0,1,0)]; - return []; - } - R0=R[1][0];R1=R[1][1]; - if(R0!=0){ - M=rowx(M,0,R0); - if(Tr) GR=rowx(GR,0,R0); - } - if(R1!=0){ - M=colx(M,0,R1); - if(Tr) GC=colx(GC,0,R1); - } - if(St>0 && (R0!=0 || R1!=0)) - if(type(V)==5) V[St]=cons([0,R0,R1],V[St]); - else if(Tr){ - mycat0([St,": (",R0+1,",",R1+1,") -> (1,1)\n"],0); - mycat([GR,"\n"]);mycat([M,"\n"]);mycat([GC,"\n"]); - }else mycat0([St,": (",R0+1,",",R1+1,") -> (1,1)\n",M,"\n"],0); - if(R[0]==0){ /* (1,1) : invertible */ - if(type(V)==5) V[St]=cons([1],V[St]); - P=M[0][0]; M[0][0]=1; - for(J=0;J<S1;J++){ /* (1,1) -> 1 */ - if(J>0) M[0][J]= red(M[0][J]/P); - if(Tr) GR[0][J]=red(GR[0][J]/P); - } - if(S0>1 && S1>1) N=newmat(S0-1,S1-1); - else N=0; - for(I=1;I<S0;I++){ - P=M[I][0]; M[I][0]=0; - for(J=1;J<S1;J++) - N[I-1][J-1]=M[I][J]=red(M[I][J] - muldo(P,M[0][J],XX)); - if(Tr){ - for(J=0;J<S0;J++) - GR[I][J] = red(GR[I][J] -muldo(P,GR[0][J],XX)); - } - } - if(Tr){ - for(J=1;J<S1; J++){ - for(I=0;I<S1;I++) GC[I][J]=red(GC[I][J]-muldo(GC[I][0],M[0][J],XX)); - M[0][J]=0; - } - } - if(St>0 && V==0){ - if(Tr){ - mycat0([St,": unit\n"],0); - mycat([GR,"\n"]);mycat([M,"\n"]);mycat([GC,"\n"]); - } - else mycat0([St,": unit\n",M,"\n"],0); - } - if(N==0){ - if(!Tr) return [1]; - if(Tr==2){ - GR0=mdivisor(GR,X|trans=1)[1]; - GC0=mdivisor(GC,X|trans=1)[1]; - return [[1],GR,GC,GR0,GC0]; - } - return [[1],GR,GC]; - } - R=mdivisor(N,XX|dviout=V,trans=Tr0,step=(St>0)?St+1:St); - if(!Tr) return cons(1,R); - GR=muldo(newbmat(2,2,[[1],[0,R[1]]]),GR,XX); - GC=muldo(GC,newbmat(2,2,[[1],[0,R[2]]]),XX); - if(S0==S1 && countin(1,1,R[0])==S0-1){ - GR=muldo(GC,GR,XX); GC=mgen(S0,0,1,0); - } - if(Tr==2){ - GR0=mdivisor(GR,X|trans=1)[1]; - GC0=mdivisor(GC,X|trans=1)[1]; - return [cons(1,R[0]),GR,GC,GR0,GC0]; - } - return [cons(1,R[0]),GR,GC]; - } - for(I=1;I<S0;I++){ - if(M[I][0]!=0){ -/* Error! when mygcd(A,B,0) with A<=0 or B<=0 */ - R=mygcd(M[I][0],M[0][0],XX); /* R[0]=R[1]*M[I][0]+R[2]*M[0][0] */ - M[0][0]=R[0]; M[I][0]=0; /* 0=R[3]*M[I][0]+R[4]*M[0][0] */ - for(J=1;J<S1;J++){ - T=red(muldo(R[1],M[I][J],XX)+muldo(R[2],M[0][J],XX)); - M[I][J]=red(muldo(R[3],M[I][J],XX)+muldo(R[4],M[0][J],XX)); - M[0][J]=T; - } - if(Tr){ - for(J=0;J<S0;J++){ - T=red(muldo(R[1],GR[I][J],XX)+muldo(R[2],GR[0][J],XX)); - GR[I][J]=red(muldo(R[3],GR[I][J],XX)+muldo(R[4],GR[0][J],XX)); - GR[0][J]=T; - } - } - if(St && V==0){ - mycat([" [",R[2],R[1],"]*"]); - mycat([" [",R[4],R[3],"]"]); - } - if(type(V)==5) V[St]=cons([2,I,mat([R[2],R[1]],[R[4],R[3]])],V[St]); - FF=": line 1 & "+rtostr(I+1); I=S0; - } - } - if(I>S0) continue; - for(J=1;J<S1;J++){ - if(M[0][J]!=0){ - R=mygcd(M[0][J],M[0][0],XX|rev=1); /* R[0]=M[0][J]*R[1]+M[0][0]*R[2] */ - M[0][0]=R[0]; M[0][J]=0; /* 0=M[0][J]*R[3]+M[0][0]*R[4] */ - for(I=1;I<S0;I++){ - T=red(muldo(M[I][J],R[1],XX)+muldo(M[I][0],R[2],XX)); - M[I][J]=red(muldo(M[I][J],R[3],XX)+muldo(M[I][0],R[4],XX)); - M[I][0]=T; - } - if(Tr){ - for(I=0;I<S1;I++){ - T=red(muldo(GC[I][J],R[1],XX)+muldo(GC[I][0],R[2],XX)); - GC[I][J]=red(muldo(GC[I][J],R[3],XX)+muldo(GC[I][0],R[4],XX)); - GC[I][0]=T; - } - } - if(type(V)==5) V[St]=cons([3,J,mat([R[2],R[4]],[R[1],R[3]])],V[St]); - FF=": column 1 & "+rtostr(J+1);J=S1; - if(St && V==0){ - mycat([" *[",R[2],R[4],"]"]); - mycat([" [",R[1],R[3],"]"]); - } - } - } - if(J>S1) continue; - if(S0==1 || S1==1){ - P=M[0][0]; - if(X==0){ - if(P<0){ - P=-P; - if(Tr) for(J=0;J<S0;J++) GR[0][J]=-GR[0][J]; - if(type(V)==5) V[St]=cons([5,0,-1],V[St]); - } - }else{ - P=nm(P); - if((R=fctr(P)[0][0])!=1){ - P/=R; - if(Tr) for(J=0;J<S0;J++) GR[0][J]/=R; - if(type(V)==5) V[St]=cons([5,0,1/R],V[St]); - } - } - if(!Tr) return [P]; - if(Tr==2){ - GR0=mdivisor(GR,X|trans=1)[1]; - GC0=mdivisor(GC,X|trans=1)[1]; - return [[P],GR,GC,GR0,GC0]; - } - return [[P],GR,GC]; - } - if(XX==0 || (type(XX)==4 && XX[0]==0)){ /* commutative case */ - P=M[0][0]; - for(I=1; I<S0; I++){ - for(J=1; J<S1; J++) - if(divdo(M[I][J],P,XX)[1]!=0) break; - if(J<S1){ - if(type(V)==5) V[St]=cons([4,J],V[St]); - FF=": column 1 += col"+rtostr(J+1); - for(I=1;I<S0;I++) M[I][0]=M[I][J]; - if(Tr) for(I=0;I<S1;I++) GC[I][0]=red(GC[I][0]+GC[I][J]); - break; - } - } - if(J<S1) continue; - N=newmat(S0-1,S1-1); - for(I=1;I<S0;I++) - for(J=1;J<S1;J++) N[I-1][J-1]=red(M[I][J]/P); - if(X==0){ - if(P<0) P=-P; - if(Tr) for(J=0;J<S0;J++) GR[0][J]=-GR[0][J]; - }else{ - P=M[0][0]; - P=nm(P); - P/=fctr(P)[0][0]; - if(Tr) for(J=0;J<S0;J++) GR[0][J]/=fctr(P)[0][0]; - } - R=mdivisor(N,XX|dviout=V,trans=Tr0,step=(St>0)?St+1:St); - RT=(Tr)?R[0]:R; - for(RR=[],L=reverse(RT);L!=[];L=cdr(L)) - RR=cons(red(P*car(L)),RR); - RR=cons(P,RR); - if(!Tr) return RR; - GR=muldo(newbmat(2,2,[[1],[0,R[1]]]),GR,XX); - GC=muldo(GC,newbmat(2,2,[[1],[0,R[2]]]),XX); - if(S0==S1 && countin(1,1,RR)==S0){ - GR=muldo(GC,GR,XX); GC=mgen(S0,0,1,0); - } - if(Tr==2){ - GR0=mdivisor(GR,X|trans=1)[1]; - GC0=mdivisor(GC,X|trans=1)[1]; - return [RR,GR,GC,GR0,GC0]; - } - return [RR,GR,GC]; - } /* End of commutative case */ - for(I=1; I<S0; I++){ - for(J=1; J<S1; J++){ - if(M[I][J] != 0){ - for(T=1;I<S0;T*=XX[0]){ - R=divdo(muldo(M[I][J],T,XX),M[0][0],XX); - if(R[1]!=0){ - if(type(V)==5) V[St]=cons([6,J,T],V[St]); - FF=": column 1 += col"+rtostr((J+1)*T); - if(I>1){ - M=rowx(M,1,I); - if(Tr) GR=rowx(GR,1,I); - if(type(V)==5) V[St]=cons([7,I],V[St]); - FF+=", line 2<->"+rtostr(I+1); - } - for(I=1;I<S0;I++) M[I][0]=muldo(M[I][J],T,XX); - if(Tr) - for(I=1;I<S1;I++) GC[I][0]=red(GC[I][0]+muldo(GC[I][J],T,XX)); - I=S0+1; J=S1; - break; - } - } - } - } - if(I>S0) break; - } - if(I==S0) return []; /* zero matrix : never happen */ - } -} - -def mdsimplify(L) -{ - T=getopt(type); - SS=0; - if(type(L)==6){ - L=[L]; SS=1; - } - if(type(L)==5){ - SS=2; - L = vtol(L); - } - M=car(L); - S=size(M)[0]; -#if 0 - MN=newmat(S,S); - MD=newmat(S,S); - for(I=0;I<S;I++){ - for(J=0;J<S;J++){ - TN=0;TD=1; - for(PL=L;PL!=[];PL=cdr(PL)){ - TM=red(car(PL)[I][J]); - TN=lgcd([TN,nm(TM)]|pol=1); - TD=llcm([TD,dn(TM)]|pol=1); - } - MN[I][J]=TM; - MD[I][J]=TN; - } - } - for(I=0;I<S;I++){ - for(J=0;J<S;J++){ - if(I==J||type(TD[I][J])<2||type(TN[J][I])<2) continue; - for(FC=cdr(fctr(TD[I][J]));FC!=[];){ - TFC=car(FC); - if(type(red(TN[J][I]/TFC[0]))>2) continue; - } - } - } -#endif - DD=newvect(S); - for(I=0; I<S; I++){ - LN=RN=[]; - LD=RD=1; - for(LL=L; LL!=[]; LL=cdr(LL)){ - M = car(LL); - for(J=0; J<S; J++){ - if(J==I) continue; - if((MM=M[I][J]) != 0){ - LN = cons(nm(MM),LN); - if(type(MM)==3 && tdiv(LD,P=dn(MM))==0) - LD=tdiv(LD*P,gcd(LD,P)); - } - if((MM=M[J][I]) != 0){ - RN = cons(nm(MM),RN); - if(type(MM)==3 && tdiv(RD,P=dn(MM))==0) - RD=tdiv(RD*P,gcd(RD,P)); - } - } - } - if(T==1 || T==3) LQ=RD; - else{ - P=lpgcd(LN); - LQ=gcd(P,RD); - if(P!=0) LQ *= nm(fctr(P)[0][0]); - } - if(T==1 || T==2) RQ=LD; - else{ - P=lpgcd(RN); - RQ=gcd(P,LD); - if(P!=0) RQ *= nm(fctr(P)[0][0]); - } - if((P=gcdz(LQ,RQ))!=1){ - LQ = red(LQ/P); RQ=red(RQ/P); - } - DD[I]=red(LQ/RQ); - if(LQ!=1 || RQ!=1){ - for(LA=[],LL=L; LL!=[]; LL=cdr(LL)){ - M = car(LL); - for(J=0; J<S; J++){ - if(I!=J){ - if(LQ!=1){ - M[I][J] = red(M[I][J]/LQ); - M[J][I] = red(M[J][I]*LQ); - } - if(RQ!=1){ - M[J][I] = red(M[J][I]/RQ); - M[I][J] = red(M[I][J]*RQ); - } - } - } - } - } - } - if(SS==2) L=ltov(L); - if(SS==1) L=L[0]; - if(getopt(show)==1) L=[L,DD]; - return L; -} - -def m2mc(M,X) -{ - if(type(M)<2){ - mycat([ -"m2mc(m,t) or m2mc(m,[t,s])\t Calculation of Pfaff system of two variables\n", -" m : list of 5 residue mat. or GRS/spc for rigid 4 singular points\n", -" t : [a0,ay,a1,c], swap, GRS, GRSC, sp, irreducible, pair, pairs, Pfaff, All\n", -" s : TeX, dviout, GRSC\n", -" option : swap, small, simplify, operator, int\n", -" Ex: m2mc(\"21,21,21,21\",\"All\")\n" -]); - return 0; - } - if(type(M)==7) M=s2sp(M); - if(type(X)==7) X=[X]; - Simp=getopt(simplify); - if(Simp!=0 && type(Simp)!=1) Simp=2; - Small=(getopt(small)==1)?1:0; - if(type(M[0])==4){ - if(type(M[0][0])==1){ /* spectral type */ - XX=getopt(dep); - if(type(XX)!=4 || type(XX[0])>1) XX=[1,length(M[0])]; - M=sp2grs(M,[d,a,b,c],[XX[0],XX[1],-2]|mat=1); - if(XX[0]>1 && XX[1]<2) XX=[XX[0],2]; - if(getopt(int)!=0){ - T=M[XX[0]-1][XX[1]-1][1]; - for(V=vars(T);V!=[];V=cdr(V)){ - F=coef(T,1,car(V)); - if(type(F)==1 && dn(F)>1) - M = subst(M,car(V),dn(F)*car(V)); - } - } - V=vars(M); - if(findin(d1,V)>=0 && findin(d2,V)<0 && findin(d3,V)<0) - M=subst(M,d1,d); - } - RC=chkspt(M|mat=1); - if(RC[2] != 2 || RC[3] != 0){ /* rigidity idx and Fuchs cond */ - erno(0);return 0; - } - R=getbygrs(M,1|mat=1); - if(getopt(anal)==1) return R; /* called by mc2grs() */ - Z=newmat(1,1,[[0]]); - N=[Z,Z,Z,Z,Z]; - for(RR=R; RR!=[]; RR=cdr(RR)){ - RT=car(RR)[0]; - if(type(RT)==4){ - if(RT[0]!=0) N=m2mc(N,RT[0]|simplify=Simp); - N=m2mc(N,[RT[1],RT[2],RT[3]]|simplify=Simp); - } - } - if(type(X)==4 && type(X[0])==7) - return m2mc(N,X|keep=Keep,small=Small); - return N; - } - if(type(X)==4 && type(X[0])==7){ - Keep=(getopt(keep)==1)?1:0; - if(X[0]=="All"){ - dviout("Riemann scheme"|keep=1); - m2mc(M,[(findin("GRSC",X)>=0)?"GRSC":"GRS","dviout"]|keep=1); - dviout("Spectral types : "|keep=1); - m2mc(M,["sp","dviout"]|keep=1); - dviout("\\\\\nBy the decompositions"|keep=1); - R=m2mc(M,["pairs","dviout"]|keep=1); - for(R0=R1=[],I=1; R!=[]; I++, R=cdr(R)){ - for(S=0,RR=car(R)[1][0];RR!=[]; RR=cdr(RR)) S+=RR[0]; - if(S==0) R0=cons(I,R0); - else if(S<0) R1=cons(I,R1); - } - S="irreducibility\\ $"+((length(R0)==0)?"\\Leftrightarrow":"\\Leftarrow") - +"\\ \\emptyset=\\mathbb Z\\cap$"; - dviout(S|keep=1); - m2mc(M,["irreducible","dviout"]|keep=1); - if(R0!=[]) - dviout(ltotex(reverse(R0))|eq=0,keep=1, - title="The following conditions may not be necessary for the irreducibility."); - if(R1!=[]) - dviout(ltotex(reverse(R1))|eq=0,keep=1,title="The following conditions can be omitted."); - if(getopt(operator)!=0){ - dviout("The equation in a Pfaff form is"|keep=1); - m2mc(M,["Pfaff","dviout"]|keep=Keep,small=Small); - } - else if(Keep!=1) dviout(" "); - return M; - } - Show=0; - if(length(X)>1){ - if(X[1]=="dviout") Show=2; - if(X[1]=="TeX") Show=1; - } - if(X[0]=="GRS"||X[0]=="GRSC"||X[0]=="sp"){ - Y=radd(-M[0],-M[1]-M[2]); - if(X[0]!="GRSC"){ - L=meigen([M[0],M[1],M[2],M[3],M[4],Y,radd(-M[1],-M[3]-M[4]),radd(Y,-M[3]-M[4])]|mult=1); - if(X[0]=="sp"){ - L=chkspt(L|opt="sp"); - V=[L[1],L[0],L[2],L[5]]; W=[L[1],L[3],L[4],L[6]]; - if(Show==2) dviout(s2sp(V)+" : "+s2sp(W)|keep=Keep); - return [V,W]; - } - S="x=0&x=y&x=1&y=0&y=1&x=\\infty&y=\\infty&x=y=\\infty\\\\\n"; - }else{ - L=meigen([M[0],M[1],M[2],M[3],M[4],Y,radd(-M[1],-M[3]-M[4]),radd(Y,-M[3]-M[4]), - radd(M[0],M[1]+M[3]),radd(M[1],M[2]+M[4])]|mult=1); - S="x=0&x=y&x=1&y=0&y=1&x=\\infty&y=\\infty&x=y=\\infty&x=y=0&x=y=1\\\\\n"; - } - T=ltotex(L|opt="GRS",pre=S,small=Small); - if(Show==2) dviout(T|eq=0,keep=Keep); - if(Show==1) L=T; - return L; - } - if(X[0]=="Pfaff"){ - S=ltotex(M|opt=["Pfaff",u,x,x-y,x-1,y,y-1],small=Small); - if(Show==2) dviout(S|eq=0,keep=Keep); - return S; - } - if(X[0]=="irreducible"){ - L=meigen([M[0],M[1],M[2],radd(-M[0],-M[1]-M[2])]|mult=1); - S=getbygrs(L,10|mat=1); - if(Show==2) dviout(ltotex(S)|eq=0,keep=Keep); - return S; - } - if(X[0]=="pairs"||X[0]=="pair"){ - L=meigen([M[0],M[1],M[2],radd(-M[0],-M[1]-M[2])]|mult=1); - S=chkspt(L|opt=0); - V=(Show==2)?1:0; - S=sproot(L,X[0]|dviout=V,keep=Keep); - return S; - } - if(X[0]=="swap"){ - Swap=getopt(swap); - if(type(Swap)<1 || Swap==1) - return newvect(5,[M[3],M[1],M[4],M[0],M[2]]); - if(Swap==2) - return newvect(5,[radd(M[0],M[1]+M[3]),M[4],M[2],radd(-M[1],-M[3]-M[4]),M[1]]); - if(type(Swap)==4 && length(Swap)==3){ - MX=radd(-M[0],-M[1]-M[2]); MY=radd(-M[3],-M[1]-M[4]); - if(Swap[0]==1){ - MX0=M[2];MY0=M[4]; - } - else if(Swap[0]==2){ - MX0=MX;MY0=MY; - }else{ - MX0=M[0];MY0=M[3]; - } - if(Swap[1]==1){ - MX1=M[2];MY1=M[4]; - } - else if(Swap[1]==2){ - MX1=MX;MY1=MY; - }else{ - MX1=M[0];MY1=M[3]; - } - return newvect(5,MX0,M[1],MX1,MY0,MY1); - } - } - return 0; - } - if(getopt(swap)==1) - return m2mc(m2mc(m2mc(M,"swap"),X),"swap"); - N=newvect(5); - for(I=0;I<5;I++) - N[I]=M[I]; - S=size(N[0])[0]; - if(type(X)==4){ - for(I=0;I<3;I++){ - if(X[I] != 0) - N[I] = radd(N[I],X[I]); - } - if(length(X)==3) return N; - X=X[3]; - } - MZ = newmat(S,S); - ME = mgen(S,0,[X],0); - MM = newvect(5); - MM[0] = newbmat(3,3, [[N[0]+ME,N[1],N[2]], [MZ], [MZ]]); - MM[1] = newbmat(3,3, [[MZ], [N[0],N[1]+ME,N[2]], [MZ]]); - MM[2] = newbmat(3,3, [[MZ], [MZ], [N[0],N[1],N[2]+ME]]); - MM[3] = newbmat(3,3, [[N[3]+N[1],-N[1]], [-N[0],radd(N[0],N[3])], [MZ,MZ,N[3]]]); - MM[4] = newbmat(3,3, [[N[4]], [MZ,N[4]+N[2],-N[2]], [MZ,-N[1],radd(N[4],N[1])]]); - M0 = newbmat(3,3, [[N[0]], [MZ,N[1]], [MZ,MZ,N[2]]]); - M1 = radd(MM[0],MM[1]+MM[2]); - KE = append(mykernel(M0|opt=1),mykernel(M1|opt=1)); - if(length(KE) == 0) return MM; - KK = mtoupper(lv2m(KE),0); - for(I=0;I<5;I++) - MM[I] = mmod(MM[I],KK); - if(Simp!=0) MM = mdsimplify(MM|type=Simp); - return MM; -} - -def easierpol(P,X) -{ - if(type(X) == 4){ - for( Y = [] ; X != []; X = cdr(X) ) - Y = cons([0,car(X)], Y); - }else - Y = [0,X]; - return rede(P,Y); -} - -def l2p(L,V) -{ - if(type(L)==4){ - for(S=I=0;L!=[];L=cdr(L),I++) - S+=car(L)*V^I; - return S; - }else if(type(L)==5){ - for(S=0,I=size(L)-1;I>=0;I--) - S+=L[I]*V^I; - return S; - }else{ - if(type(D=getopt(size))==1) D--; - else D=mydeg(L,V); - for(S=[];D>=0;D--) - S=cons(mycoef(L,D,V),S); - return S; - } -} - -def paracmpl(L,V) -{ - if(type(L)==4) L=ltov(L); - S=length(L); - Lim=getopt(lim);Low=getopt(low); - if((F=type(L[0]))>3){ - SV=length(L[0]); - V0=makenewv(L); - for(LL=[];S>0;S--) - LL=cons(l2p(L[S-1],V0),LL); - G=paracmpl(LL,V|option_list=getopt()); - H=(Lim==1)?G:G[0]; - for(HH=[];H!=[];H=cdr(H)){ - HT=l2p(car(H),V0|size=SV); - if(F==5) HT=ltov(HT); - HH=cons(HT,HH); - } - H=reverse(HH); - return (Lim==1)?H:[H,G[1]]; - } - H=newvect(S);D=newvect(S); - for(Dn=1,I=0;I<S;I++){ - P=dn(L[I]=red(L[I])); - Dn=red(Dn*P/gcd(Dn,P)); - } - if(Dn!=1){ - for(I=0;I<S;I++) L[I]=red(Dn*L[I]); - } - G=diagm(S,[1]); - if(type(V)<4) V=[V]; - VV=lsort(vars(L),V,1); - V=car(V); - for(I=0;I<S;I++){ - P=L[I]; - for(J=0,C=P;J<I;J++){ - if(D[J]!=[]){ - C=mycoef(C,DT,VV); - P-=C*H[J]; - G=cola(G,I,J,-C); - } - } - if(P==0){ - D[I]=[];continue; - } - P0=nm(red(P)); - K=mymindeg(P0,V); - C=mycoef(P0,K,V); - if(K>0){ - P=red(P/V^K); - G=colm(G,I,1/V^K); - } - for(DT=[],VT=VV;VT!=[];VT=cdr(VT)){ - K=(Low==1)?mymindeg(C,car(VT)):mydeg(C,car(VT)); - C=mycoef(C,K,car(VT)); - DT=cons(K,DT); - } - D[I]=DT=reverse(DT); - for(C=P,VT=VV;VT!=[];VT=cdr(VT),DT=cdr(DT)) - C=mycoef(C,car(DT),car(VT)); - H[I]=P=red(P/C); - G=colm(G,I,1/C); - } - if(Dn!=1){ - for(I=0;I<S;I++){ - TH=red(H[I]/Dn); - F=fctr(dn(TH));F=cdr(F); - if(Lim!=1||subst(Dn,V,0)==0){ - for(;F!=[];F=cdr(F)){ - if(lsort(vars(car(F)[0]),VV,2)==[]){ - C=car(F)[0]^car(F)[1]; - TH=red(TH*C); - G=colm(G,I,C); - } - } - } - H[I]=TH; - } - } - H=vtol(H); - if(Lim==1){ - H=subst(H,V,0); - return map(red,H); - } - return [H,map(red,G)]; -} - -def mykernel(M) -{ - if(getopt(opt) == 1) - M = mtranspose(M); - S = size(M); - R = []; - MM = mtoupper(M,-1); - for(I = S[0]-1; I >= 0; I--){ - for(J = S[1]-1; J >= 0; J--){ - if(MM[I][J] != 0) - return R; - } - P = easierpol(MM[I][S[1]],zz); - RR = newvect(S[0]); - for(J = 0; J < S[0]; J++) - RR[J] = mycoef(P,J,zz); - R = cons(RR,R); - } - return R; -} - -def myimage(M) -{ - if(getopt(opt) == 1) - M = mtranspose(M); - S = size(M); - V = []; - M0 = newvect(S[1]); - M = mtoupper(M,0|opt=1); - for(I = S[0]-1; I >= 0; I--) - if(M0 != M[I]) - V = cons(vtozv(M[I])[0], V); - return V; -} - -def mymod(V,L) -{ - Opt = getopt(opt); - S = length(V); - VP = newvect(S); - if(type(L)==6) - L=m2lv(L); - CT = length(L); - for(LT = L; LT != []; LT = cdr(LT)){ - for(VT = car(LT), I = 0; I < S; I++) - if(VT[I] != 0) break; - if(I >= S){ - CT--; - continue; - } - VP[I] = 1; - MI = -red(V[I]/VT[I]); - if(MI != 0) - V = radd(V,rmul(MI,VT)); - } - if(Opt==1){ - for(I = 0; I < S; I++) - if(V[I] != 0) - return 1; - return 0; - } - if(Opt==2){ - W=newvect(S-CT); - for(CC = I = 0; I < S; I++){ - if(VP[I]==0) W[CC++] =V[I]; - } - return W; - } - return V; -} - -def mmod(M,L) -{ - S=size(M)[1]; - MM=mtranspose(M); - VP = newvect(S); - if(type(L)==6) - L=m2lv(L); - for(CT = 0, LT = L; LT != []; LT = cdr(LT)){ - for(VT = car(LT), I = 0; I < S; I++){ - if(VT[I] != 0){ - VP[I] = 1; - break; - } - } - } - if(getopt(opt)==1) - NE=1; - for(D=I=0; I<S; I++){ - if(NE != 1 && VP[I] == 1) continue; - T = mymod(MM[I],L|opt=2); - if(D==0){ - K=length(T); - MN=newmat((NE==1)?S:K,K); - } - for(J=0;J<K;J++) - MN[J][D]=T[J]; - D++; - } - return MN; -} - -def llsize(V) -{ - for(I=J=0;V!=[];V=cdr(V),I++) - if(length(car(V))>J) J=length(car(V)); - return [I,J]; -} - -def llbase(VV,L) -{ - S = length(VV); - V = dupmat(VV); - if(type(V) == 4) - V = ltov(V); - T = length(L); - for(I = 0; I < S; I++) - V[I] = nm(red(V[I])); - LV = 0; - for(J = 0; J < T; J++){ - X = var(L[J]); N = deg(L[J],X); - for(I = LV; I < S; I++){ - if((C2=coef(V[I],N,X)) != 0){ - if(I > LV){ - Temp = V[I]; - V[I] = V[LV]; - V[LV] = Temp; - } - for(I = 0; I < S; I++){ - if(I == LV || (C1 = coef(V[I],N,X)) == 0) - continue; - Gcd = gcd(C1,C2); - V[I] = V[I]*tdiv(C2,Gcd)-V[LV]*tdiv(C1,Gcd); - } - LV++; - } - } - } - return V; -} - -def lsort(L1,L2,T) -{ - C1=getopt(c1);C2=getopt(c2); - if(type(T)==4){ - K=T; - if(length(T)>0){ - T=K[0]; - K=cdr(K); - }else T=0; - }else K=0; - if(type(TT=T)==7) - T = findin(T,["cup","setminus","cap","reduce","sum","subst"]); - if(type(L2)==7&&T<0) - T=findin(TT,["put","get","sub"]); - if(K){ /* [[..],..] */ - if(K!=[]) KN=K[0]; - if(L2==[]||L2=="sort"){ /* sort or deduce duplication */ - if((T!=0&&T!=3)||length(K)!=1) return L1; - if(KN<0){ - KN=-KN-1; - F=-1; - }else F=1; - L1=msort(L1,[F,0,KN]); - if(T==3){ - R=[car(L1)];L1=cdr(L1); - for(;L1!=[];L1=cdr(L1)){ - if(car(L1)[KN]!=car(R)[KN]) R=cons(car(L1),R); - } - L1=reverse(R); - } - return L1; - }else if((L2==0||L2=="col")&&type(C1)==4){ - if(T==0||T==1){ /* extract or delete columns */ - for(R=[];L1!=[];L1=cdr(L1)){ - if(T==1&&C1==[0]){ /* delete top column */ - R=cons(cdr(car(L1)),R); - continue; - } - LT=car(L1);RT=[]; - if(T==0){ - for(CT=C1;CT!=[];CT=cdr(CT)) RT=cons(LT[car(CT)],RT); - }else{ - for(I=0;LT!=[];I++,LT=cdr(LT)) - if(findin(I,C1)<0) RT=cons(car(LT),RT); - RT=reverse(RT); - } - R=cons(RT,R); - } - return reverse(R); - } - }else if(type(L2)==1||type(L2)==7){ - if(L2==1||L2=="num"){ - if(T==4) T=3; - I=(length(K)<2)?(-1):K[1]; - if(T==0||T==1||T==2||T==3){ - S=F=CT=0;R=[]; - if(K==[] || type((S=K[0]))==1 || S==0){ - if(T==0||T==1||T==2){ - for(J;L1!=[];L1=cdr(L1),J++){ - if(T==0) R=cons(cons(J+S,car(L1)),R); - else if(T==1){ - for( ;C1!=[]; C1=cdr(C1)) - R=cons(L1[car(C1)],R); - }else{ - if(findin(J,C1)<0) R=cons(car(L1),R); - } - } - return reverse(R); - }else if(T==3) return length(L1); - }else{ - if(type(S)==2&&vtype(S)>2) F=1; - else if(type(S)==4) F=2; - else if(S=="+") F=3; - else return L1; - } - for(R=[];L1!=[];L1=cdr(L1)){ - L1T=car(L1); - if(F==1) V=call(S,(I<0)?L1T:L1T[I]); - else if(F==2) V=calc((I<0)?L1T:L1T[I],S); - else if(F==3){ - for(C=C1,V=0;C!=[];C=cdr(C)) - if(type(X=L1T[car(C)])==1) V+=X; - } - if(T==0) R=cons(cons(V,L1T),R); - else if(T==1){ - if(V) R=cons(L1T,R); - }else if(T==2){ - if(!V) R=cons(L1T,R); - }else if(T==3){ - if(F==3) CT+=V; - else if(V) CT++; - } - } - return (T==3)?CT:reverse(R); - }else if(TT=="col"){ - J=(length(K)>0)?car(K):0; - I=length(car(L1))+J; - for(V=[];I>J;) - V=cons(--I,V); - return cons(V,L1); - } - }else if(L2=="transpose") return mtranspose(L1); - else if(L2=="subst"||L2=="adjust"){ - Null=(!K)?"":car(K); - if(L2=="adjust") C1=[]; - R=lv2m(L1|null=""); - for(;C1!=[];C1=cdr(C1)) R[car(C1)[0]][car(C1)[1]]=car(C1)[2]; - return m2ll(R); - } - return L1; - }else{ /* [[..],..], [[..],..] */ - if(type(L2[0])<4){ - for(R=[];L2!=[];L2=cdr(L2)) R=cons([car(L2)],R); - L2=reverse(R); - } - if(TT=="sum") T=3; - if(TT=="over") T=4; - if(findin(T,[0,1,2,3,4,5])<0) return L1; - if(T==4||T==5){ - if(type(C1)<2) C1=[C1]; - if(type(C2)<2) C2=[C2]; - } - if(type(car(L2))!=4){ - for(R=[];L2!=[];L2=cdr(L2)) R=cons([car(L2)],R); - R=reverse(R); - if(length(K)==1) K=[K[0],0]; - C2=0; - } - L1=lsort(L1,"num",["put",0]); /* insert number */ - K0=(length(K)>0)?K[0]+1:1; - K1=(length(K)>1)?K1=K[1]:0; - L1=lsort(L1,"sort",[0,K0]); - if(T<4&&type(C2)==4&&length(L2[0])>1){ - L2=lsort(L2,"col",["put"]|c1=cons(K1,C2)); /* add key and extract columns */ - C2=0;K1=0; - } - L2=lsort(L2,"sort",[0,K1]); - for(R0=[],S=S1=length(L1[0]);S>0;S--) R0=cons("",R0); - for(R1=[],S=length(L2[0]);S>0;S--) R1=cons("",R1); - if(!K1&&T!=3) R1=cdr(R1); - for(R=[];L1!=[];L1=cdr(L1)){ - while(L2!=[]&&car(L1)[K0]>car(L2)[K1]){ - if(T==3) R=cons(append(R0,car(L2)),R); - L2=cdr(L2); - } - if(L2==[]||car(L1)[K0]<car(L2)[K1]){ - if(T!=2) R=cons((T==1||T>3||R1==[])?car(L1):append(car(L1),R1),R); - }else if(T==0||T==2||T==3){ - if(R0==[]) R=append(car(L1),R); - else R=cons(append(car(L1),(!K1&&T!=3)?cdr(car(L2)):car(L2)),R); - L2=cdr(L2); - }else if(T==4||T==5){ - V1=ltov(car(L1));V2=ltov(car(L2)); - for(D1=C1,D2=C2;D1!=[];D1=cdr(D1),D2=cdr(D2)) - if((I=V2[car(D2)])!=""||T==4) V1[car(D1)+1]=I; - R=cons(vtol(V1),R); - } - } - if(T==3){ - while(L2!=[]){ - R=cons(append(R0,car(L2)),R); - L2=cdr(L2); - } - } - R=lsort(R,"sort",["put",0]); /* original order */ - D=(((T==0||T==2)&&!K1)||T==3)?[0]:[0,S1+K1]; - R=lsort(R,0,[1]|c1=D); /* delete */ - if(type(C1)!=4||T==1||T==4||T==5) return R; - C=[];S0=size(L1[0]); - for(;C1!=[];C1=cdr(C1)) C=cons(car(C1),C); - for(I=0;I<S0-S1;I++) C=cons(I+S1,C); - C=reverse(C); - return lsort(R,"col",[1]|c1=C); - } - } - if(L2 == []){ /* [...] */ - if(T==8||TT=="count") return [length(L1),length(lsort(L1,[],1))]; - if(T==7||TT=="cut"){ - K=length(L1); - if(C1<0) C1=K+C1; - for(R=[],I=0;I<C1&&L1!=[];I++,L1=cdr(L1)) - R=cons(car(L1),R); - for(S=[];L1!=[];L1=cdr(L1)) - S=cons(car(L1),S); - return [reverse(R),reverse(S)]; - } - if(T==2) return L2; - if(T==3) return [L1,L2]; - L1 = ltov(L1); qsort(L1); - if(T != 1) - return vtol(L1); - L3 = []; - for(I = length(L1)-1; I >= 0; I--){ - if(I > 0 && L1[I] == L1[I-1]) - continue; - L3 = cons(L1[I], L3); - } - return L3; - } - if(T==8||TT=="count"){ - K=length(lsort(L1,L2,3)[0]); - R=[length(L2),length(L1)]; - L1 = lsort(L1,[],1); - L2 = lsort(L2,[],1); - R=append([length(L2),length(L1)],R); - R=cons(length(lsort(L1,L2,2)),R); - return reverse(cons(K,R)); - } - if((T==9||TT=="cons")&&type(car(L1))==4){ - if(type(L2)!=4) L2=[L2]; - for(R=[];L1!=[];L1=cdr(L1)){ - R=cons(cons(car(L2),car(L1)),R); - if(length(L2)>1) L2=cdr(L2); - } - return reverse(R); - } - if(T==10||TT=="cmp"){ - if(length(L1)!=length(L2)){ - mycat("Different length!"); - return 1; - } - R=[]; - if(type(car(L1))==4){ - for(U=[],I=0;L1!=[];I++,L1=cdr(L1),L2=cdr(L2)){ - if(length(S=car(L1))!=length(T=car(L2))){ - mycat(["Different size : line ",I]); - return 0; - } - for(J=0;S!=[];S=cdr(S),T=cdr(T),J++) - if(car(S)!=car(T)) U=cons([[I,J],car(S),car(T)],U); - } - if(U!=[]) R=cons(reverse(U),R); - }else{ - for(I=0;L1!=[];L1=cdr(L1),L2=cdr(L2),I++) - if(car(L1)!=car(L2)) R=cons([I,car(L1),car(L2)],R); - } - return reverse(R); - } - if(T==11||TT=="append"){ - if(type(car(L1))!=4) return append(L1,L2); - for(R=[];L1!=[];L1=cdr(L1),L2=cdr(L2)) - R=cons(append(car(L1),car(L2)),R); - return reverse(R); - } - if(T == 1 || T == 2){ - L1 = lsort(L1,[],1); - L2 = lsort(L2,[],1); - L3 = []; - if(T == 1){ - while(L1 != []){ - if(L2 == [] || car(L1) < car(L2)){ - L3 = cons(car(L1), L3); - L1 = cdr(L1); - continue; - } - if(car(L1) > car(L2)){ - L2 = cdr(L2); - continue; - } - L1 = cdr(L1); L2 = cdr(L2); - } - return reverse(L3); - } - if(T==2){ - while(L1 != [] && L2 != []){ - if(car(L1) != car(L2)){ - if(car(L1) <= car(L2)) - L1 = cdr(L1); - else L2 = cdr(L2); - continue; - } - while(car(L1) == car(L2)) - L1 = cdr(L1); - L3 = cons(car(L2), L3); - } - return reverse(L3); - } - } - if(T==3){ - L1 = qsort(L1); L2 = qsort(L2); - L3 = L4 = []; - while(L1 != [] && L2 != []){ - if(car(L1) == car(L2)){ - L1 = cdr(L1); L2 = cdr(L2); - }else if(car(L1) < car(L2)){ - L3 = cons(car(L1),L3); - L1 = cdr(L1); - }else{ - L4 = cons(car(L2), L4); - L2 = cdr(L2); - } - } - L4 = append(reverse(L4),L2); - L3 = append(reverse(L3),L1); - return [L3,L4]; - } - L1 = append(L1,L2); - return lsort(L1,[],1); -} - -def mqsub(X,Y) -{ - for(L=LQS;L!=[];L=cdr(L)){ - F=(T=car(L))[0];M=(T=cdr(T))[0]; - X0=X;Y0=Y; - for(T=cdr(T);T!=[];T=cdr(T)){ - X0=X0[car(T)];Y0=Y0[car(T)]; - } - if(type(M)==1){ - if(M==3){ - X0=type(X0);Y0=type(Y0); - }else if(M==4&&type(X0)<2&&type(Y0)<2){ - X0=abs(X0);Y0=abs(Y0); - }else if(M==5){ - X0=str_len(rtostr(X0));Y0=str_len(rtostr(Y0)); - }else if(type(X0)==type(Y0)&&type(X0)>3&&type(X0)<7){ - if(M==1){ - X0=length(X0);Y0=length(Y0); - }else if(M==2){ - LX=length(X0);LY=length(Y0); - L0=(LX<LY)?LX:LY; - for(I=0;;I++){ - if(I==L0){ - X0=LX;Y0=LY;break; - } - if(X0[I]==Y0[I]) continue; - X0=X0[I];Y0=Y0[I];break; - } - } - } - }else if(type(M)==2){ - X0=(*M)(X0,Y0);Y0=0; - }else if(type(M)==4&&length(M)==1){ - X0=(*car(M))(X0);Y0=(*car(M))(Y0); - } - if(X0==Y0) continue; - return (X0<Y0)?-F:F; - } - return 0; -} - -def msort(L,S) -{ - if(type(S)!=4) return qsort(L); - if(type(S[0])!=4) S=[S]; - LQS=S; - return qsort(L,os_md.mqsub); -} - -def lmax(L) -{ - if(type(L)==4){ - V=car(L); - while((L=cdr(L))!=[]) - if(V < car(L)) V=car(L); - return V; - }else if(type(L)==5||type(L)==6) - return lmax(m2l(L)); - return []; -} - -def lmin(L) -{ - if(type(L)==4){ - V=car(L); - while((L=cdr(L))!=[]) - if(V > car(L)) V=car(L); - return V; - }else if(type(L)==5||type(L)==6) - return lmin(m2l(L)); - return []; -} - -def lgcd(L) -{ - if(type(L)==4){ - F=getopt(poly); - V=car(L); - while((L=cdr(L))!=[]&&V!=1){ - if(V!=0) - V=(F==1)?gcd(V,car(L)):igcd(V,car(L)); - } - return V; - }else if(type(L)==5||type(L)==6) - return lgcd(m2l(L)|option_list=getopt()); - return []; -} - -def llcm(L) -{ - if(type(L)==4){ - F=getopt(poly); - V=car(L); - while((L=cdr(L))!=[]){ - if(V!=0){ - if((V0=car(L))!=0) - V=(F==1)?red(V*V0/gcd(V,V0)):ilcm(V,V0); - } - else V=car(L); - } - if(F!=1&&V<0) V=-V; - return V; - } - else if(type(L)==5||type(L)==6) - return llcm(m2l(L)|option_list=getopt()); - return []; -} - -def ldev(L,S) -{ - M=abs(lmax(L));N=abs(lmin(L)); - if(M<N) M=N; - for(C=0,LT=L;;C++){ - LT=ladd(LT,S,1); - MT=abs(lmax(LT));NT=abs(lmin(LT)); - if(MT<NT) MT=NT; - if(MT>=M) break; - M=MT; - } - if(!C){ - for(C=0,LT=L;;C--){ - LT=ladd(LT,S,-1); - MT=abs(lmax(LT));NT=abs(lmin(LT)); - if(MT<NT) MT=NT; - if(MT>=M) break; - M=MT; - } - } - return [C,ladd(L,S,C)]; -} - -def lchange(L,P,V) -{ - if(getopt(flat)==1&&type(P)==4){ - for(L=ltov(L);P!=[];P=cdr(P),V=cdr(V)) - L[car(P)]=car(V); - return vtol(L); - } - if(type(P)==4){ - IP=car(P); P=cdr(P); - }else{ - IP=P; P=[]; - } - for(I=0, LL=[], LT=L; LT!=[]; I++,LT=cdr(LT)){ - if(I==IP){ - LL=cons((P==[])?V:lchange(car(LT),P,V),LL); - }else - LL=cons(car(LT),LL); - } - return reverse(LL); -} - -def lsol(VV,L) -{ - if(type(VV)<4 && type(L)==2) - return red(L-VV/mycoef(VV,1,L)); - S = length(VV); - T = length(L); - V = llbase(VV,L); - for(J = K = 0; J < T; J++){ - X = var(L[J]); N = deg(L[J],X); - for(I = K; I < S; I++){ - if((C=mycoef(V[I], N, X)) != 0){ - V[I] = [L[J],red(X^N-V[I]/C)]; - K++; - break; - } - } - } - return V; -} - -def lnsol(VV,L) -{ - LL=lsort(vars(VV),L,1); - VV=ptol(VV,LL|opt=0); - return lsol(VV,L); -} - - -def ladd(X,Y,M) -{ - if(type(X)==4) X=ltov(X); - if(type(Y)==4) Y=ltov(Y); - return vtol(X+M*Y); -} - -def mrot(X) -{ - if(type(X)==4){ - if(getopt(deg)==1) - X=[deval(@pi*X[0]/180),deval(@pi*X[1]/180),deval(@pi*X[2]/180)]; - if(getopt(conj)==1) - return mrot([-X[2],-X[1],0])*mrot([X[0],X[1],X[2]]); - if(X[1]==0){ - X=[X[0]+X[2],0,0]; - if(X[0]==0) return diagm(3,[1]); - } - if(X[0]!=0){ - M=mat([dcos(X[0]),-dsin(X[0]),0],[dsin(X[0]),dcos(X[0]),0],[0,0,1]); - if(X[1]==0) return M; - } - N=mat([dcos(X[1]),0,-dsin(X[1])],[0,1,0],[dsin(X[1]),0,dcos(X[1])]); - if(X[0]!=0) N=M*N; - if(X[2]==0) return N; - return N*mrot([X[2],0,0]); - } - if(getopt(deg)==1) X=@pi*X/180; - X=deval(X); - return mat([dcos(X),-dsin(X)],[dsin(X),dcos(X)]); -} - -def m2v(M) -{ - S = size(M); - V = newvect(S[0]*S[1]); - for(I = C = 0; I < S[0]; I++){ - MI = M[I]; - for(J = 0; J < S[1]; J++) - V[C++] = MI[J]; - } - return V; -} - -def lv2m(L) -{ - if(type(L)==5) L=vtol(L); - II=length(L); - for(J=1,T=L; T!=[]; T=cdr(T)) - if(length(car(T))>JJ) JJ=length(car(T)); - M = newmat(II,JJ); - N = getopt(null); - if(type(N)<0) N=0; - for(I=0; I<II; I++){ - V=car(L); L=cdr(L); - for(J=length(V);--J>=0;) - M[I][J] = V[J]; - if(N!=0){ - for(J=length(V); J<JJ; J++) - M[I][J]=N; - } - } - return M; -} - -def m2lv(M) -{ - I=size(M)[0]; - for(N=[],I=size(M)[0];I-->0;) - N=cons(M[I],N); - return N; -} - -def s2m(S) -{ - if(type(S)==6) return S; - if(type(S)==7){ - if(str_chr(S,0,"[")!=0) S=s2sp(S); - else if(str_chr(S,0,",")>=0) return eval_str(S); - else{ - for(L=LL=[],I=0; ; ){ - II=str_chr(S,I+2,"]"); - if(II<0) return 0; - J=str_chr(S,I+2," "); - while(str_chr(S,J+1," ")==J+1) J++; - if(J>II-2 || J<0) J=II; - V=eval_str(sub_str(S,I+1,J-1)); - L=cons(V,L); - I=J; - if(J==II){ - LL=cons(ltov(reverse(L)),LL); - L=[]; - if((I=str_chr(S,II+1,"["))<0) - return lv2m(reverse(LL)); - } - } - } - } - if(type(S)==5) S=vtol(S); - if(type(S[0])==5) return lv2m(S); - I=length(S); - for(J=1,T=S; T!=[]; T=cdr(T)) - if(length(car(T))>J) J=length(car(T)); - return newmat(I,J,S); -} - -def c2m(L,V) -{ - if(type(Pow=getopt(pow))!=1){ - if(isvar(V)==1){ - for(Pow=0,LT=L;LT!=[];LT=cdr(LT)){ - if(mydeg(car(LT),V)>JJ) Pow=mydeg(car(LT),V); - } - JJ=Pow+1; - }else{ - Pow=-1; - JJ=length(V); - } - }else JJ=Pow+1; - M=newmat(length(L),JJ); - for(I=0;L!=[];L=cdr(L),I++){ - for(J=0;J<JJ;J++){ - LT=car(L); - M[I][J]=(Pow>=0)?mycoef(LT,J,V):mycoef(LT,1,V[J]); - } - } - return M; -} - -#if 0 -def m2diag(M,N) -{ - S = size(M); - MM = mtoupper(M,N); - for(I = S[0]-1; I >= 0; I--){ - for(J = 0; I < S[1]-N; I++){ - if(MM[I][J] != 0){ - P = MM[I][J]; - for(K = 0; K < I; K++){ - Q = -rmul(MM[K][J],1/P); - MM[K][J] = 0; - if(Q != 0){ - for(L = J+1; L < S[1]; L++){ - if(MM[I][L] != 0) - MM[K][L] = radd(MM[K][L], rmul(MM[I][L],Q)); - } - } - } - } - } - } - return MM; -} -#endif - -def myinv(M) -{ - S = size(M); - if((T=S[0]) != S[1]) - return 0; - MM = mtoupper(M,-T|opt=2); - if(MM[T-1][T-1] != 1) return 0; - return mperm(MM,0,[T,[T]]); -} - -def madj(G,M) -{ - H=myinv(G); - if(type(M)==6) - return rmul(rmul(G,M),H); - if(type(M)==4||type(M)==5){ - L=length(M); - N=newvect(L); - for(I=0;I<L;I++){ - N[I]=rmul(rmul(G,M[I]),H); - } - if(type(N)==4) N=vtol(N); - return N; - } - return -1; -} - -def mpower(M,N) -{ - if(type(M)<=3) return (red(M))^N; - S = size(M); - if(S[0] != S[1]) - return 0; - if(N == 0) return mgen(S[0],0,[1],0); - if(N < 0) - return(mpower(myinv(M), -N)); - R = dupmat(M); - V=1; - for(V=1;;){ - if(iand(N,1)){ - V=map(red,R*V); - N--; - } - if((N/=2)==0) break; - R=map(red,R*R); - } - return V; -} - -def texlen(S) -{ - if(type(S)!=7) return 0; - LF=I=J=0; - LM=str_len(S); - while((I=str_str(S,"\\frac{"|top=J))>=0){ - if(I>J) LF+=texlen(str_cut(S,J,I-1)); - I+=6; - for(F=L=0,J=I;F<2 && J<LM-1;F++){ - for(C=1;C>0 && J<LM;){ - if((K0=str_char(S,J,"}"))<0) K0=LM; - if((K1=str_char(S,J,"{"))<0) K1=LM; - if(K0<0 && K1<0){ - J = str_len(S)-1; - break; - } - if(K0<K1){ - J=K0+1; C--; - }else{ - J=K1+1; C++; - } - } - T=str_cut(S,I,J-1); - if(F==0){ - I=J=K1+1;C=1; - }else J=K0+1; - if(type(T)==7 && (LL=texlen(T))>L) L=LL; - } - LF+=L; - } - if(J>0) S=str_cut(S,J,str_len(S)-1); - if(S==0) return LF; - S=ltov(strtoascii(S)); - L=LL=length(S); - for(I=F=0; I<L; I++){ - if(S[I]==92) F=1; - else if(F==1){ - if((S[I]>96 && S[I]<123)||(S[I]>64 && S[I]<91)) LL--; - else F=0; - } - if(S[I]<=32||S[I]==123||S[I]==125||S[I]==94||S[I]==38) LL--; /* {}^& */ - else if(S[I]==95){ - LL--; - if(I+2<L && S[I+2]==94) LL--; /* x_2^3 */ - else if(I+6<L && S[I+1]==123 && S[I+4]==125){ /* x_{11}^2 */ - if(S[I+5]==94 || (S[I+5]==125 && S[I+6]==94)) LL-- ; /* x_{11}}^2 */ - } - } - } - return LL+LF; -} - -def isdif(P) -{ - if(type(P)<1 || type(P)>3) return 0; - for(Var=[],R=vars(P);R!=[];R=cdr(R)){ - V0=rtostr(car(R)); - if(V0>"d" && V0<"e"){ - V=sub_str(V0,1,str_len(V0)-1); - if(V>="a" && V<"{") Var=cons([strtov(V),strtov(V0)],Var); - } - } - if(Var==[]) return 0; - for(V=Var; V!=[]; V=cdr(V)) - if(ptype(P,car(V)[1])==3) return 0; - return Var; -} - -def texsp(P) -{ - Q=strtoascii(P); - if((J=str_char(Q,0,92))<0 || (C=Q[L=str_len(P)-1])==32||C==41||C==125) - return P; - for(;;){ - if((I=str_char(Q,J+1,92))<0) break; - J=I; - }; - for(I=J+1;I<L&&isalpha(Q[I]);I++); - return(I==L)?P+" ":P; -} - -def fctrtos(P) -{ - /* extern TeXLim; */ - - if(!chkfun("write_to_tb", "names.rr")) - return 0; - - TeX = getopt(TeX); - if(TeX != 1 && TeX != 2 && TeX != 3) - TeX = 0; - if((Dvi=getopt(dviout)==1) && TeX<2) TeX=3; - if(TeX>0){ - Lim=getopt(lim); - if(Lim!=0 && TeX>1 && (type(Lim)!=1||Lim<30)) Lim=TeXLim; - else if(type(Lim)!=1) Lim=0; - CR=(TeX==2)?"\\\\\n":"\\\\\n&"; - if(TeX==1 || Lim==0) CR=""; - else if((Pages=getopt(pages))==1) CR="\\allowdisplaybreaks"+CR; - if(!chkfun("print_tex_form", "names.rr")) - return 0; - Small=getopt(small); - } - Dif=getopt(dif); - Var=getopt(var); - if(Lim>0 && type(Var)<2 && TeX!=1) Var=[strtov("0"),""]; - Dif=0; - if(Var=="dif"){ - Dif=DV=1; - }else if (Var=="dif0") Dif=1; - else if(Var=="dif1") Dif=2; - else if(Var=="dif2") Dif=3; - if(Dif>0){ - for(Var=[],R=vars(P);R!=[];R=cdr(R)){ - V=rtostr(car(R)); - if(V>"d" && V<"e"){ - V=sub_str(V,1,str_len(V)-1); - if(V>="a" && V<"{"){ - if(TeX>0){ - V=my_tex_form(strtov(V)); - if(Dif>=1){ - if(Dif==1){ - if(str_len(V)==1) V="\\partial_"+V; - else V="\\partial_{"+V+"}"; - } - Var=cons([car(R),V],Var); - } - else Var=cons([car(R)],Var); - }else Var=cons([car(R)],Var); - } - } - } - if(TeX>0){ - if(length(Var)==1){ - if(DV==1 && str_len(Var[0][1])==10) Var=[[Var[0][0],"\\partial"]]; - }else if(DV==1){ - for(V=Var;V!=[];V=cdr(V)){ - VV=rtostr(car(V)[0]); - if(VV<"dx0" || VV>= "dx:" || str_len(VV)>4) break; - } - if(V==[]){ - for(VT=[],V=Var;V!=[];V=cdr(V)){ - VV=str_cut(rtostr(car(V)[0]),2,3); - if(str_len(VV)==1) VT=cons([car(V)[0],"\\partial_"+VV],VT); - else VT=cons([car(V)[0],"\\partial_{"+VV+"}"],VT); - } - Var=reverse(VT); - } - }else - if(Dif==2 && length(Var)>1) Dif=3; - } - if(Dif>0) Dif--; - } - if(type(Var)>1 && Var!=[]){ /* as a polynomial of Var */ - Add=getopt(add); - if(type(Add)>0){ - if(type(Add)!=7){ - Add=my_tex_form(Add); - if(str_char(Add,0,"-")>=0 || str_char(Add,0,"+")>=0) Add="("+Add+")"; - } - if(str_char(Add,0,"(")!=0) Add = " "+Add; - }else Add=0; - if(type(Var)!=4) Var=[Var]; - if(length(Var)==2 && type(Var[1]) == 7) - Var = [Var]; - for(VV=VD=[]; Var!=[];Var=cdr(Var)){ - VT=(type(car(Var))==4)?car(Var):[car(Var)]; - VT0=var(car(VT)); - VV=cons(VT0,VV); - if(length(VT)==1){ - VD=cons((TeX>=1)?my_tex_form(VT0):rtostr(VT0),VD); - }else VD=cons(VT[1],VD); - } - VV=reverse(VV);VD=reverse(VD); - Rev=(getopt(rev)==1)?1:0; - Dic=(getopt(dic)==1)?1:0; - TT=terms(P,VV|rev=Rev,dic=Dic); - if(TeX==0){ - Pre="("; Post=")"; - }else{ - Pre="{"; Post="}"; - } - Out = string_to_tb(""); - for(L=C=0,Tm=TT;Tm!=[];C++,Tm=cdr(Tm)){ - for(I=0,PC=P,T=cdr(car(Tm)),PW="";T!=[];T=cdr(T),I++){ - PC=mycoef(PC,D=car(T),VV[I]); - if(PC==0) continue; - PT=""; - if(D!=0 && VD[I]!=""){ - if(TeX==0 && PW!="") PW+="*"; - if(D>1){ - if(D>9) PT="^"+Pre+rtostr(D)+Post; - else PT="^"+rtostr(D); - } - if(Dif>0) PW+=(Dif==1)?"d":"\\partial "; - PW+=VD[I]+PT; - } - } - D=car(Tm)[0]; - if(Dif>0 && D>0){ - Op=(Dif==1)?"\\frac{d":"\\frac{\\partial"; - if(D>1) Op+="^"+((D>9)?(Pre+rtostr(D)+Post):rtostr(D)); - PW=Op+Add+"}{"+PW+"}"; - }else if(Add!=0) PW=PW+Add; - if(TeX>=1){ - if(type(PC)==1 && ntype(PC)==0 && PC<0) - OC="-"+my_tex_form(-PC); - else OC=fctrtos(PC|TeX=1,br=1); - }else OC=fctrtos(PC|br=1); - if(PW!=""){ - if(OC == "1") OC = ""; - else if(OC == "-1") OC = "-"; - } - if(TeX==0 && D!=0 && OC!="" && OC!="-") PW= "*"+PW; - if((TOC=type(OC)) == 4){ /* rational coef. */ - if(Lim>0 && (texlen(OC[0])>Lim || texlen(OC[0])>Lim)){ - OC = (Small==1)?"("+OC[0]+")/("+OC[1]+")" - :"\\Bigl("+OC[0]+"\\Bigr)\\Bigm/\\Bigl("+OC[1]+"\\Bigr)"; - TOC = 7; - }else{ - if(str_char(OC[0],0,"-")==0){ - OC = fctrtos(-PC|TeX=1,br=1); - OC = "-\\frac{"+OC[0]+"}{"+OC[1]+"}"; - } - else - OC = "\\frac{"+OC[0]+"}{"+OC[1]+"}"; - } - } - if(Lim>0){ - LL=texlen(OC)+texlen(PW); - if(LL+L>=Lim){ - if(L>0) str_tb(CR,Out); - if(LL>Lim){ - if(TOC==7) OC=texlim(OC,Lim|cut=CR); - PW+=CR; L=0; - }else L=LL; - }else L+=LL; - }else if(length(Tm)!=1) PW += CR; /* not final term */ - if(TeX) OC=texsp(OC); - if(str_chr(OC,0,"-") == 0 || C==0) str_tb([OC,PW], Out); - else{ - str_tb(["+",OC,PW],Out); - if(LL<=Lim) L++; - } - } - S=str_tb(0,Out); - if(S=="") S="0"; - }else{ /* Var is not specified */ - if((TP=type(P)) == 3){ /* rational function */ - P = red(P); Nm=nm(P); Dn=dn(P); - Q=dn(ptozp(Nm|factor=1)[1]); - if(Q>1){ - Nm*=Q;Dn*=Q; - } - if(TeX>0){ - return (TeX==2)? - "\\frac\{"+fctrtos(Nm|TeX=1)+"\}\{"+fctrtos(Dn|TeX=1)+"\}" - :[fctrtos(Nm|TeX=1),fctrtos(Dn|TeX=1)]; - } - else{ - S=fctrtos(Nm); - if(nmono(Nm)>1) S="("+S+")"; - return S+"/("+fctrtos(Dn)+")"; - } - } - if(imag(P)==0) P = fctr(P); /* usual polynomial */ - else P=[[P,1]]; - S = str_tb(0,0); - for(J = N = 0; J < length(P); J++){ - if(type(P[J][0]) <= 1){ - if(P[J][0] == -1){ - write_to_tb("-",S); - if(length(P) == 1) - str_tb("1", S); - }else if(P[J][0] != 1){ - str_tb((TeX>=1)?my_tex_form(P[J][0]):rtostr(P[J][0]), S); - N++; - }else if(length(P) == 1) - str_tb("1", S); - else if(getopt(br)!=1 && length(P) == 2 && P[1][1] == 1){ - str_tb((TeX>=1)?my_tex_form(P[1][0]):rtostr(P[1][0]), S); - J++; - } - continue; - } - if(N > 0 && TeX != 1 && TeX != 2 && TeX != 3) - write_to_tb("*", S); - SS=(TeX>=1)?my_tex_form(P[J][0]):rtostr(P[J][0]); - N++; - if(P[J][1] != 1){ /* (log(x))^2 */ - if(nmono(P[J][0])>1|| - (!isvar(P[J][0])||vtype(P[J][0]))&&str_len(SS)>1) SS="("+SS+")"; - write_to_tb(SS,S); - str_tb(["^", (TeX>1)?rtotex(P[J][1]):monotos(P[J][1])],S); - }else{ - if(nmono(P[J][0])>1) SS="("+SS+")"; - write_to_tb(SS,S); - } - } - S = str_tb(0,S); - if((Lim>0 || TP!=2) && CR!="") S=texlim(S,Lim|cut=CR); - } - if(TeX>0){ - if(Small==1) S=str_subst(S,"\\frac{","\\tfrac{"); - if(Dvi==1){ - dviout(strip(S,"(",")")|eq=(Pages==1)?6:0); S=1; - } - } - return S; -} - -def strip(S,S0,S1) -{ - SS=strtoascii(S); - if(length(SS)>1){ - if(SS[0]==40&&SS[length(SS)-1]==41&&str_pair(SS,1,S0,S1)==length(SS)-1) - S=str_cut(SS,1,length(SS)-2); - } - return S; -} - -def texlim(S,Lim) -{ - /* extern TeXLim; */ - if(S==1 && Lim>10){ - TeXLim=Lim; - mycat(["Set TeXLim =",Lim]); - return 1; - } - if(type(Out=getopt(cut))!=7) Out="\\\\\n&"; - if(type(Del=getopt(del))!=7) Del=Out; - if(Lim<30) Lim=TeXLim; - S=ltov(strtoascii(S)); - for(L=[0],I=F=0;F==0; ){ - II=str_str(S,Del|top=I)+2; - if(II<2){ - F++;II=/* str_len(S) */ length(S)-1; - } - for(J=JJ=I+1;;JJ=K+1){ - K=str_char(S,JJ,43); /* + */ - if((K1=str_char(S,JJ,45))>2 && K1<K){ /* - */ - if(S[K1-1]!=123 && S[K1-1]!=40) K=K1; /* {, ( */ - } - if((K1=str_char(S,JJ,40))>0 && K1-JJ>6 && K1<K && S[K1-1]!=43 && S[K1-1]!=45){ /* ( */ - T=str_char(S,K1-6,"\\"); /* \Big*(, \big*( */ - if((T==K1-6 || T==K1-5) - && (str_str(S,"big"|top=T+1,end=T+1)>0 || str_str(S,"Big"|top=T+1,end=T+1)>0)) - K=T; - else if(K1>0 && K1<K) K=K1; - } - if(K<0 || K>II) break; - if(K-J>Lim && texlen(str_cut(S,J,K-1))>=Lim){ - J=K+1; L=cons(JJ-1,L); SL=0; - } - } - I=II; - } - SS=str_tb(0,0); - L=cons(length(S),L); - L=reverse(L); - for(I=0; L!=[]; I=J,L=cdr(L)){ - str_tb((I==0)?"":Out,SS); - J=car(L); - str_tb(str_cut(S,I,J-1),SS); - } - return str_tb(0,SS); -} - -def fmult(FN,M,L,N) -{ - Opt=getopt(); - for(I = 0; I < length(M); I++) - M = call(FN, cons(M,cons(L[I],N))|option_list=Opt); - return M; -} - -def radd(P,Q) -{ - if(type(P) <= 3 || type(Q) <= 3){ - if(type(P) >= 5) - return radd(Q,P); - if(type(Q) >= 5){ - R = dupmat(Q); - if(P == 0) - return R; - if(type(Q) == 6){ - S = size(Q); - if(S[0] != S[1]) - return 0; - for(I = 0; I < S[0]; I++) - R[I][I] = radd(R[I][I], P); - }else{ - for(I = length(R)-1; I >= 0; I--) - R[I] = radd(R[I],P); - } - return R; - } - /* P=red(P);Q=red(Q); */ - if((P1=dn(P)) == (Q1=dn(Q))){ - if(P1==1) return P+Q; - return red((nm(P)+nm(Q))/P1); - } - R=gcd(P1,Q1);S=tdiv(P1,R); - return red((nm(P)*tdiv(Q1,R)+nm(Q)*S)/(S*Q1)); - } - if(type(P) == 5){ - S = length(P); - R = newvect(S); - for(I = 0; I < S; I++) - R[I] = radd(P[I],Q[I]); - return R; - } - if(type(P) == 6){ - S = size(P); - R = newmat(S[0],S[1]); - for(I = 0; I < S[0]; I++){ - for(J = 0; J < S[1]; J++) - R[I][J] = radd(P[I][J],Q[I][J]); - } - return R; - } - erno(0); -} - -def getel(M,I) -{ - if(type(M) >= 4 && type(M) <= 6 && type(I) <= 1) - return M[I]; - if(type(M) == 6 && type(I) == 5) - return M[I][J]; - return M; -} - -def ptol(P,X) -{ - F=(getopt(opt)==0)?0:1; - if(type(P) <= 3) - P = [P]; - if(type(X) == 4){ - for( ; X != []; X = cdr(X)) - P=ptol(P,car(X)|opt=F); - return P; - } - P = reverse(P); - for(R=[]; P != []; P = cdr(P)){ - Q = car(P); - for(I = mydeg(Q,X); I >= 0; I--){ - S=mycoef(Q,I,X); - if(F==1 || S!=0) R = cons(S,R); - } - } - return R; -} - -def rmul(P,Q) -{ - if(type(P) <= 3 && type(Q) <= 3){ - P=red(P);Q=red(Q); - P1=dn(P);P2=nm(P);Q1=dn(Q);Q2=nm(Q); - if(P1==1 && Q1==1) - return P*Q; - if((R=gcd(P1,Q2)) != 1){ - P1=tdiv(P1,R);Q2=tdiv(Q2,R); - } - if((R=gcd(Q1,P2)) != 1){ - Q1=tdiv(Q1,R);P2=tdiv(P2,R); - } - return P2*Q2/(P1*Q1); - } -#ifdef USEMODULE - return mmulbys(os_md.rmul,P,Q,[]); -#else - return mmulbys(rmul,P,Q,[]); -#endif -} - -def mtransbys(FN,F,LL) -{ - Opt=getopt(); - if(type(F) == 4){ - F = ltov(F); - S = length(F); - R = newvect(S); - for(I = 0; I < S; I++) - R[I] = mtransbys(FN,F[I],LL|option_list=Opt); - return vtol(R); - } - if(type(F) == 5){ - S = length(F); - R = newvect(S); - for(I = 0; I < S; I++) - R[I] = mtransbys(FN,F[I],LL|option_list=Opt); - return R; - } - if(type(F) == 6){ - S = size(F); - R = newmat(S[0],S[1]); - for(I = 0; I < S[0]; I++){ - for(J = 0; J < S[1]; J++) - R[I][J] = mtransbys(FN,F[I][J],LL|option_list=Opt); - } - return R; - } - if(type(F) == 7) return F; - return call(FN, cons(F,LL)|option_list=Opt); -} - -def drawopt(S,T) -{ - if(type(S)!=7) return -1; - if(T==0||T==1){ - for(I=0,R=LCOPT;I<7;I++,R=cdr(R)) - if(str_str(S,car(R))>=0) return(T==0)?COLOPT[I]:car(R); - return -1; - } - if(T==2){ - V0=V1=0; - for(I=0,R=LPOPT;R!=[];I++,R=cdr(R)){ - if(str_str(S,car(R))>=0){ - if(I==0) V1++; - else if(I==1) V1--; - else if(I==2) V0--; - else V0++; - } - } - if(V0==0&&V1==0) return -1; - return [V0,V1]; - } - if(T==3){ - V=0; - for(I=1,R=LFOPT;R!=[];R=cdr(R),I*=2){ - if(str_str(S,car(R))>=0) V+=I; - } - return (V==0)?-1:V; - } - return -1; -} - -def execdraw(L,P) -{ - if((Proc=getopt(proc))!=1) Proc=0; - if(type(P)<2) P=[P]; - if(L!=[]&&type(L[0])!=4) L=[L]; - /* special command */ - if(P[0]<0){ - if(length(P)==1&&(P[0]==-1||P[0]==-2||P[0]==-3)){ /* Bounding Box */ - W=WS=N=LS=0; - for(LL=L;LL!=[];LL=cdr(LL)){ - T=car(LL); - if(P[0]!=-3 && T[0]==0){ - if(length(T)>3) S=" by "+rtostr(T[3])+" cm"; - else S=""; - if(P[0]==-1){ - mycat(["Windows : ",T[1][0],"< x <",T[1][1],", ", - T[2][0],"< y <",T[2][1],S]); - if(length(T)>4 && type(T[4])==4) mycat(["ext :",T[4]]); - if(length(T)>5) mycat(["shift :",T[5]]); - } - return cdr(T); - } - if(type(T[0])==1){ - if(T[0]==1){ - for(TT=cdr(cdr(T));TT!=[];TT=cdr(TT)){ - D=car(TT); - if(type(D[0][0])==4){ - for(DT=D;DT!=[];DT=cdr(DT)){ - if(N++==0) W=ptbbox(car(DT)); - else W=ptbbox(car(DT)|box=W); - } - }else{ - if(N++==0) W=ptbbox(D); - else W=ptbbox(D|box=W); - } - } - }else if(T[0]==2){ - V=T[2]; - if(type(V[0])>1||type(V[1])>1) continue; /* not supported */ - if((Sc=delopt(T[1],"scale"|inv=1))!=[]){ - Sc=car(Sc)[1]; - if(type(Sc)==1) V=[Sc*V[0],Sc*V[1]]; - else V=[Sc[0]*V[0],Sc[1]*V[1]]; - } - if(LS==0) WS=ptbbox([V]); - else WS=ptbbox([V]|box=WS); - if(length(T)>4) S=T[4]; - else if(type(S=T[3])==4){ - S=S[0]; - if(type(S)==4) S=S[length(S)-1]; - S=rtostr(S); - } - if(str_len(S)>LS) LS=str_len(S); - }else if(T[0]==3||T[0]==4){ - if(N++==0) W=ptbbox(cdr(cdr(T))); - else W=ptbbox(cdr(cdr(T))|box=W); - } - } - } - if(W!=0&&WS!=0) W=ptbbox([W,WS]|box=1); - return (P[0]==-3)?[W,LS,WS]:W; - }else if(length(P)>1&&P[0]==-1){ /* set Bounding Box */ - P=cons(0,cdr(P)); - Ex=Sft=[0,0]; - if(type(X=getopt(ext))==4) Ex=X; - if(type(X=getopt(shift))==4) Sft=X; - if(Ex!=Sft||Ex!=[0,0]){ - if(Sft==[0,0]) Sft=[Ex]; - else Sft=[Ex,Sft]; - if(length(P)==3) Sft=cons(1,Sft); - if(length(P)==3||length(P)==4) P=append(P,Sft); - } - return cons(P,delopt(L,0)); - } - if(P[0]==-4){ - for(N=0,LT=L;LT!=[];LT=cdr(LT)){ /* count coord. */ - T=car(LT); - if(T[0]==1){ - for(T=cdr(cdr(T));T!=[];T=cdr(T)){ - if(type((S=car(T))[0][0])==4) N+=length(S); - else for(;S!=[];S=cdr(S)) if(type(car(S))==4) N++; - } - }else if(T[0]==2) N++; - else if(T[0]==3||T[0]==4) N+=2; - } - return N; - } - if(P[0]==-5){ /* functions */ - for(N=0,R=[],LT=L;LT!=[];LT=cdr(LT)){ - T=car(LT); - if(T[0]==0) N=ior(N,1); - else if(type(T[0])==1){ - if(T[0]>0) N=ior(N,2^T[0]); - } - else if(Type(T[0])==2){ - if(findin(T[0],R)<0) R=cons(T[0],R); - } - } - for(I=5;I>=0;I--) if(iand(N,2^I)) R=cons(I,R); - return R; - } - return 0; - } - - if(length(P)>1){ - if(type(P[1])==6||(type(P[1])<2&&P[1]>0)) M=P[1]; - else if(type(P[1])==4&&length(P[1])==2) M=diagm(2,P[1]); - } - if(length(P)>2&&type(P[2])==4){ - Org=[["shift",P[2]]]; - if(M==0) M=1; - }else Org=[]; - if(P[0]==0||(type(P[0])==4&&P[0][0]==0)){ /* Risa/Asir */ - PP=car(P);PPP=0; - if(type(PP)!=4) PP=[PP]; - if(length(PP)<3){ - if(length(PP)==1 || type(PP[1])==4){ - if(ID_PLOT<0) ID_PLOT=ox_launch_nox(0,"ox_plot"); - Id=ID_PLOT; - if(length(PP)==1&&type(Canvas)==4&&length(Canvas)==2) - PP=cons(PP[0],[Canvas]); - if(length(PP)>1){ - PPP=PP[1][0]; - PPQ=(length(PP[1])==2)?PP[1][1]:PPP; - open_canvas(Id,[PPP,PPQ]); - }else open_canvas(Id); - Ind=ox_pop_cmo(Id); - }else{ - Ind=PP[1]; - if(getopt(cl)==1) clear_canvas(Id,Ind); - } - }else{ - Id=PP[1];Ind=PP[2]; - if(length(PP)>3 && type(PP[3])==1) PPP=PP[3]; - if(length(PP)>4 && type(PP[4])==1) PPQ=PP[4]; - if(getopt(cl)==1) clear_canvas(Id,Ind); - } - if(L==[]) return (PPP>0)? [0,Id,Ind,PPP,PPQ]:[0,Id,Ind]; - Ex0=Ex0;Sft=[0,0]; - if(length(P)>1&&P[1]==0&&length(P)<4){ - R=execdraw(L,-3); - Ex0=Ex1=Ex2=10; - if((U=R[1])>0){ /* string */ - if(U>20) U=16; /* adj 16,8,2,7,15 */ - if(R[0][0][0]>R[2][0][0]-(R[0][0][1]-R[0][0][0])/256) Ex0+=8*U; /* adj 256 */ - else Ex0+=2*U; - if(R[0][0][1]<R[2][0][1]+(R[0][0][1]-R[0][0][0])/256) Ex1+=7*U; - else Ex1+=2*U; - if(R[0][1][1]<R[2][1][1]+(R[0][1][1]-R[0][1][0])/256) Ex2+=15; - } - R=[R[0][0],R[0][1],0,[Ex0,Ex1],[0,-Ex2]]; - if(length(P)>2 && P[2]==1) - mycat0(["Box:",[R[0],R[1]], ", ext=",R[3],", shift=",R[4]],1); - }else R=execdraw((length(P)>3)?P[3]:L,-2); /* Windows */ - XW=R[0];YW=R[1]; - if(length(R)>3){ - if(R[3]!=0 && R[3]!=[0,0]) Ex=R[3]; - if(length(R)>4) Sft=R[4]; - } - if(type(X=getopt(ext))==4) - Ex=(Ex0)?[X[0]+Ex[0],X[1]+Ex[1]]:X; - if(type(M)<2){ - if(length(P)>1&&type(P[1])==1) M=P[1]; - else if((length(P)==1||P[1]==0||P[1]==1)&& PPP>0) M=PPP; - if(M<2) M=400; - if(Ex!=0 && type(Ex)==4){ - M-=Ex[0]+Ex[1]; - } - M=(M/(XW[1]-XW[0]))*diagm(2,[1,-1]); - } - if(type(X=getopt(shift))==4) Sft=(Ex0)?[Sft[0]+X[0],Sft[1]+X[1]]:X; - if(type(Sft)==4) Sft=[Sft[0],-Sft[1]]; - if(Ex!=0) Sft=[Sft[0]+Ex[0],Sft[1]]; - Org=[["shift",ptaffine(M,[-XW[0],-YW[1]]|shift=Sft)]]; - for(CT=0;CT<2;CT++){ - for(LT=L;LT!=[];LT=cdr(LT)){ - T=car(LT); - if(!CT && T[0]!=2) continue; - if(CT && T[0]==2) continue; - if(T[0]==1){ - for(TT=cdr(cdr(T));TT!=[];TT=cdr(TT)){ - D=car(TT); - if(type(D[0][0])==4){ - for(DT=D;DT!=[];DT=cdr(DT)){ - V=car(DT); - if(M) V=ptaffine(M,V|option_list=Org); - draw_bezier(Id,Ind,V|option_list=T[1]); - } - }else{ - if(M) D=ptaffine(M,D|option_list=Org); - draw_bezier(Id,Ind,D|option_list=T[1]); - } - } - }else if(T[0]==2){ /* put */ - if(length(T)<4) continue; - V=T[2]; - if(type(VLB)==4&&V[0]=="_") V=VLB; - else if(type(V[0])>1||type(V[1])>1) continue; /* not supported */ - if(length(T)>3&&type(T[3])==4&&length(T[3])>1&&T[3][1]==1) VLB=V; - F++;MM=M; - if((Sc=delopt(T[1],"scale"|inv=1))!=[]){ - if(!MM) MM=1; - Sc=car(Sc)[1]; - if(type(Sc)==1) MM=MM*Sc; - else if(type(Sc)==6) MM=MM*diagm(2,Sc); - } - if(MM) V=ptaffine(MM,V|option_list=Org); - if(type(S=S0=T[3])==4) S=S0[0]; - if(length(T)>4) S=T[4]; /* subst. string */ - if(type(S0)==4&&type(S0[0])==4){ - if((Col=drawopt(S0[0][0],0))<0) Col=0; /* attrib. */ - if(type(S)!=7) S=rtostr(S0[0][1]); - S=str_subst(S,[["$\\bullet$","*"],["$\\times$","x"],["$",""]],0); - if(type(Pos=drawopt(S0[0][0],2))==4) - V=[V[0]+4*str_len(S)*Pos[0],V[1]-10*Pos[1]]; /* adjustable */ - }else S=str_subst(rtostr(S),[["$\\bullet$","*"],["$\\times$","x"],["$",""]],0); - V=[V[0]-str_len(S)*4,V[1]-8]; /* adjustable */ - draw_string(Id,Ind,V,S,Col); - }else if(T[0]==3){ /* arrow */ - F++; - T1=T[2];T2=T[3]; - if(M){ - T1=ptaffine(M,T1|option_list=Org); - T2=ptaffine(M,T2|option_list=Org); - } - draw_bezier(Id,Ind,[T1,T2]|option_list=T[1]); - }else if(T[0]==4){ /* line */ - F++; - T1=T[2];T2=T[3]; - if(M){ - T1=ptaffine(M,T1|option_list=Org); - T2=ptaffine(M,T2|option_list=Org); - } - V=delopt(T1=T[1],"opt"|inv=1); - if(V!=[]&&str_str(V[1],".")>=0) - T1=cons(["opt",cons("dotted,",V[1])],delopt(T1,"opt")); - draw_bezier(Id,Ind,[T1,T2]|option_list=T1); - }else if(T[0]==5){ /* TeX */ - mycat(rtostr(T[2])); - if(F){ - S=str_tb(0,Out); - Out=str_tb(0,0); - F=0; - if(S!=""){ - if(P[0]==2) dviout(xyproc(S)|keep=1); - else LOut=cons(xyproc(S),LOut); - } - if(P[0]==2) dviout(T[2]|option_list=T[1]); - else{ - LOut=cons(T[2],Out); - } - } - }else if(Proc==1&&type(T[0])==2){ - if(length(T)<3) call(T[0],T[1]); - else call(T[0],T[1]|option_list=T[2]); - } - } - } - S=(PPP>0)? [0,Id,Ind,PPP,PPQ]:[0,Id,Ind]; - if(Ex==0&&Sft!=[0,0]) Ex=[0,0]; - return (Ex!=0&&length(P)>2&&P[2]==-1)? - [S,0,0,[0,R[0],R[1],0,Ex,[Sft[0]-Ex[0],-Sft[1]]]]:S; - } - if(P[0]==1||P[0]==2){ /* TeX */ - Out=str_tb(0,0);LOut=[];F=0; - if(getopt(cl)==1) dviout0(0); - for(;L!=[];L=cdr(L)){ - T=car(L);Opt=T[1]; - if(type(T[0])>=2) continue; - if(T[0]==0){ - XW=T[1];YW=T[2]; - if(length(P)>1&&type(P[1])==1&&P[1]<0) - M=-P[1]/(XW[0]-XW[1]); - }else if(T[0]==1){ - F++; - for(TT=cdr(cdr(T));TT!=[];TT=cdr(TT)){ - D=car(TT); - if(type(D[0][0])==4){ - for(DT=D;DT!=[];DT=cdr(DT)){ - V=car(DT); - if(M) V=ptaffine(M,V|option_list=Org); - str_tb(xybezier(V|option_list=Opt),Out); - } - }else{ - if(M) D=ptaffine(M,D|option_list=Org); - str_tb(xybezier(D|option_list=Opt),Out); - } - } - }else if(T[0]==2){ - F++;V=T[2]; - Opt=delopt(Opt,"scale"|inv=1); - MM=M; - if(Opt!=[]){ - Opt=car(Opt)[1]; - if(type(Opt)==1) Opt=[Opt,Opt]; - if(Opt!=[1,1]){ - if(!MM) MM=1; - MM=MM*diagm(2,[Opt[0],Opt[1]]); - } - } - if(MM) V=ptaffine(MM,V|option_list=Org); - if(length(T)>3) V=append(V,T[3]); - str_tb(xyput(V),Out); - }else if(T[0]==3){ - F++; - T1=T[2];T2=T[3]; - if(M){ - T1=ptaffine(M,T1|option_list=Org); - T2=ptaffine(M,T2|option_list=Org); - } - str_tb(xyarrow(T1,T2|option_list=Opt),Out); - }else if(T[0]==4){ - F++; - T1=T[2];T2=T[3]; - if(M){ - T1=ptaffine(M,T1|option_list=Org); - T2=ptaffine(M,T2|option_list=Org); - } - str_tb(xyline(T1,T2|option_list=Opt),Out); - }else if(T[0]==5){ - if(F){ - S=str_tb(0,Out); - Out=str_tb(0,0); - F=0; - if(S!=""){ - if(P[0]==2) dviout(xyproc(S)|keep=1); - else LOut=cons(xyproc(S),LOut); - } - if(P[0]==2) dviout(T[2]|option_list=T[1]); - else LOut=cons(T[2],Out); - } - }else if(T[0]==-2) - str_tb(["%",T[1],"\n"],Out); - else if(Proc==1&&type(T[0])==2){ - if(length(T)<3) call(T[0],T[1]); - else call(T[0],T[1]|option_list=T[2]); - } - } - S=str_tb(0,Out); - if(P[0]==1){ - if(F) LOut=cons(xyproc(S),LOut); - Out=str_tb(0,0); - for(L=reverse(LOut);L!=[];L=cdr(L)) - str_tb(car(L),Out); - return str_tb(0,Out); - } - if(F) dviout(xyproc(S)); - else dviout(" "); - } -} - -def execproc(L) -{ - if(type(N=getopt(var))!=1&&N!=0) N=2; - for(R=[];L!=[];L=cdr(L)){ - P=car(L); - if(type(P[0])==2&&vtype(P[0])==3){ - if((VS=vars(cdr(P)))!=[]){ - for(I=0;I<N;I++){ - V=makev(["v",I+1]); - if(findin(V,VS)>=0) P=mysubst(P,[V,R[I]]); - } - } - if(length(P)<3) R=cons(call(P[0],P[1]),R); - else R=cons(call(P[0],P[1]|option_list=P[2]),R); - } - } - return (getopt(all)==1)?R:car(R); -} - -def myswap(P,L) -{ - X=makenewv(P); - for(L=reverse(L);length(L)>1;L=cdr(L)) - P=subst(P,L[0],X,L[1],L[0],X,L[1]); - return P; -} - -def mysubst(P,L) -{ - if(P==0) return 0; - Inv=getopt(inv); - if(type(L[0]) == 4){ - while((L0 = car(L))!=[]){ - P = mysubst(P,(Inv==1)?[L0[1],L0[0]]:L0); - L = cdr(L); - } - return P; - } - if(Inv==1) L=[L[1],L[0]]; - if(type(P) > 3){ - if(type(P)==7) return P; - if(type(P)>7) - return subst(P,L[0],L[1]); -#ifdef USEMODULE - return mtransbys(os_md.mysubst,P,[L]); -#else - return mtransbys(mysubst,P,[L]); -#endif - } - P = red(P); - if(type(P) == 3){ - A=mysubst(nm(P),L);B=mysubst(dn(P),L); - return red(nm(A)/nm(B))*red(dn(B)/dn(A)); - } - L1=(type(L[1])==3)?red(L[1]):L[1];X=L[0]; - if(ptype(L1,X)==3){ - LN=nm(L1);LD=dn(L1); - Deg=mydeg(P,X); - if(Deg <= 0) return P; - V = newvect(Deg+1); - for(V[I=Deg]=1;I >= 1;I--) - V[I-1]=V[I]*LD; - for(R = 0, I = Deg; I >= 0; I--) - R = R*LN + mycoef(P,I,X)*V[I]; - return red(R/V[0]); - } - return subst(P,X,L1); -} - -def mmulbys(FN,P,F,L) -{ - Opt=getopt(); - if(type(F) <= 3){ - if(type(P) <= 3) - return call(FN, cons(P,cons(F,L))|option_list=Opt); - if(type(P) == 5){ - S = length(P); - R = newvect(S); - for(I = 0; I < S; I++) - R[I] = call(FN, cons(P[I],cons(F,L))|option_list=Opt); - return R; - }else if(type(P) == 6){ - S = size(P); - R = newmat(S[0],S[1]); - for(I = 0; I < S[0]; I++){ - for(J = 0; J < S[1]; J++) - R[I][J] = call(FN, cons(P[I][J],cons(F,L))|option_list=Opt); - } - return R; - } - } - if(type(F) == 5){ - S = length(F); - if(type(P) <= 3){ - R = newvect(S); - for(I = 0; I < S; I++) - R[I] = call(FN, cons(P,cons(F[I],L))|option_list=Opt); - return R; - } - if(type(P) == 5){ - for(J=R=0; J<S; J++) - R = radd(R, call(FN, cons(P[J],cons(F[J],L)))|option_list=Opt); - return R; - } - T = size(P); - R = newvect(T[0]); - for(I = 0; I < T[0]; I++){ - for(J = 0; J < S; J++) - R[I] = radd(R[I], call(FN, cons(P[I][J],cons(F[J],L))|option_list=Opt)); - } - return R; - } - if(type(F) == 6){ - S = size(F); - if(type(P) <= 3){ - R = newmat(S[0],S[1]); - for(I = 0; I < S[0]; I++){ - for(J = 0; J < S[1]; J++) - R[I][J] = call(FN, cons(P,cons(F[I][J],L))|option_list=Opt); - } - return R; - } - if(type(P) == 5){ - R = newvect(S[1]); - for(J = 0; J < S[1]; J++){ - for(K = U = 0; K < S[0]; K++) - U = radd(U, call(FN, cons(P[K],cons(F[K][J],L))|option_list=Opt)); - R[J] = U; - } - return R; - } - T = size(P); - R = newmat(T[0],S[1]); - for(I = 0; I < T[0]; I++){ - for(J = 0; J < S[1]; J++){ - for(K = U = 0; K < S[0]; K++) - U = radd(U, call(FN, cons(P[I][K],cons(F[K][J],L)|option_list=Opt))); - R[I][J] = U; - } - } - return R; - } - erno(0); - return 0; -} - -def appldo(P,F,L) -{ - if(type(F) <= 3){ - if(type(L) == 4 && type(L[0]) == 4) - return applpdo(P,F,L); - L = vweyl(L); - X = L[0]; DX = L[1]; - J = mydeg(P,DX); - for(I = R = 0; I <= J; I++){ - if(I > 0) - F = mydiff(F,X); - R = radd(R,mycoef(P,I,DX)*F); - } - return R; - } -#ifdef USEMODULE - return mmulbys(os_md.appldo,P,F,[L]); -#else - return mmulbys(appldo,P,F,[L]); -#endif -} - -def appledo(P,F,L) -{ - if(type(F) <= 3){ - L = vweyl(L); - X = L[0]; DX = L[1]; - J = mydeg(P,DX); - for(I = R = 0; I <= J; I++){ - if(I > 0) - F = myediff(F,X); - R = radd(R,mycoef(P,I,DX)*F); - } - return R; - } -#ifdef USEMODULE - mmulbys(os_md.appledo,P,F,[L]); -#else - mmulbys(appledo,P,F,[L]); -#endif -} - -def muldo(P,Q,L) -{ - if(type(Lim=getopt(lim))!=1) Lim=100; - if(type(Q) <= 3){ - if(type(L) == 4 && type(L[0]) == 4) - return mulpdo(P,Q,L|lim=Lim); /* several variables */ - R = rmul(P,Q); - L = vweyl(L); - X = L[0]; DX = L[1]; - if(X != 0){ - for(I = F = 1; ; I++){ - P = mydiff(P,DX); - if(I>Lim){ - mycat(["Over", Lim,"derivations!"]); - break; - } - if(P == 0) - break; - Q = mydiff(Q,X); - if(Q == 0) - break; - F *= I; - R = radd(R,P*Q/F); - } - } - return R; - } -#ifdef USEMODULE - return mmulbys(os_md.muldo,P,Q,[L]); -#else - return mmulbys(muldo,P,Q,[L]); -#endif -} - -def jacobian(F,X) -{ - F=ltov(F);X=ltov(X); - N=length(F); - M=newmat(N,N); - for(I=0;I<N;I++) - for(J=0;J<N;J++) M[I][J]=red(diff(F[I],X[J])); - if(getopt(mat)==1) return M; - return mydet(M); -} - -def hessian(F,X) -{ - X=ltov(X); - N=length(X); - M=newmat(N,N); - for(I=0;I<N;I++){ - G=red(diff(F,X[I])); - for(J=0;J<N;J++) M[I][J]=red(diff(G,X[J])); - } - if(getopt(mat)==1) return M; - return mydet(M); -} - -def wronskian(F,X) -{ - N=length(F); - M=newmat(N,N); - for(I=0;F!=[];F=cdr(F),I++){ - M[I][0]=car(F); - for(J=1;J<N;J++) M[I][J]=red(diff(M[I][J-1],X)); - } - if(getopt(mat)==1) return M; - return mydet(M); -} - -def adj(P,L) -{ - if(type(P) == 4) -#ifdef USEMODULE - return map(os_md.adj,mtranspose(P),L); -#else - return map(adj,mtranspose(P),L); -#endif - if(type(L) == 4 && type(L[0]) == 4) -#ifdef USEMODULE - return fmult(os_md.adj,P,L,[]); -#else - return fmult(adj,P,L,[]); -#endif - L = vweyl(L); - X = L[0]; DX = L[1]; - P = R = subst(P, DX, -DX); - for(I = 1; (R = mydiff(mydiff(R, X), DX)/I) != 0 && I < 100; I++) - P = radd(P,R); - return P; -} - -def laplace1(P,L) -{ - if(type(L) == 4 && type(L[0]) == 4) -#ifdef USEMODULE - return fmult(os_md.laplace,P,L,[]); -#else - return fmult(laplace,P,L,[]); -#endif - L = vweyl(L); - X = L[0]; DX = L[1]; - P = adj(P, L); - return subst(P,X,o_1,DX,X,o_1,DX); -} - -def laplace(P,L) -{ - if(type(L) == 4 && type(L[0]) == 4) -#ifdef USEMODULE - return fmult(os_md.laplace1,P,L,[]); -#else - return fmult(laplace1,P,L,[]); -#endif - L = vweyl(L); - X = L[0]; DX = L[1]; - P = adj(P, L); - return subst(P,X,o_1,DX,-X,o_1,-DX); -} - -def mce(P,L,V,R) -{ - L = vweyl(L); - X = L[0]; DX = L[1]; - P = sftexp(laplace1(P,L),L,V,R); - return laplace(P,L); -} - -def mc(P,L,R) -{ - return mce(P,L,0,R); -} - -def rede(P,L) -{ - Q = ltov(fctr(nm(red(P)))); - P = 1; - if(type(L) < 4) - L = [L]; - if(type(L[0]) < 4) - L = [L]; - for( ; L != []; L = cdr(L)){ - DX = vweyl(car(L))[1]; - for(I = 1; I < length(Q); I++){ - if(mydeg(Q[I][0],DX) > 0){ - P *= (Q[I][0])^(Q[I][1]); - Q[I]=[1,0]; - } - } - } - return P; -} - -def ad(P,L,R) -{ - L = vweyl(L); - DX = L[1]; - K = mydeg(P,DX); - S = mycoef(P,0,DX); - Q = 1; - for(I=1; I <= K;I++){ - Q = muldo(Q,DX-R,L); - S = radd(S,mycoef(P,I,DX)*Q); - } - return S; -} - -def add(P,L,R) -{ - return rede(ad(P,L,R),L); -} - - -def vadd(P,L,R) -{ - L = vweyl(L); - if(type(R) != 4) - return 0; - N = length(R); - DN = 1; Ad = PW = 0; - for( ; R != []; R = cdr(R), PW++){ - DN *= (T=1-car(R)[0]*L[0]); - Ad = Ad*T-car(R)[1]*x^PW; - } - Ad /= DN; - return add(P,L,Ad); -} - -def addl(P,L,R) -{ - return laplace1(add(laplace(P,L),L,R),L); -} - -def cotr(P,L,R) -{ - L = vweyl(L); - X = L[0]; DX = L[1]; - T = 1/mydiff(P,DX); - K = mydeg(P,DX); - S = mysubst(mycoef(P,0,DX), [X, R]); - Q = 1; - for(I = 1; I <= K; I++){ - Q = muldo(Q, K*DX, L); - S = radd(S,mysubst(mycoef(P,I,DX), [X, R])*Q); - } -} - -def rcotr(P,L,R) -{ - return rede(cotr(P,L,R), L); -} - -def muledo(P,Q,L) -{ - if(type(Q)>3) -#ifdef USEMODULE - return mmulbys(os_md.muledo,P,Q,[L]); -#else - return mmulbys(muledo,P,Q,[L]); -#endif - R = P*Q; - L = vweyl(L); - X = L[0]; DX = L[1]; - for(I = F = 1; I < 100; I++){ - P = mydiff(P,DX); - if(P == 0) - break; - Q = myediff(Q,X); - if(Q == 0) - break; - F = rmul(F,I); - R = radd(R,P*Q/F); - } - return R; -} - - -#if 1 -def mulpdo(P,Q,L) -{ - if(type(Q)>3) -#ifdef USEMODULE - return mmulbys(os_md.mulpdo,P,Q,[L]); -#else - return mmulbys(mulpdo,P,Q,[L]); -#endif - if(type(Lim=getopt(lim))!=1) Lim=100; - M = vweyl(car(L)); X= M[0]; DX = M[1]; - L = cdr(L); - R = 0; - for(I = 0; Q != 0 && I <= Lim; I++){ - if(I>Lim){ - mycat(["Over", Lim,"derivations!"]); - break; - } - if(I > 0) - P /= I; - if(length(L)==0) - R = radd(R,P*Q); - else - R = radd(R,mulpdo(P,Q,L)); - if(X==0) break; - P = mydiff(P,DX); - if(P == 0) - break; - Q = mydiff(Q,X); - } - if(I>Lim) mycat(["Over", Lim,"derivations!"]); - return R; -} - -#else -def mulpdo(P,Q,L); -{ - if(type(Q)>3) -#ifdef USEMODULE - return mmulbys(os_md.mulpdo,P,Q,[L]); -#else - return mmulbys(mulpdo,P,Q,[L]); -#endif - if(type(Lim=getopt(lim))!=1) Lim=100; - N = length(L); - VO = newvect(2*N); - VN = newvect(2*N); - for(I = J = 0; I < N; J += 2, I++){ - M = vweyl(L[I]); - P = subst(P, VO[J]=M[0], VN[J]=strtov("o_"+rtostr(V[J])), - VO[J+1]=M[1], VN[J+1] = strtov("o_"+rtostr(V[J+1]))); - } - for(PQ = P*Q, I = 0; I < 2*N; I += 2){ - for(R = PQ, J = 1; J < Lim; J++){ - R = mydiff(R, VN[I+1])/J; - if(R == 0) - break; - R = mydiff(R, VO[I]); - if(R == 0) - break; - PQ = radd(PQ,R); - } - if(I==Lim) mycat(["Over", Lim,"derivations!"]); - PQ = red(subst(PQ,VN[I],VO[I],VN[I+1],VO[I+1])); - } -} -#endif - -def transpdosub(P,LL,K) -{ - Len = length(K)-1; - if(Len < 0 || P == 0) - return P; - KK=K[Len]; - if(type(KK)==4){ - KK0=KK[0]; KK1=KK[1]; - }else{ - L = vweyl(LL[Len]); - KK0=L[1]; KK1=K[Len]; - } - Deg = mydeg(P,KK0); - K1 = reverse(cdr(reverse(K))); - R = transpdosub(mycoef(P,0,KK0),LL,K1); - for(I = M = 1; I <= Deg ; I++){ - M = mulpdo(M,KK1,LL); - S = mycoef(P,I,KK0); - if(Len > 0) - S = transpdosub(S,LL,K1); - R = radd(R,mulpdo(S,M,LL)); - } - return R; -} - -def transpdo(P,LL,K) -{ - if(type(K[0]) < 4) - K = [K]; - Len = length(K)-1; - K1=K2=[]; - if(type(LL)!=4) LL=[LL]; - if(type(LL[0])!=4) LL=[LL]; - if(getopt(ex)==1){ - for(LT=LL, KT=K; KT!=[]; LT=cdr(LT), KT=cdr(KT)){ - L = vweyl(LL[J]); - K1=cons([L[0],car(KT)[0]],K1); - K2=cons([L[1],car(KT)[1]],K2); - } - K2=append(K1,K2); - }else{ - for(J = length(K)-1; J >= 0; J--){ - L = vweyl(LL[J]); - if(L[0] != K[J][0]) - K1 = cons([L[0],K[J][0]],K1); - K2 = cons(K[J][1],K2); - } - P = mulsubst(P, K1); - } - return transpdosub(P,LL,K2); -} - -def translpdo(P,LL,M) -{ - S=length(LL); - L0=newvect(S);L1=newvect(S); - K=newvect(S); - for(J=0;J<S;J++){ - L = vweyl(LL[J]); - L0[J]=L[0]; - L1[J]=L[1]; - } - K=rmul(M,L0); - for(T=[],J=0;J<S;J++) - T=cons([L0[J],K[J]],T); - P=mulsubst(P,T); - K=rmul(myinv(M),L1); - for(T=[],J=0;J<S;J++) - T=cons([L1[J],K[J]],T); - return mulsubst(P,T); -} - -/* - return [R, M, S] : R = M*P - S*Q - deg(R,X) < deg(Q,X) -*/ -def rpdiv(P,Q,X) -{ - if(P == 0) - return [0,1,0]; - DQ = mydeg(Q,X); - CO = mycoef(Q,DQ,X); - S = 0; - while((DP = mydeg(P,X)) >= DQ){ - R = mycoef(P,DP,X)/CO; - S = radd(S,R*X^(DP-DQ)); - P = radd(P, -R*Q*X^(DP-DQ)); - } - Lcm = lcm(dn(S),dn(P)); - Gcd = gcd(nm(S),nm(P)); - return [red(P*Lcm/Gcd), red(Lcm/Gcd),red(S*Lcm/Gcd)]; -} - -def texbegin(T,S) -{ - if(type(Opt=getopt(opt))==7) Opt="["+Opt+"]\n"; - else Opt="\n"; - return "\\begin{"+T+"}"+Opt+S+"%\n\\end{"+T+"}\n"; -} - -def mygcd(P,Q,L) -{ - if((Dvi=getopt(dviout))==3 || Dvi==-3){ /* dviout=3 */ - if((Rev=getopt(rev))!=1) Rev=0; - R=mygcd(P,Q,L|rev=Rev); - if(type(L)<2) Var=0; - else if(type(L)==2){ - Val=L;L=[0,L]; - }else if(type(L)==4){ - L=vweyl(L); - Var=[[L[1],"\\partial"]]; - } - S=mat([P],[Q]);T=mat([R[0]],[0]); - M=mat([R[1],R[2]],[R[3],R[4]]); - if(type(Val)==4) - N=mdivisor(M,L|trans=1)[1]; - else N=myinv(M); - Tb=str_tb(mtotex(S|var=Var),0); - str_tb("&="+mtotex(N|var=Var)+mtotex(T|var=Var)+",\\\\\n",Tb); - str_tb(mtotex(T|var=Var),Tb); - str_tb("&="+mtotex(M|var=Var)+mtotex(S|var=Var)+".",Tb); - Out=str_tb(0,Tb); - if(Dvi<0) return Out; - dviout(Out|eq="align*"); - return 1; - } - if((type(Dvi)==1||Dvi==0) && getopt(rev)!=1) V=[[P,Q]]; - else V=0; - if(L==0){ /* integer case */ - if(type(P) > 1 || type(Q) > 1 || Q==0 /* P <= 0 || Q <= 0 */ - || dn(P) > 1 || dn(Q) > 1) - return 0; - CPP = CQQ = 1; CQP = CPQ = 0; - P1 = P; Q1 = Q; - /* P1 = CPP*P + CPQ*Q - Q1 = CQP*P + CQQ*Q */ - while(Q1 != 0){ - Div1 = idiv(P1,Q1); Div2 = irem(P1,Q1); - if(type(V)==4) V=cons([Div1,Div2],V); - P1 = Q1 ; Q1 = Div2; - TP = CQP; TQ = CQQ; - CQP = CPP-Div1*CQP; - CQQ = CPQ-Div1*CQQ; - CPP = TP; CPQ = TQ; - } - if(V!=0){ - V=reverse(V); - if((DVI=abs(Dvi))==0) return V; - PT=P;QT=Q; - if(DVI==1 || DVI==2){ - Tb=str_tb(0,0); - for(C=0,V=cdr(V);V!=[];V=cdr(V)){ - T=car(V); - if(C++) str_tb(texcr(11),Tb); - if(DVI==1){ - Qs=rtostr(QT); - if(QT<0) Qs="("+Qs+")"; - if(T[1]>0) Qs=Qs+"+"; - if(T[1]!=0) Qs=Qs+rtostr(T[1]); - str_tb(rtostr(PT)+"&=" - +rtostr(T[0])+"\\times"+Qs,Tb); - }else{ - N=mat([T[0],1],[1,0]); - if(C==1){ - str_tb(S0=mtotex(mat([PT],[QT])),Tb); - M=N; - } - str_tb("&=",Tb); - if(C>1) str_tb(mtotex(M),Tb); - str_tb(mtotex(N),Tb); - str_tb(S=mtotex(mat([QT],[T[1]])),Tb); - if(C>1){ - str_tb("=",Tb); - str_tb(mtotex(M=M*N),Tb); - str_tb(S,Tb); - } - } - PT=QT;QT=T[1]; - } - if(DVI==2){ - str_tb(texcr(43)+S+"&=",Tb); - str_tb(mtotex(myinv(M)),Tb); - str_tb(S0,Tb); - } - Out=str_tb(0,Tb); - if(Dvi>0){ - dviout(Out|eq="align*"); - return 1; - } - return Out; - } - } - if(P1<0) return [-P1,-CPP,-CPQ,CQP,CQQ]; - return [P1, CPP, CPQ, CQP, CQQ]; - } - if(type(L) == 2) /* polynomical case */ - L = [0,L]; - if(getopt(rev)==1 && L[0]!=0){ - R=mygcd(adj(P,L),adj(Q,L),L); - return [adj(R[0],L),adj(R[1],L),adj(R[2],L),adj(R[3],L),adj(R[4],L)]; - } - if(type(P) == 3) - P = red(P); - if(type(Q) == 3) - Q = red(Q); - CP=newvect(2,[1/dn(P),0]); CQ=newvect(2,[0,1/dn(Q)]); - P=PT=nm(P); Q =QT=nm(Q); - L = vweyl(L); - while(Q != 0){ - R = divdo(P,Q,L); - if(type(V)==4) V=cons(R,V); -/* R[1] = R[2]*P - R[0]*Q - = R[2]*(CP[0]*P0+CP[1]*Q0) - R[0]*(CQ[0]*P0+CQ[1]*Q0) */ -/* - P(n) |0 1 | P(n-1) - = | | - R[1] |R[2] -R[0]| P(n) - P(n+1) = R[1], P(n) = P, P(n-1) = Q -*/ - P = Q; - Q = R[1]; - { - CT = dupmat(CQ); - CQ = [R[2]*CP[0]-muldo(R[0],CQ[0],L), - R[2]*CP[1]-muldo(R[0],CQ[1],L)]; - CP = CT; - } - } - if(V!=0){ - V=reverse(V); - if((DVI=abs(Dvi))==0) return V; - if(type(L[0])<1) Var=L[1]; - else Var=[L[1],"\\partial"]; - if(DVI==1 || DVI==2){ - Tb=str_tb(0,0); - PT=car(V)[0];QT=car(V)[1]; - for(C=0,V=cdr(V);V!=[];V=cdr(V)){ - T=car(V); - if(C++) str_tb(texcr(11),Tb); - if(DVI==1){ - if(T[2]!=1){ - str_tb(monototex(T[2]),Tb); - str_tb("(",Tb); - str_tb(fctrtos(PT|var=Var,TeX=2),Tb); - str_tb(")&=",Tb); - }else{ - str_tb(fctrtos(PT|var=Var,TeX=2),Tb); - str_tb("&=",Tb); - } - str_tb("(",Tb); - str_tb(fctrtos(T[0]|var=Var,TeX=2),Tb); - str_tb(")(",Tb); - str_tb(fctrtos(QT|var=Var,TeX=2),Tb); - if(T[1]!=0){ - str_tb(")+(",Tb); - str_tb(fctrtos(T[1]|var=Var,TeX=2),Tb); - } - str_tb(")",Tb); - }else{ - N=mat([red(T[0]/T[2]),1],[1,0]); - if(C==1){ - str_tb(S0=mtotex(mat([PT],[QT])|var=Var),Tb); - M=N; - } - str_tb("&=",Tb); - if(C>1) str_tb(mtotex(M),Tb); - str_tb(mtotex(N|var=Var),Tb); - str_tb(S=mtotex(mat([QT],[T[1]])|var=Var),Tb); - if(C>1){ - str_tb("=",Tb); - str_tb(mtotex(M=muldo(M,N,L)|var=Var),Tb); - str_tb(S,Tb); - } - } - PT=QT;QT=T[1]; - } - if(DVI==2){ - FT=fctr(PT); - for(R=1;FT!=[];FT=cdr(FT)){ - if(mydeg(car(FT)[0],L[1])<1) - for(J=car(FT)[1];J>0;J--) R*=car(FT)[0]; - } - if(R!=1){ - str_tb(texcr(79),Tb); - M=muldo(M,mat([R,0],[0,1]),L); - str_tb(mtotex(M|var=Var),Tb); - str_tb(S=mtotex(mat([PT/R],[QT])|var=Var),Tb); - } - str_tb(texcr(43)+S+"&=",Tb); - if(type(Var)==4){ - N=mdivisor(M,L|trans=1); - N=N[1]; - }else - N=myinv(M); - str_tb(mtotex(N|var=Var),Tb); - str_tb(S0,Tb); - } - Out=str_tb(0,Tb); - if(Dvi>0){ - dviout(Out|eq="align*"); - return 1; - } - return Out; - } - } - Q = rede(P,L); - R = red(P/Q); - return [Q,red(CP[0]/R),red(CP[1]/R),red(CQ[0]/R),red(CQ[1]/R)]; -} - -def mylcm(P,Q,L) -{ - Rev=(getopt(rev)==1)?1:0; - if(Rev==1){ - P=adj(P); Q=adj(Q); - } - R = mygcd(P,Q,L); - S=(type(L)<=2)?R[3]*P:muldo(R[3],P,L); - S = nm(S); - if(type(S) <= 1 && type(L) <= 1){ - if(S<0) S = -S; - return S; - } - if(type(L) == 2) - return easierpol(S,L); - S=rede(easierpol(S,L[1]),L); - return (Rev==1)?adj(S):S; -} - -def sftpexp(P,LL,F,Q) -{ - if(type(LL[0]) < 4) - LL = [LL]; - for(L0=L1=[],LT=LL;LT!=[];LT=cdr(LT)){ - W=vweyl(car(LT)); - L0=cons(W,L0); - D=mydiff(F,W[0]); - if(D!=0) L1=cons(W[1]+Q*D/F,L1); - else L1=cons(W[1],L1); - } - return rede(transpdosub(P,L0,L1),L0); -} - -def applpdo(P,F,LL) -{ - if(type(F)>3) -#ifdef USEMODULE - return mmulbys(os_md.applpdo,P,F,[LL]); -#else - return mmulbys(applpdo,P,F,[LL]); -#endif - L = vweyl(LL[0]); - LL = cdr(LL); - Deg = deg(P,L[1]); - S = F; - for(I = R = 0; I <= Deg ; I++){ - if(I > 0) - S = mydiff(S,L[0]); - if(LL == []) - R = radd(R,mycoef(P,I,L[1])*S); - else - R = radd(R,applpdo(mycoef(P,I,L[1]), S, LL)); - } - return R; -} - -def tranlpdo(P,L,M) -{ - N = length(L); - R = size(M); - if(R[0] != N || R[1] != N){ - print("Strange size"); - return; - } - InvM = M; - if(InvM[1] == 0){ - print("Not invertible"); - return; - } - XL = newvector(N); - DL = newvector(N); - for(I = 0; I < 0; I++){ - R = vweyl(L[I]); - XL[I] = R[0]; - DL[I] = R[1]; - } - for(I = 0; I < N; I++){ - for(J = XX = D0 = 0; J < N; J++){ - XX = radd(XX,M[I][J]*XL[J]); - DD = radd(DD, red(InvM[0][I][J]/InvM[1])*DL[J]); - P = mysubst(P,[[XL[I],XX],[DL[I],DD]]); - } - } - return P; -} - -def divdo(P,Q,L) -{ - if(L==0){ - R=P-idiv(P,Q)*Q; - if(R<0){ - if(Q>0) R+=Q; - else R-=Q; - } - return [(P-R)/Q,R,1]; - } - L = vweyl(L); - if(getopt(rev)==1){ - R=divdo(adj(P,L),adj(Q,L),L); - return [adj(R[0],L),adj(R[1],L),R[2]]; - } - X = L[0]; DX = L[1]; - S = 0; - M = 1; - I = mydeg(Q,DX); - CQ = mycoef(Q,I,DX); - while((J=mydeg(P,DX)) >= I){ - C = mycoef(P,J,DX); - SR = red(C/CQ); - if(dn(SR) != 1){ - M *= dn(SR); - P *= dn(SR); - S *= dn(SR); - SR = nm(SR); - } - P -= muldo(SR*(DX)^(J-I),Q,L); - S += SR*(DX)^(J-I); - } - return [S,P,M]; -} - -def qdo(P,Q,L) -{ - L = vweyl(L); DX = L[1]; OD = deg(P,DX); - V = newvect(OD+1); - for(I = 0; I <= OD; I++){ - if(I) - Q = muldo(DX,Q,L); - S = divdo(Q,P,L); - V[I] = S[1]*DX-S[2]*zz^I; - } - for(K = [], I = OD; I >= 0; I--) - K = cons(DX^(I+1), K); - R = lsol(V,K); - S = length(R); - for(I = P1 = 0; I < S; I++){ - if(type(R[I]) < 4 && mydeg(R[I],DX) == 0 && R[I] != 0 - && (mydeg(R[I],zz) <= mydeg(P,DX))) - P1 = R[I]; - else if(type(R[I]) == 4 && R[I][0] == DX) - P2 = R[I][1]; - } - T=fctr(P1); - for(I=0, S=length(T), P1=1; I<S; I++){ - if(mydeg(T[I][0],zz) > 0) - P1 *= T[I][0]^(T[I][1]); - } - return subst([P1,P2],zz,DX); -} - -def sqrtdo(P,L) -{ - L = vweyl(L); - P = toeul(P,L,0); - V = -1; - for(R = 0, Ord = mydeg(P,L[1]); Ord >= 0; Ord--){ - Q = coef(P,Ord,L[1]); - M = mydeg(Q,L[0]); - N = mymindeg(Q,L[0]); - if(V < 0) - V = M+N; - else if(V != M+N){ - print("Cannot be transformed!"); - return; - } - Q = tohomog(red(Q/L[0]^N), [L[0]], z_z); - if(irem(Ord,2)) - B = x-z_z; - else - B = x+z_z; - Q = substblock(Q,x,B,z_zz); - if(mydeg(Q,x) > 0){ - print("Cannot be transformed!"); - return; - } - R += mysubst(Q,[z_zz,x])*L[1]^Ord; - } - return fromeul(R,L,0); -} - -def ghg(A,B) -{ - R = dx; - while(length(B)>0){ - R = muldo(x*dx+car(B),R,[x,dx]); - B = cdr(B); - } - T = 1; - while(length(A)>0){ - T = muldo(x*dx+car(A),T,[x,dx]); - A = cdr(A); - } - return R-T; -} - -def ev4s(A,B,C,S,T) -{ - R4 = x^2*(x-1)^2; - R3 = x*(x-1)*((2*A-2*B-8)*x-2*A+5); - R2 = (-3/2*(A^2+B^2)+3*A*B+9*A-9*B-29/2+1/4*(S^2+T^2))*x^2 - +(5*A^2/2-13*A-3*A*B+B^2/2+7*B-C^2+C+35/2 - 1/4*(S^2+T^2))*x - - (2*A+2*C-5)*(2*A-2*C-3)/4; - R1 = 1/4*(A-B-2)*(2*A^2-4*A*B-8*A+2*B^2+8*B+10-S^2-T^2)*x - +15/4+3*B^2/4-C^2/2+11*A^2/4 - 11*A/2+3*B+B*C-7*A*B/2+C/2-A*B^2/2 -#if 1 - + A^2*B -#endif - - B*C^2 - A^3/2+(2*A-3)*(S^2+T^2)/8; -/* OK? for the above term added */ - R0 = -(A-B-1-S)*(A-B-1+S)*(A-B-1-T)*(A-B-1+T)/16; - return (R4*dx^4-R3*dx^3-R2*dx^2-R1*dx-R0); -} - -def b2e(A,B,C,S,T) -{ - R4 = x^2*(x-1)^2; - R3 = x*(x-1)*(2*x-1)*(2*c-5); - R2 = (-6*C^2+24*C-25+1/2*S^2+1/2*T^2)*x^2 - +(6*C^2-24*C+25-1/2*S^2-1/2*T^2-A^2+B^2+A-B)*x - +A^2-C^2-A+4*C-15/4; - R1 = (2*C-3)*(2*C^2-6*C+5-1/2*S^2-1/2*T^2)*x - +(2*C-3)*(-C^2+3*C+1/2*A^2-1/2*B^2+1/2*B-1/2*A-5/2+1/4*S^2+1/4*T^2); - R0 = -(2-2*C+S+T)*(2-2*C-S-T)*(2-2*C+S-T)*(2-2*C-S+T)/16; - return (R4*dx^4-R3*dx^3-R2*dx^2-R1*dx-R0); -} - - -/* - T^m = T(T-1)....(T-m+1) - f(t) -> g(t) - - f(t) = a_mt^m + ... + a_1t+a_0 - g(x*dx) = a_m*x^m*dx^m + ... + a_1*x*dx+a_0 - - ret: x(x-1)...(x-i+1) - */ -def sftpow(X,I) -{ - R = 1; - for(J=0;J<I;J++) - R *= X-J; - return(R); -} - -/* - ret: x(x+K)(x+2*k)...(x+(i-1)*k) -*/ -def sftpowext(X,I,K) -{ - R = 1; - for(J=0;J<I;J++) - R *= X+K*J; - return(R); -} - -def polinsft(F,A) -{ - R = 0; - while(F != 0){ - D = mydeg(F,A); - C = mycoef(F,D,A); - R += C*A^D; - F -= C*sftpow(A,D); - } - return R; -} - -def pol2sft(F,A) -{ - S=getopt(sft); - if(type(S)<0 || type(S)>2) S=1; - R = 0; - for(I = mydeg(F,A); I >= 0; I--) - R = R*(A-I*S) + mycoef(F,I,A); - return R; -} - -def binom(P,N) -{ - if(type(N)!=1 || N<=0) return 1; - for(S=1;N>0;N--,P-=1) S*=P/N; - return red(S); -} - -def expower(P,R,N) -{ - if(type(N)!=1 || N<0) return 0; - for(S=S0=K=1;K<=N;K++,R-=1){ - S0*=P*R/K;S+=S0; - } - return red(S); -} - -def seriesHG(A,B,X,N) -{ - if(N==0) return 1; - if(type(N)!=1 || N<0) return 0; - if(type(X)<4){ - for(K=0,S=S0=1;K<N;K++){ - for(T=A; T!=[]; T=cdr(T)) S0*=car(T)+K; - for(T=B; T!=[]; T=cdr(T)) S0/=car(T)+K; - S0=red(S0*X/(K+1)); - DN=dn(S0); - S=red((red(S*DN)+nm(S0))/DN); - } - return S; - } - S=0; - for(K=0;K<=N;K++){ - for(I=0;I<=N-K;I++){ - C=1/sftpowext(1,I,1)/sftpowext(1,J,1); - for(T=A[0];T!=[];T=cdr(T)) C*=sftpowext(car(T),I+K,1); - for(T=A[1];T!=[];T=cdr(T)) C*=sftpowext(car(T),I,1); - for(T=A[2];T!=[];T=cdr(T)) C*=sftpowext(car(T),K,1); - for(T=B[0];T!=[];T=cdr(T)) C/=sftpowext(car(T),I+K,1); - for(T=B[1];T!=[];T=cdr(T)) C/=sftpowext(car(T),I,1); - for(T=B[2];T!=[];T=cdr(T)) C/=sftpowext(car(T),K,1); - S+=red(C*X[0]^I*X[1]^K); - } - } - return S; -} - -def evalred(F) -{ - Opt=getopt(opt); - if(type(Opt)!=4){ - Opt=[]; - }else if(length(Opt)==2 && type(Opt[0])!=4) Opt=[Opt]; - for(;;){ - G=mysubst(F,[[tan(0),0],[asin(0),0],[atan(0),0],[sinh(0),0],[tanh(0),0], - [log(1),0],[cosh(0),1],[exp(0),1]]); - for(Rep=Opt; Rep!=[]; Rep=cdr(Rep)) - G=subst(G,car(Rep)[0],car(Rep)[1]); - Var=vars(G); - for(V=Var; V!=[]; V=cdr(V)){ - if(!(VV=args(CV=car(V)))) continue; - if((functor(CV)==sin||functor(CV)==cos)){ - P=2*red(VV[0]/@pi); - if(functor(CV)==sin) P=1-P; - if(isint(P)){ - if(iand(P,1)) G=subst(G,CV,0); - else if(!iand(P,3)) G=subst(G,CV,1); - else G=subst(G,CV,-1); - continue; - } - if(isint(P*=3/2)){ - if(iand(P,3)==1) G=subst(G,CV,1/2); - else G=subst(G,CV,-1/2); - } - } - for(;VV!=[];VV=cdr(VV)) - if(car(VV)!=(TV=evalred(car(VV)))) G=subst(G,car(VV),TV); - if(functor(CV)!=pow || (args(CV)[0])!=1) continue; - G=subst(G,CV,1); - } - if(G==F) return F; - F=G; - } -} - -def seriesMc(F,N,V) -{ - if(type(V)<4) V=[V]; - V=reverse(V); - L=length(V); - if(type(Opt=getopt(evalopt))!=4) Opt=[]; - P=newvect(L); - G=newvect(L+1); - G[0]=F; - for(I=0;I<L;I++) - G[I+1]=eval(evalred(subst(G[I],V[I],0)|opt=Opt)); - R=G[L]; - for(;;){ - for(M=0,I=0;I<L;I++){ - M+=P[I]; - if(M==N) break; - } - if(M<N){ - P[L-1]++; - G[L-1]=mydiff(G[L-1],V[L-1]); - G[L]=eval(evalred(mysubst(G[L-1],[V[L-1],0])|opt=Opt)); - }else{ - if(I--==0) break; - P[I]++; - G[I]=mydiff(G[I],V[I]); - while(I++<L){ - G[I]=eval(evalred(mysubst(G[I-1],[V[I-1],0])|opt=Opt)); - if(I<L) P[I]=0; - } - } - K=1; - for(I=0;I<L;I++) K*=V[I]^P[I]/fac(P[I]); - R+=G[L]*K; - } - return R; -} - -def seriesTaylor(F,N,V) -{ - G=F; - if(isvar(V)) V=[V]; - if(length(V)==2 && type(car(V))!=4 && !isvar(V[1])) V=[V]; - for(V0=V1=[];V!=[];V=cdr(V)){ - if(type(T=car(V))!=4) T=[T]; - V0=cons(X=car(T),V0); - if(length(T)==1 || T[1]==0){ - V1=cons(X,V1);continue; - } - S=my_tex_form(-T[1]); - if(str_char(S,0,"-")!=0) S="+"+S; - S="("+my_tex_form(X)+S+")"; - V1=cons([X,S],V1); - F=red(subst(F,T[0],T[0]+T[1])); - } - V0=reverse(V0);V1=reverse(V1); - F=seriesMc(F,N,V0|option_list=getopt()); - if(getopt(frac)==0) F=frac2n(F); - T=getopt(dviout); - if(type(T)!=1) T=0; - F=fctrtos(F|var=V1,rev=1,TeX=(T==0||T==2)?2:3); - if(getopt(small)==1) F=str_subst(F,"\\frac{","\\tfrac{"); - if(T<0 || T==1) F="\\begin{align}\\begin{split}\n"+ - my_tex_form(G)+"&="+F+"+\\cdots\n\\end{split}\\end{align}\n"; - if(T==1) dviout(F); - else if(T==1) dviout(F|eq=4); - return F; -} - -def toeul(F,L,V) -{ - L = vweyl(L); - X = L[0]; DX = L[1]; - I = mydeg(F,DX); - if(V == "infty"){ - for(II=I; II>=0; II--){ - J = mydeg(P=mycoef(F,I,DX),X); - if(II==I) S=II-J; - else if(P!=0 && II-J>S) S=II-J; - } - F *= X^S; - R = 0; - for( ; I >= 0; I--) - R += red((mysubst(mycoef(F,I,DX),[X,1/X])*(x*DX)^I)); - return(subst(pol2sft(R,DX),DX,-DX)); - } - F = subst(F,X,X+V); - for(II=I; II>=0; II--){ - J = mymindeg(P=mycoef(F,II,DX),X); - if(II==I) S=II-J; - else if(P!=0 && II-J>S) S=II-J; - } - F *= X^S; - R = 0; - for( ; I >= 0; I--) - R += (red(mycoef(F,I,DX)/X^I))*DX^I; - return pol2sft(R,DX); -} - -/* -def topoldif(P,F,L) -{ - L = vweyl(L); - P = nm(red(P)); - while(deg(P,L[1]) > 0){ - R = coef(P,0,L[0]); - Q = red((P-R)/(F*L[0]); - P = nm(Q)*zz+F*R*dn(Q); - } -} -*/ - -def fromeul(P,L,V) -{ - if(P == 0) - return 0; - L = vweyl(L); - X = L[0]; DX = L[1]; - I = mydeg(P,DX); - if(V == "infty"){ - P = subst(P,DX,-DX); - J = mydeg(P,X); - P = red(mysubst(P,[X,1/X])*X^J); - } - R = mycoef(P,0,DX); - S = 1; - for(S = J = 1; J <= I; J++){ - S = DX*(S*X + mydiff(S,DX)); - R += mycoef(P,J,DX)*S; - } - while(mycoef(R,0,X) == 0) - R = tdiv(R,X); - if(V != "infty" && V != 0) - R = mysubst(R,[X,X-V]); - return R; -} - -def sftexp(P,L,V,N) -{ - L = vweyl(L); DX = L[1]; - P = mysubst(toeul(P,L,V),[DX,DX+N]); - return fromeul(P,L,V); -} - - -def fractrans(P,L,N0,N1,N2) -{ - L = vweyl(L); - if(N2 != "infty"){ - if(N0 == "infty") - N0 = 0; - else - N0 = red(1/(N0-N2)); - if(N1 == "infty") - N1 = 0; - else - N1 = red(1/(N1-N2)); - P = mysubst(P,[L[0],L[0]+N2]); - P = fromeul(toeul(P,L,"infty"),L,0); - } - if(N0 != 0){ - P = mysubst(P,[L[0],L[0]+N0]); - N1 -= N0; - } - if(N1 != 1) - P = mysubst(P,[[L[0],L[0]/N1],[L[1],L[1]*N1]]); - return P; -} - -def soldif(P,L,V,Q,N) -{ - L = vweyl(L); X = L[0]; DX = L[1]; - P = mysubst(toeul(P,L,V),[DX,DX+Q]); - DEG = mydeg(P,X); - P0 = newvect(DEG+1); - for(I = 0; I <= DEG; I++) - P0[I] = coef(P,I,X); - if(P0[0] == 0) - return 0; - if(subst(P0[0],DX,0) != 0){ - mycat([Q,"is not the exponent at", V])$ - return 0; - } - R = newvect(N+1); - R[0] = 1; - for(I = 1; I <= N; I++){ - for(S = 0, K = 1; K <= DEG && K <= I; K++) - S += mysubst(P0[K],[DX,I-K])*R[I-K]; - S = red(S); - M = mysubst(P0[0],[DX,I]); - if(M != 0){ - R[I] = -red(S/M); - if(R1 != 0){ - for(S = 0, K = 1; K <= DEG && K <= I; K++) - S += mysubst(P0[K],[DX,I-K])*R1[I-K] + - mysubst(P1[K],[DX,I-K])*R[I-K]; - R1[I] = -red(S/M); - } - }else{ - if(S == 0){ - if(R1 != 0){ - for(S = 0, K = 1; K <= DEG && K <= I; K++) - S += mysubst(P0[K],[DX,I-K])*R1[I-K] + - mysubst(P1[K],[DX,I-K])*R[I-K]; - } - if(S == 0) - continue; - } - R1 = newvect(N+1); - for(K = 0; K < I; K++){ - R1[K] = R[K]; - R[K] = 0; - } - R1[I] = 0; - P1 = newvect(DEG); - for(K = 0; K <= DEG; K++) - P1[K] = mydiff(P0[K], DX); - M = mysubst(P1[0],[DX,I]); - if(M == 0){ - cat(["multiple log at ", I])$ - return 0; - } - R[I] = -red(S/M); - } - } - if(R1 != 0) - return [R1, R]; - else - return R; -} - -def chkexp(P,L,V,Q,N) -{ - L = vweyl(L); X = L[0]; DX = L[1]; - P = mysubst(toeul(P,L,V),[DX,DX+Q]); - P = fromeul(P,L,0); - D = mydeg(P,DX); - Z = mindeg(mycoef(P,D,DX), X) - (D-N); - R = []; - for(I = 0; I < Z; I++){ - S = mycoef(P,I,X); - if(S != 0){ - for(J = mydeg(S,DX); J >= 0; J--){ - T = mycoef(S,J,DX); - if(T != 0) - R = cons(T,R); - } - } - } - return R; -} - - -def sqrtrat(P) -{ - if(P==0) return 0; - if(type(P)==3||type(P)==2){ - P=red(P); - if(imag(dn(P))!=0||imag(nm(P))!=0){ - if(imag(dn(P))==0&&real(P)!=0){ - F=red(imag(P)/real(P)); - if(F==3^(1/2)||F==-3^(1/2)){ - if(eval(real(P))<0) - return -real(P)+imag(P)*@i; - else{ - if(eval(imag(P))>0) return imag(P)+real(P)*@i; - else return -imag(P)-real(P)*@i; - } - } - } - return []; - } - F=fctr(dn(P)); - R=sqrtrat(car(F)[0]); - for(F=cdr(F);F!=[];F=cdr(F)){ - if(!iand(car(F)[1],1)) R*=car(F)[0]^(car(F)[1]/2); - else return []; - } - F=fctr(nm(P)); - R=sqrtrat(car(F)[0])/R; - for(F=cdr(F);F!=[];F=cdr(F)){ - if(!iand(car(F)[1],1)) R*=car(F)[0]^(car(F)[1]/2); - else return []; - } - return R; - } - if(ntype(P)==4){ - P0=real(P);P1=imag(P)/2; - X=makenewv(P); - for(R=fctr(X^4-P0*X^2-P1^2);R!=[];R=cdr(R)){ - RT=car(R)[0]; - if(deg(RT,X)==1){ - X=-mycoef(RT,0,X)/mycoef(RT,1,X); - return X+P1/X*@i; - } - if(deg(RT,X)==2){ - if((D=mycoef(RT,1,X)^2-4*mycoef(RT,2,X)*mycoef(RT,0,X))<0) continue; - X=(-mycoef(RT,1,X)+sqrtrat(D))/(2*mycoef(RT,2,X)); - return X+P1*sqrt2rat(1/X)*@i; - } - } - D=P0^2+4*P1^2; - if(P1>0) return ((sqrtrat(D)+P0)/2)^(1/2)+((sqrtrat(D)-P0)/2)^(1/2)*@i; - return ((sqrtrat(D)+P0)/2)^(1/2)-((sqrtrat(D)-P0)/2)^(1/2)*@i; - }else if(ntype(P)!=0) return []; - if(P==1) return P; - Dn=dn(P);Nm=nm(P);C=R=1; - N=pari(factor,Dn); - if(N){ - for(II=car(size(N))-1;II>=0;II--){ - if(iand(K=N[II][1],1)){ - R*=N[II][0]; - K++; - } - C/=N[II][0]^(K/2); - } - } - N=pari(factor,Nm); - if(N){ - for(II=car(size(N))-1;II>=0;II--){ - if(N[II][0]==-1){ - C*=@i; - continue; - } - K=N[II][1]; - if(iand(K,1)){ - R*=N[II][0]; - K--; - } - if(K!=0) C*=N[II][0]^(K/2); - } - } - if(R!=1) C*=R^(1/2); - return C; -} - -def fctri(F) -{ - R=(iscoef(F,os_md.israt))?fctr(F):[[1,1],[F,1]]; - if(!iscoef(F,os_md.iscrat)||chkfun("af_noalg",0)==0) return R; - X=makenewv(vars(F)); - for(S=[];R!=[];R=cdr(R)){ - if(length(Var=vars(R0=car(R)[0])) == 1 && (D=mydeg(R0,Var=car(Var))) > 0){ - if(imag(T=mycoef(R0,D,Var))!=0) R0/=T; - T=af_noalg(real(R0)+imag(R0)*X,[[X,X^2+1]]); - if(length(T)>1||T[0][1]>1){ - T=subst(T,X,@i); - for(; T!=[];T=cdr(T)){ - if(vars(T[0])!=[]) - S=cons([car(T)[0],car(T)[1]*car(R)[1]],S); - } - continue; - } - } - S=cons(R[0],S); - } - return reverse(S); -} - -def getroot(F,X) -{ - S=[]; - if(type(Cpx=getopt(cpx))!=1) Cpx=0; - M=getopt(mult); - if(type(F) == 3) - F = nm(red(F)); - for(R=fctri(F); length(R)>0; R = cdr(R)){ - T=car(R); - P=car(T); - I=car(cdr(T)); - if(mydeg(P,X)>0){ - if(mydeg(P,X)==1){ - C = mycoef(P,1,X); - P = X - red(P/C); - }else if(mydeg(P,X)==2 && Cpx>0){ - C2=mycoef(P,2,X);C1=mycoef(P,1,X);C0=mycoef(P,0,X); - C=sqrt2rat(C1^2-4*C0*C2); - C0=[]; - if(type(C)==0&&ntype(C)==0&&pari(issquare,-C)) C0=sqrt(C); - else if(Cpx>1) C0=sqrtrat(C); - if(C0==[]&&Cpx>2) C0=C^(1/2); - if(C0!=[]){ - if(M==1) - S=cons([I,sqrt2rat((-C1+C0)/(2*C2))],S); - else{ - for(II=I; II>0; II--) - S=cons(sqrt2rat((-C1+C0)/(2*C2)),S); - } - P=sqrt2rat((-C1-C0)/(2*C2)); - } - }else if(mydeg(P,X)==3 && Cpx>1){ - Omg=(-1+3^(1/2)*@i)/2; - PP=P/mycoef(P,3,X); - C2=mycoef(PP,2,X)/3; - PP=subst(PP,X,X-C2); - if((C1=mycoef(PP,1,X))==0){ - C0=mycoef(PP,0,X); - if(real(C0)==0||imag(C0)==0){ - if(real(C0)==0){ - PP=getroot(X^3+imag(C0),X); - if(length(PP)==3){ - for(;PP!=[];PP=cdr(PP)){ - if(imag(PP[0])==0){ - C0=PP[0]*@i; - break; - } - } - if(PP==[]) C0=0; - } - }else{ - if(C0>0) C0=C0^(1/3); - else C0=-(-C0)^(1/3); - } - if(C0!=0){ - if(M==1){ - S=cons([I,C0-C2],S); - S=cons([I,C0*Omg-C2],S); - S=cons([I,C0*(-1-Omg)-C2],S); - }else{ - for(II=I; II>0; II--){ - S=cons(C0-C2,S); - S=cons(C0*Omg-C2,S); - S=cons(C0*(-1-Omg)-C2,S); - } - } - continue; - } - } - } - if(Cpx>2){ - Q=X^2+(mycoef(PP,1,X)/3)*X+mycoef(PP,0,X)^3; - SQ=getroot(Q,X|cpx=2); - SQ=SQ[0]^(1/3);SQ2=mycoef(PP,0,X)/SQ; - if(M==1){ - S=cons([I,SQ+SQ2-C2],S); - S=cons([I,SQ*Omg+SQ2*(-1-Omg)-C2],S); - S=cons([I,SQ*(-1-Omg)+SQ2*Omg-C2],S); - }else{ - for(II=I; II>0; II--){ - S=cons(SQ+SQ2-C2,S); - S=cons(SQ*Omg+SQ2*(-1-Omg)-C2,S); - S=cons(SQ*(-1-Omg)+SQ2*Omg-C2,S); - } - } - continue; - } - }else if(mydeg(P,X)==4 && Cpx>0){ - C2=mycoef(P,3,X)/(4*mycoef(P,4,X)); - PP=subst(P,X,X-C2); - if(mycoef(PP,1,X)==0){ - PP=mycoef(PP,4,X)*X^2+mycoef(PP,2,X)*X+(SQ2=mycoef(PP,0,X)); - SQ=getroot(PP,X|cpx=2); - if(length(SQ)==2){ - if((C0=sqrtrat(SQ[0]))==[]){ - if(mycoef(PP,1,X)==0){ - if(SQ2<0) C0=(-SQ2)^(1/4); - else C0=SQ2^(1/4)*(1+@i)/2; - } - else if(Cpx>2) C0=SQ[0]^(1/2); - else C0=0; - } - if((C1=sqrtrat(SQ[1]))==[]){ - if(mycoef(PP,1,X)==0) C1=-C0; - else C1=SQ[1]^(1/2); - } - if(C0!=0){ - if(M==1) - S=append([[I,C0-C2],[I,-C0-C2],[I,C1-C2],[I,-C1-C2]],S); - else{ - for(II=I; II>0; II--) - S=append([C0-C2,-C0-C2,C1-C2,-C1-C2],S); - } - continue; - } - } - }else{ - PP/=mycoef(PP,4,X); - CC=mycoef(PP,2,X);C1=mycoef(PP,1,X);C0=mycoef(PP,0,X); - SQ=getroot(X*(CC+X)^2-4*C0*X-C1^2,X|cpx=Cpx); - if(length(SQ)>1){ - SQ=sqrt2rat(SQ[0]); - SQ2=getroot(X^2-SQ,X|cpx=Cpx); - if(length(SQ2)>1){ - C1=SQ2[0]*X-C1/SQ2[0]/2; - C0=getroot(X^2+CC/2+SQ/2+C1,X|cpx=Cpx); - C1=getroot(X^2+CC/2+SQ/2-C1,X|cpx=Cpx); - if(length(C0)>1&&length(C1)>1){ - C0=[sqrt2rat(C0[0]-C2),sqrt2rat(C0[1]-C2), - sqrt2rat(C1[0]-C2),sqrt2rat(C1[1]-C2)]; - if(M==1) for(II=0;II<4;II++) S=cons([I,C0[II]],S); - else for(II=I; II>0; II--) S=append(C0,S); - continue; - } - } - } - } - } - if(M==1) - S=cons([I,P],S); - else for( ; I>0; I--) S=cons(P,S); - } - } - S=qsort(S); - if(M==1) S=reverse(S); - return S; -} - -def expat(F,L,V) -{ - L = vweyl(L); - if(V == "?"){ - Ans = []; - - F = nm(red(F)); - S = fromeul(toeul(F,L,"infty"),L,0); - S = mycoef(S,mydeg(S,L[1]),L[1]); - if(mydeg(S,L[0]) > 0) - Ans = cons(["infty", expat(F,L,"infty")],Ans); - - S = mycoef(F,mydeg(F,L[1]), L[1]); - R = getroot(S,L[0]); - for(I = 0; I < length(R); I++){ - if(I > 0 && R[I-1] == R[I]) - continue; - if(mydeg(R[I], L[0]) <= 0) - Ans = cons([R[I], expat(F,L,R[I])], Ans); - else - Ans = cons([R[I]], Ans); - } - return Ans; - } - return getroot(subst(toeul(F,L,V),L[0],0),L[1]); -} - -def polbyroot(P,X) -{ - R = 1; - while(length(P)){ - R *= X-car(P); - if(type(R)>2) R = red(R); - P = cdr(P); - } - return R; -} - -def polbyvalue(P,X) -{ - R = 1; S = 0; - while(length(P)){ - T = car(P); - V0 = T[1] - mysubst(S,[X,T[0]]); - if(V0 != 0){ - if(type(R) > 2) R = red(R); - V1 = mysubst(R,[X,T[0]]); - if(V1 == 0){ - erno(0); - return 0; - } - S += (V0/V1)*R; - if(type(S) > 2) S = red(S); - } - R *= X - T[0]; - P = cdr(P); - } - return S; -} - - -def pcoef(P,L,Q) -{ - if(L==0) - return 1; - Coef=TP=0; - if(type(Q)>=4){ - TP=1; - V=Q[0]; - if(type(V)==4) - V=ltov(V); - else V=dupmat(V); - N=length(V); - if(type(Q[1])==5) MR=dupmat(Q[1]); - else{ - MR=newvect(N); - for(K=Q[1], I=0; I< N; I++){ - MR[I] = car(K); - K = cdr(K); - } - } - }else{ - V=ltov(vars(P)); - N=length(V); - MR=newvect(N); - for(I=0;I<N;I++){ - MR[I]=mydeg(Q,V[I]); - Q=mycoef(Q,MR[I],V[I]); - } - if(type(Q)>1) return 0; - } - if(L==1){ - for(I=0;I<N;I++) - P=mycoef(P,MR[I],V[I]); - return P; - } - for(I=1;I<N;I++){ /* sorted by required degrees */ - for(K1=MR[I],K2=V[I],J=I-1; J>=0 && MR[J]<K1; J--); - for(II=I-1;II>J;II--){ - MR[II+1]=MR[II];V[II+1]=V[II]; - } - MR[II+1]=K1;V[II+1]=K2; - } - for(NN=N; N>0 && MR[N-1]==0; N--); - Mon=[];Coe=[];Q=P; - while(Q!=0){ - M=newvect(N); - for(R=Q,F=I=0,MT=1;I<NN;I++){ - K=mydeg(R,V[I]); - R=mycoef(R,K,V[I]); - if(I<N) M[I]=K; - if(K>0) MT*=V[I]^K; - if(K>MR[I]) F=1; - } - Q -= R*MT; - if(F==0){ - Mon=cons(M,Mon); - Coe=cons(R,Coe); - } - } - Mon=ltov(reverse(Mon)); - Coe=ltov(reverse(Coe)); - Len=length(Mon); - S=newvect(Len); - for(JL=0; JL<Len;JL++){ - if(L*Mon[JL][0]<MR[0]) break; - } - S[0]=L; - - K0=Mon[0][0]; - K=L*K0-MR[0]; - for(I=II=0;II<Len && K>=0;II++){ - if((K1=K0-Mon[0][II])>0){ - while(K>K1 && S[I]>0){ - S[I]--;S[II]++; - K-=K1; - I=II; - K0=Mon[0][II]; - } - }else break; - } - - I=0; - while(1){ - for(T=T0=J=JP=0; J<Len; J++){ - if(S[J]!=0){ - if(T0==0 && J>=JL) return Coef; - JP=J;T0=1; - T+=S[J]*Mon[J][I]; - } - } - if(T==MR[I]){ - if(++I<N) continue; - for(TT=1,J=1; J<=L; J++) /* find a solution */ - TT*=J; - for(J=0;J<Len;J++){ - if(S[J]!=0){ - TT*=Coe[J]^S[J]; - for(II=S[J]; II>1; II--) - TT/=II; - } - } - Coef+=TT; - if(TP==1 && type(Coef)==3) Coef=red(Coef); - if(JP<Len-2 && S[JP]>1){ - S[JP]-=2;S[JP+1]++;S[JP+2]++; - }else{ - for(JT=JP-1;JT>=0&&S[JT]==0;JT--); - if(JT<0) break; - if(JT==JP-1){ - S[JT]--; - if(JP<Len-1) - S[JP+1]++; - else - S[JP]++; - }else{ - S[JT]--; - S[JT+1]+=S[JP]+1; - S[JP]=0; - } - } - I=0; - continue; - } - if(JP<Len-1){ - for(JP1=JP+1;JP1<Len-1;JP1++){ - if(Mon[JP1][I]!=Mon[JP][I]) break; - } - - if(I>0 && Mon[JP1][0] < Mon[JP][0]){ - S[JP]--;S[Len-1]++;JP=JP-1; - }else{ - - S[JP]--; - if(JP1<Len){ - S[JP1]++; - }else{ - S[JP1-1]++; - } - } - } - if(JP==Len-1){ - for(JT=JP-1;JT>=0 && S[JT]==0;JT--); - if(JT<0) break; - S[JT]--; - if(JT==JP-1){ - S[JP]++; - }else{ - S[JT+1]+=S[JP]+1; - S[JP]=0; - } - } - I=0; - } - return Coef; -} - -def prehombf(P,Q) -{ - if((Mem=getopt(mem))!=1 && Mem!=-1) - return prehombfold(P,Q); - if(Q==0) Q=P; - V=ltov(vars(P)); - N=length(V); - for(I=1;I<N;I++){ /* sorted by required degrees */ - for(K=mydeg(P,V[I]),K1=V[I],J=I-1; J>=0 && mydeg(P,V[J])<K; J--); - for(II=I-1;II>J;II--) V[II+1]=V[II]; - V[II+1]=K1; - } - S=newvect(N);T=newvect(N);U=newvect(N); - for(R=P,M=1,Deg=I=0;I<N;I++){ /* extreme vector */ - Deg+=(S[I]=mydeg(R,V[I])); - R=mycoef(R,S[I],V[I]); - } - DR=[[-1,0]]; - if((R1=N/Deg)!=1){ - DR=cons([-R1,0],DR); - Sft=1; - }else Sft=0; - if(Deg%2==0) Sg=1; - else Sg=-1; - for(I=0,R=R2=1,QQ=Q; 2*I+Sft < Deg; I++){ - if(Mem==-1){ - print(I+1,0);print("/",0);print(idiv(Deg-Sft+1,2),0);print(" ",2); - } - Coef=0; - Q=QQ; - while(Q!=0){ - for(R=Q,J=0,RR=1;J<N;J++){ - T[J]=mydeg(R,V[J]); - R=mycoef(R,T[J],V[J]); - if(T[J]>0) RR*=V[J]^T[J]; - } - Q-=R*RR; - for(J=0,CC=R;J<N;J++){ - U[J]=I*S[J]+T[J]; - for(II=0; II<T[J]; II++) - CC*=(U[J]-II); - } - CC*=pcoef(P,I+1,[V,U]); - if(Mem==-1) print("*",2); - Coef+=CC; - } - DR=cons([I,Coef],DR); - DR=cons([-R1-1-I,Sg*Coef],DR); - if(Mem==-1) print(""); - } - P = polbyvalue(DR,s); - return fctr(P); -} - -def prehombfold(P,Q) -{ - V = vars(P); - if(Q==0) Q=P; - for(Deg=0, R=P, V1=V, DD=[]; V1!=[]; V1=cdr(V1)){ - VT = car(V1); - D = mydeg(R,VT); - R = mycoef(R,D,VT); - Deg += D; - X = makev(["d",VT]); - Q = subst(Q,VT,X); - DD=cons([VT,X],DD); - } - DR=[[-1,0]]; - NV=length(V); - if((R1=NV/Deg)!=1){ - DR=cons([-R1,0],DR); - Sft=1; - }else - Sft=0; - if(Deg%2==0) - Sg=1; - else Sg=-1; - for(I = 0, R=R2=1; 2*I+Sft < Deg; I++){ - R = R2; - R2 = R*P; - S = appldo(Q,R2,DD); - QQ = sdiv(S,R); - DR=cons([I,QQ],DR); - DR=cons([-R1-1-I,Sg*QQ],DR); - } - P = polbyvalue(DR,s); - return fctr(P); -} - -def sub3e(P0,P1,P2,N0,N1,N) -{ - R = x^N0*(x-1)^N1*dx^N; - for(V = I = 1, J = 1; I <= N; I++){ - S = 0; - M = N-I; - if(I <= N0){ - T = mycoef(P0,N0-I,x); - S += T; - R += T*x^(N0-I)*(x-1)^N1*dx^M; - K1 = N0-I+1; - }else - K1 = 0; - if(I <= N1){ - T = mycoef(P1,N1-I,x); - S += T; - R += T*x^N0*(x-1)^(N1-I)*dx^M; - K2 = N0-1; - }else - K2 = N-I; - for(K = K1; K <= K2; K++){ - if(K == K2){ - R += (mycoef(P2,N-I,x)-S)*x^K*(x-1)^(M-K)*dx^M; - continue; - } - R += strtov("r"+rtostr(V))*x^K*(x-1)^(M-K)*dx^M; - S += strtov("r"+rtostr(V++)); - } - } - if(V > 1) - mycat([V-1, "accessory parameters: r1,r2,..."]); - return R; -} - -def fuchs3e(P,Q,R) -{ - return getbygrs([R,P,Q],3); -} - -def okubo3e(P,Q,R) -{ - if(getopt(opt)==1){ - N=length(R); - M1=N-length(P);M2=N-length(Q); - V=(M1-1)*(M2-1); - if(V>0) mycat([V, "accessory parameters"]); - return getbygrs([R,cons([M1,0],P),cons([M2,0],Q)],3); - } - S = 0; - V = -1; - L = newvect(3,[[],[],[]]); - N = newvect(3,[0,0,0]); - if(type(R) < 4){ - I = -1; - V = 3; - }else{ - I = 2; - V = -1; - } - for( ; I >= 0; I--){ - if(I == 2) - U = R; - else if(I == 1) - U = Q; - else - U = P; - for( ; length(U); U = cdr(U)){ - T = car(U); - if( T == "?"){ - if(V < 0) - V = I; - else - return 0; - }else{ - if(I == 2) - L[I] = cons(-T, L[I]); - else - L[I] = cons(T, L[I]); - S += T; - } - N[I]++; - } - } - if(V == 3){ - N[2] = N[0] + N[1]; - P2 = x^N; - for(I = 1; I <= N; I++) - P2 += makev([R,I])*x^(N-I); - }else{ - if(N[0]+N[1] != N[2]){ - print("Number of exponents are wrong",0); - return -1; - } - S -= N[0]*N[1]; - if(V < 0){ - if(S != 0){ - mycat(["Viorate Fuchs relation ->",S]); - return -2; - } - }else{ - if(V != 2) - S = -S; - L[V] = cons(S, L[V]); - } - P2 = polinsft(polbyroot(L[2],x),x); - } - P0 = polinsft(mysubst(polbyroot(L[0],x),[x,x+N[1]]),x); - P1 = polinsft(mysubst(polbyroot(L[1],x),[x,x+N[0]]),x); - return sub3e(P0,P1,P2,N[0],N[1],N[2]); -} - -/* N = 2*M (N-M = M) or 2*M+1 (N-M = M+1) - 0 : 0 1 ..... M-1 B B+1 ... B+N-M-2 A - 1 : C C+1 ... C+M-1 0 1 .... N-M-2 N-M-1 - */ -def eosub(A,B,C,N) -{ - M = N%2; - P = []; - Q = []; - P = cons(A,P); - for(I = 0; I < N-M-1; I++) - P = cons(B+I,P); - for(I = 0; I < M; I++) - Q = cons(C+I,Q); - P = okubo3e(P,Q,s); - - C = newvect(2); - L = newvect(2); - C[1] = chkexp(P,[x,dx],0,b,N-M-1); - C[0] = chkexp(P,[x,dx],1,c,M); - for(LL = K = 0; K < 2; K++){ - L[K] = length(C[K]); - C[K] = ltov(C[K]); - if(L[K] > LL) - LL = L[K]; - } - JJ = 0; - - for(I = 1; Do; I++){ - Do = 0; - S = makev(["r",I]); - for(J = JJ; J < LL; J++){ - JJ = LL; - for(K = 0; K < 2; K++){ - if(J >= L[K] || C[K][J] == 0) - continue; - if(J < JJ) - JJ = J; - if(Do == 1){ - CC = C[K]; - CC[J] = mysubst(CC[J], [S, Var]); - continue; - } - if(mydeg(C[K][J]) >= 1){ - if(mydeg(C[K][J]) > 1){ - print("Internal error"); - return; - } - Var = getroot(C[K][J],S); - Var = Var[0]; - CC = C[K]; - CC[J] = 0; - P = mysubst(P, [S, Var]); - Do = 1; - J = JJ - 1; - K++; - } - } - } - } - if(JJ != L){ - print("Internal error (non Rigid)"); - return; - } - return P; -} - -def even4e(X,Y){ - if(length(X) != 4 || length(Y) != 2){ - print("Usage: even4e([a,b,c,d],[e,f])"); - print("0: 0 1 e f"); - print("1; 0 1 * *+1"); - print("infty: a b c d"); - return; - } - S = -3; - for(I = 0; I < 4; I++){ - S += X[I]; - if(I < 2) - S += Y[I]; - } - S = -S/2; - P = okubo3e(Y,[S,"?"],X); - T = chkexp(P,x,1,S,2); - T = getroot(T[0],r1); - return mysubst(P,[r1,T[0]]); -} - -def odd5e(X,Y) -{ - if(length(X) != 5 || length(Y) != 2){ - print("Usage: spec6e([a,b,c,d,e],[f,g])"); - print("0: 0 1 f g g+1"); - print("1: 0 1 2 * *+1"); - print("infty: a b c d e"); - return; - } - S = -4; - for(I = 0; I < 5; I++){ - S += X[I]; - if(I < 2) - S += Y[I]; - } - S = -(S + Y[1])/2; - P = okubo3e([Y[0],Y[1],Y[1]+1],[S,"?"],X); - T = chkexp(P,x,1,S,2); - T = getroot(T[0],r1); - P = mysubst(P,[r1,T[0]]); - T = chkexp(P,x,0,Y[1],2); - T = getroot(T[0],r2); - return mysubst(P,[r2,T[0]]); -} - -def extra6e(X,Y) -{ - if(length(X) != 6 || length(Y) != 2){ - print("Usage: extra6e([a,b,c,d,e,f],[g,h])"); - print("0: 0 1 g g+1 h h+1"); - print("1: 0 1 2 3 * *+1"); - print("infty: a b c d e f"); - return; - } - S = -5; - for(I = 0; I < 6; I++){ - S += X[I]; - if(I < 2) - S += 2*Y[I]; - } - S = -S/2; - P = okubo3e([Y[0],Y[0]+1,Y[1],Y[1]+1],[S,"?"],X); - T = chkexp(P,x,1,S,2); - T = getroot(T[0],r1); - P = mysubst(P,[r1,T[0]]); - T = chkexp(P,x,0,Y[0],2); - T = getroot(T[0],r3); - P = mysubst(P,[r3,T[0]]); - T = chkexp(P,x,0,Y[1],2); - T = getroot(T[0],r2); - return mysubst(P,[r2,T[0]]); -} - -def rigid211(X,Y,Z) -{ - if(length(X) != 2 || length(Y) != 2 || length(Z) != 2){ - print("Usage: rigid211([a,b],[c,d],[e,f])"); - print("0: 0 1 a b"); - print("1: 0 1 c d"); - print("infty: e e+1 f *"); - return; - } - P = okubo3e(X,Y,[Z[0],Z[0]+1,Z[1],"?"]); - T = chkexp(P,x,"infty",Z[0],2); - T = getroot(T[0],r1); - return mysubst(P,[r1,T[0]]); -} - -def solpokuboe(P,L,N) -{ - if(type(N) > 1 || ntype(N) != 0 || dn(N) != 1){ - mycat(["Irrigal argument :", N]); - return 0; - } - L = vweyl(L); - DD=N+1; - for(U = S = L[0]^N; U != 0; ){ - D = mydeg(U,L[0]); - if(D>=DD){ - mycat(["Internal Error",D,DD]); - return -1; - } - DD=D; - UU = L[0]^D; - R = appldo(P,UU,L); - if(mydeg(R,L[0]) > D){ - printf("Bad operator\n"); - return 0; - } - CC = mycoef(R,D,L[0]); - if(D == N){ - P -= (E = CC); - U = R-E*U; - continue; - } - if(CC == 0){ - printf("No polynomial\n"); - return 0; - } - CC= mycoef(U,D,L[0])/CC; - S = red(S - UU*CC); - U = red(U - R*CC); - } - return [nm(S),E]; -} - -def stoe(M,L,N) -{ - L = vweyl(L); - Size = size(M); - S = Size[0]; - NN = 0; - if(type(N) == 4){ - NN=N[0]; N=N[1]; - }else if(N < 0){ - NN=-N; N=0; - } - if(S != Size[1] || N >= S || NN >= S) - return; - D = newmat(S+1,S+1); - MN = dupmat(M); - MD = newmat(S,S); - DD = D[0]; - DD[N] = 1; DD[S] = 1; - for(Lcm = I = 1; ; ){ - DD = D[I]; - MM = MN[N]; - for(J = 0; J < S; J++){ - DD[J] = MM[J]; - Lcm = lcm(dn(DD[J]),Lcm); - } - DD[S] = L[1]^I; - for(J = 0; J <= S; J++) - DD[J] = red(DD[J]*Lcm); - if(I++ >= S) - break; - if(I==S && NN>0){ - DD = D[I]; - DD[0]=-z_zz; DD[NN]=1; - break; - } - Mm = dupmat(MN*M); - for(J = 0; J < S; J++){ - for(K = 0; K < S; K++) - MN[J][K] = red(diff(MN[J][K],L[0])+Mm[J][K]); - } - } -#if 0 - P = fctr(mydet2(D)); -#else - P = fctr(det(D)); -#endif - for(I = R = 1; I < length(P); I++){ - if(mydeg(P[I][0],L[1]) > 0) - R *= P[I][0]^P[I][1]; - } - if(NN > 0) - R = -red(coef(R,0,z_zz)/coef(R,1,z_zz)); - return R; -} - -def dform(L,X) -{ - if(type(X)==2) X=[X]; - if(type(L[0])!=4) L=[L]; - if(type(X)==4) X=ltov(X); - M=length(X); - if(length(car(L))==2){ - R=newvect(M); - for(LL=L; LL!=[]; LL=cdr(LL)){ - for(I=0; I<M; I++){ - RT=rmul(car(LL)[0],mydiff(car(LL)[1],X[I])); - R[I] = (R[I]==0)?RT:radd(R[I],RT); - } - } - Dif=getopt(dif); - for(RR=[], I=M-1; I>=0; I--){ - if(Dif==1) RR=cons([1,R[I],X[I]],RR); - else RR=cons([R[I],X[I]],RR); - } - if(Dif==1) RR=dform(RR,X); - return RR; - }else if(length(car(L))!=3) return L; - N=M*(M-1)/2; - R=newvect(N); - S=newvect(N); - for(LL=L; LL!=[]; LL=cdr(LL)){ - for(I=K=0; I<M; I++){ - for(J=I+1; J<M; J++, K++){ - if(LL==L) S[K]=[X[I],X[J]]; - LT=car(LL); - R1=mydiff(LT[2],X[J]); - R2=mydiff(-LT[2],X[I]); - if(R2==0){ - if(R1==0) continue; - R1=rmul(mydiff(LT[1],X[I]),R1); - }else if(R1==0){ - R1=rmul(mydiff(LT[1],X[J]),R2); - }else - R1=rmul(mydiff(LT[1],X[I]),R1)+rmul(mydiff(LT[1],X[J]),R2); - R1=rmul(LT[0],R1); - R[K] = (R[K]==0)?R1:radd(R[K],R1); - } - } - } - for(RR=[],I=N-1; I>=0; I--) - RR=cons([R[I],S[I][0],S[I][1]],RR); - return RR; -} - -def polinvsym(P,Q,Sym) -{ - N = length(Q); - T = polbyroot(Q,zz); - for(I = 1; I <= N; I++){ - P = mysubst(P,[makev([Sym,I]), (-1)^I*coef(T,N-I,zz)]); - } - return P; -} - -def polinsym(P,Q,Sym) -{ - if(type(P) == 3){ - P = red(P); - if(type(P) == 3){ - D = polinsym(dn(P),Q,Sym); - if(D == 0) - return 0; - return polinsym(nm(P),Q,Sym)/D; - } - } - N = length(Q); - V = newvect(N+1); - S = newvect(N+1); - E = newvect(N+1); - E0 = newvect(N+1); - T = polbyroot(Q,zzz); - for(J = 1; J <= N; J++){ - K = coef(T,N-J,zzz); - if(J % 2) - K = -K; - S[J] = K; - V[J] = makev([Sym,J]); - } - K = deg(P,Q[0]); - for(J = 0; J <= N; J++) - E0[J] = K+1; - E[0] = K+1; - while(deg(P,Q[0]) > 0){ - for(P0 = P, J = 1; J <= N; J++){ - E[J] = deg(P0,Q[J-1]); - P0 = coef(P0,E[J],Q[J-1]); - } - /* P0*Q[0]^E[1]*Q[1]^E[2]*... E[1] >= E[2} >= ... */ - for(J = 1; J <= N; J++){ - if(E[J] < E0[J]) - break; - if(E[J-1] < E[J]) - J = N; - } - if(J > N){ - print("Not symmetric"); - return 0; - } - for(J = 1; J <= N; J++) - E0[J] = E[J]; - for(J = N; J > 1; J--){ - if(E[J] != 0) - for(K = 1; K < J; K++) - E[K] -= E[J]; - } - for(R0 = P0, K = 1; K <= N; K++){ - if(E[K] > 0) - P0 *= S[K]^E[K]; - R0 *= V[K]^E[K]; - } - P += R0 - P0; - } - return P; -} - -def tohomog(P,L,V) -{ - while(length(L)>0){ - P = mysubst(P,[car(L),car(L)/V]); - L = cdr(L); - } - P = red(P); - N = mindeg(dn(P),V); - if(N > 0) - P = red(P*V^N); - N = mindeg(dn(P),V); - if(N > 0) - P = red(P/(V^N)); - return P; -} - -def substblock(P,X,Q,Y) -{ - P = red(P); - if(deg(dn(P),X) > 0) - return substblock(nm(P),X,Q,Y)/substblock(dn(P),X,Q,Y); - N = mydeg(Q,X); - if(N < 1) - return P; - R = mycoef(Q,N,X); - while(M = mydeg(P,X), M >= N) - P = red(P - mycoef(P,M,X)*(Q-Y)*X^(M-N)/R); - return P; -} - -def okuboetos(P,L) -{ - L = vweyl(L); X = L[0]; DX = L[1]; - N = mydeg(P,DX); - C = mycoef(P,N,DX); - K = mydeg(C,X); - if(K > N){ - print("Irregular singularity at infinity")$ - return 0; - } - if(N > K) - P *= x^(N-K); - - L = getroot(mycoef(P,N,DX),x); - L = ltov(reverse(L)); - if(length(L) != N || N == 0){ - print("Cannot get exponents")$ - return 0; - } - if( type(LL = getopt(diag)) == 4 ){ - LL = ltov(LL); - if(length(LL) != N){ - mycat(["Length of the option should be", N]); - return 0; - } - Tmp = newvect(N); - for(I = N-1; I >= 0; I--){ - for(LLT = LL[I], J = N-1; J >=0 ; J--){ - if(LLT == L[J] && Tmp[J] == 0){ - Tmp[J] = 1; - break; - } - } - if(J < 0){ - print("option is wrong"); - return 0; - } - } - L = LL; - } - P /= mycoef(C,N,X); - A = newmat(N,N); - AT = newmat(N+1,N+1); - Phi= newvect(N+1); - Phi[0] = 1; - for(J = 0; J < N; J++) - Phi[J+1] = Phi[J]*(X-L[J]); - for(ATT = AT[N], J = 0; J < N; J++) - ATT[J] = mycoef(P,J,DX); - - for(K = 1; K <= N; K++){ - for(J = N; J >= K; J--){ - Aj = A[J-1]; - SIG = AT[J][J-K]; - for(I = 0; I <= K-2; I++) - SIG += Aj[J-I-1]*AT[J-I-1][J-K]; - if(K == 1) - DAT = mydiff(Phi[J-1],X); - else - DAT = mydiff(AT[J-1][J-K],X); - Aj[J-K] = -SIG+(X-L[J-1])*DAT; - Aj[J-K] /= Phi[J-K]; - Aj[J-K] = mysubst(Aj[J-K],[X,L[J-1]]); - if(J < K+1) continue; - ATj = AT[J-1]; - ATj[J-K-1] = SIG+Aj[J-K]*Phi[J-K]; - ATj[J-K-1] /= (X - L[J-1]); - ATj[J-K-1] = red(ATj[J-K-1]-DAT); - } - } - - ATT = newmat(N,N); - for(J = 0; J < N; J++){ - for(K = 0; K < N; K++){ - ATj = ATT[J]; - ATj[K] = AT[J][K]; - } - ATj[J] = Phi[J]; - if(J < N-1){ - ATj = A[J]; - ATj[J+1] = 1; - } - } - return [L,A,ATT]; -} - -def heun(X,P,R) -{ - if(type(X) != 4 || length(X) != 5){ - print("Usage: huen([a,b,c,d,e],p,r)"); - print("0: 0 c"); - print("1: 0 d"); - print("p: 0 e"); - print("infty: a b"); - print("Fuchs relation: a+b+1 = c+d+e"); - return; - } - S = 1; - V = -1; - X = ltov(X); - for(I = 0; I < 5; I++){ - if(X[I] == "?"){ - if(V >= 0) - return; - V = I; - }else if(I < 2){ - S += X[I]; - }else - S -= X[I]; - } - if(V >= 0){ - if(V < 2) - X[V] = -S; - else - X[V] = S; - }else if(S != 0){ - mycat(["Fuch relation:", S,"should be zero!"]); - return; - } - return - x*(x-1)*(x-P)*dx^2 - + (X[2]*(x-1)*(x-P)+X[3]*x*(x-P)+X[4]*x*(x-1))*dx - + X[0]*X[1]*(x-R); -} - -def fspt(M,T) -{ - if(type(M)==7) M=s2sp(M); - if(T == 3) /* 3: cut 0 */ - return cutgrs(M); - if(T == 4 || T== 5){ /* 4: short 5: long */ - for(MN = [] ; M != []; M = cdr(M)){ - MT = car(M); - for(MNT = []; MT != []; MT = cdr(MT)){ - if(type(car(MT)) <= 3){ - if(T == 4) MNT = cons(car(MT),MNT); - else MNT = cons([1,car(MT)],MNT); - }else{ - if(T == 5 || car(MT)[0] > 1) MNT = cons(car(MT),MNT); - else if(car(MT)[0] == 1) MNT = cons(car(MT)[1],MNT); - } - } - MN = cons(reverse(MNT), MN); - } - return reverse(MN); - } - if(type(M[0][0]) == 4){ - for(MN = [] ; M != []; M = cdr(M)){ - MT = car(M); - for(MNT = []; MT != []; MT = cdr(MT)) - MNT = cons(car(MT)[0], MNT); - MN = cons(reverse(MNT), MN); - } - return fspt(reverse(MN),T); - } - if(T == 0) /* 0: sp */ - return M; - for(MN = [] ; M != []; M = cdr(M)){ - MT = qsort(ltov(car(M))); - L = length(MT); - for(MNT = [], I = 0; I < L; I++) - MNT = cons(MT[I], MNT); - MN = cons(MNT, MN); - } - MN = reverse(MN); - if(T==6) return MN; /* 7: sort */ - L = length(MN); - for(M = MN; M != []; M = cdr(M)){ - for(I = 0, MT = car(M); MT != []; MT = cdr(MT)) - I += car(MT); - if(OD == 0) - OD = I; - else if(OD != I || OD == 0) - return 0; - } - ALL = [MN]; - RD=[]; - while(OD > 0){ - for(S = 0, MT = MN; MT != []; MT = cdr(MT)) - S += car(MT)[0]; - S -= (L-2)*OD; - if(S <= 0){ - if(T==7) return [ALL[0],ALL[length(ALL)-1],RD]; - return (T==1)?MN:ALL; - } - RD=cons([S,0,0],RD); - for(NP=0, M = [], MT = MN; MT != []; NP++, MT = cdr(MT)){ - MTT = car(MT); - I = MTT[0] - S; - if(I < 0){ - if(I+OD!=0) return 0; - if(T==7) return [ALL[0],ALL[length(ALL)-1],cdr(RD)]; - return (T==1)?MN:ALL; - } - MTT = cdr(MTT); - NC=1; DO=0; - for(MNT = []; MTT != []; MTT = cdr(MTT)){ - if(MTT[0] > I){ - if(DO==0) RD=cons([MTT[0]-I,NP,NC++],RD); - MNT = cons(MTT[0], MNT); - } - else if(MTT[0] <= I && I != 0){ - DO=1; - MNT = cons(I, MNT); - I = 0; - if(MTT[0] > 0) - MNT = cons(MTT[0], MNT); - } - } - if(I > 0) - MNT = cons(I,MNT); - M = cons(reverse(MNT), M); - } - MN = reverse(M); - ALL = cons(MN,ALL); - OD -= S; - } -} - -def abs(X) -{ - if(vars(X)!=[]) return todf(os_md.abs,[X]); - if(type(X)==4){ - P=X[1];X=X[0]; - }else P=0; - if(type(X)==1){ - if((T=ntype(X))<2 || T==3){ - if(X<0) X=-X; - }else if(T==4) X=P?pari(abs,X,P):pari(abs,X); - } - return X; -} - -def sgn(X) -{ - if(X==0) return 0; - if(type(X)==1){ - return (X>0)?1:-1; - } - if(type(X)==5) X=vtol(X); - if(type(X)==4){ - for(W=0,Y=X;Y!=[];Y=cdr(Y)) - for(Z=cdr(Y);Z!=[];Z=cdr(Z)) - if(car(Y)>car(Z)) W++; - if(getopt(val)==1) return W; - return (iand(W,1))?-1:1; - } -} - -def calc(X,L) -{ - if(type(X)<4||type(X)==7){ - if(type(L)==4||type(L)==7){ - V=L[1]; - if(type(X)!=7){ - if((L0=L[0])=="+") X+=V; - else if(L0=="-") X-=V; - else if(L0=="*") X*=V; - else if(L0=="/") X/=V; - else if(L0=="^") X^=V; - } - if((L0=L[0])==">") X=(X>V); - else if(L0=="<") X=(X<V); - else if(L0=="=") X=(X==V); - else if(L0==">=") X=(X>=V); - else if(L0=="<=") X=(X<=V); - else if(L0=="!=") X=(X!=V); - }else if(type(L)==7&&type(X)<4){ - if(L=="neg") X=-X; - else if(L=="abs") X=abs(X); - else if(L=="neg") X=-X; - else if(L=="sqr") X*=X; - else if(L=="inv") X=1/X; - else if(L=="sgn"){ - if(X>0)X=1; - else if(X<0) X=-1; - } - } - } - return X; -} - -def isint(X) -{ - if(X==0||(type(X)==1 && ntype(X)==0 && dn(X)==1)) return 1; - return 0; -} - -def israt(X) -{ - if(X==0||(type(X)==1 && ntype(X)==0)) return 1; - return 0; -} - -def iscrat(X) -{ - if(X==0 || (type(X)==1 && israt(real(X)) && israt(imag(X)))) return 1; - return 0; -} - -def isalpha(X) -{ - return ((X>64&&X<91)||(X>96&&X<123))?1:0; -} - -def isnum(X) -{ - return (X>47&&X<58)?1:0; -} - -def isalphanum(X) -{ - return (isalpha(X)||isnum(X))?1:0; -} - -def isdecimal(X) -{ - if(type(X)!=7) return 0; - F=S=0; - L=strtoascii(X); - while(L!=[]&&car(L)==32) L=cdr(L); - if(L!=[]&&car(L)==45) L=cdr(L); /* - */ - while(L!=[]&&isnum(car(L))){ - F=1; L=cdr(L); - } - while(L!=[]&&car(L)<33){ - S=1;L=cdr(L); - } - if(L==[]) return F; - else if(S||car(L)!=46) return 0; /* . */ - L=cdr(L);F=0; - while(L!=[]&&isnum(car(L))){ - F=1; L=cdr(L); - } - while(L!=[]&&car(L)<33) L=cdr(L); - return (L==[])?F:0; -} - -def isvar(X) -{ - return ([X]==vars(X)&&vtype(X)<3)?1:0; -} - -def isyes(F) -{ - if((CC=getopt(set))==1){ - IsYes=(type(F[0])==4)?F:[F]; - return 1; - }else if(CC==0) return(IsYes); - if(type(CC)!=7) - CC=IsYes; - for(;CC!=[]; CC=cdr(CC)){ - C=car(CC); - V=call(C[0],cons(F,C[1])); - if(type(C[2])!=4){ - if(V!=C[2]) break; - }else{ - if(C[2][0]!="" && V<C[2][0]) break; - if(C[2][1]!="" && V>C[2][1]) break; - } - } - return (CC==[])?1:0; -} - -def isall(FN,M) -{ - if(type(M)<4 || type(M)>6) return ((*FN)(M)==0)?0:1; - if(type(M)==4){ - for(;M!=[];M=cdr(M)) - if((*FN)(car(M))==0) return 0; - }else if(type(M)==5){ - K=length(M); - for(I=0;I<K;I++) - if((*FN)(M[I])==0) return 0; - }else if(type(M)==6){ - K=size(M)[0]; - for(I=0;I<K;I++) - if (isall(FN,M[I])==0) return 0; - } - return 1; -} - -def sproot(MP,T) -{ - if((I=str_chr(T,0,","))>0){ - if(type(MP)==7) M=s2sp(MP); - else M=chkspt(MP|opt=0); - if(I==length(M[0])){ - N=s2sp(T);S=SM=SN=K=0; - for(MM=M,NN=N;MM!=[];MM=cdr(MM),NN=cdr(NN),K++){ - for(MT=car(MM),NT=car(NN);MT!=[];MT=cdr(MT),NT=cdr(NT)){ - S+=car(MT)*car(NT); - if(K==0){ - SM+=car(MT);SN+=car(NT); - } - } - } - return S-(length(M)-2)*SM*SN; - } - } - MM=chkspt(MP|opt=7); - if(T=="base") return MM; - Keep=(getopt(keep)==1)?1:0; - Null=getopt(null); - Only=getopt(only); - if(type(Only)!=1) Only=7; - M0=MM[0]; - M1=MM[1]; - M=MM[2]; - if(T=="length") return length(M); - if(T=="height"){ - for(J=2,S=M1[0][0],M2=M1; M2!=[]; M2=cdr(M2)){ - for(MT=cdr(car(M2)); MT!=[]; J++, MT=cdr(MT)){ - S+= J*car(MT); - } - J=1; - } - return S; - } - for(OD=0, MT=M1[0]; MT!=[]; MT=cdr(MT)) OD+=car(MT); - if(T=="type"){ - R=newvect(OD+1); - for(MT=M; MT!=[]; MT=cdr(MT)) R[MT[0][0]]++; - for(RR=[],I=OD; I>0; I--) - if(R[I]>0) RR=cons([R[I],I],RR); - return RR; - } - if(T=="part"||T=="pair"||T=="pairs"){ - NP=length(M1); - LM=newvect(NP); - R=newvect(length(M)); - for(K=0; K<NP; K++) LM[K]=length(M1[K]); - for(I=0,TM=M; TM!=[]; I++, TM=cdr(TM)){ - V=newvect(NP); - for(K=0; K<NP; K++) V[K]=newvect(LM[K]); - TP=car(TM); - if(TP[2]==0){ - for(K=0;K<NP;K++) V[K][0]=1; - for(J=0; J<I; J++){ - VJ=R[J][1]; - for(S=K=0;K<NP;K++) S+=VJ[K][0]; - for(OD=0,K=0;K<LM[0];K++) OD+=VJ[0][K]; - S-=(NP-2)*OD; - for(K=0;K<NP;K++) VJ[K][0]-=S; - } - }else{ - K=TP[1]; P=TP[2]; - V[K][P-1]=-1; V[K][P]=1; - for(J=0; J<I; J++){ - VJ=R[J][1]; - S=VJ[K][P]; VJ[K][P]=VJ[K][P-1]; VJ[K][P-1]=S; - } - } - R[I]=[TP[0],V]; - } - if(T=="pair"||T=="pairs"){ - MV=ltov(M1); - for(K=0; K<NP; K++) MV[K] = ltov(MV[K]); - for(RR=UU=SS=[],I=0; I<length(M); I++){ - V=newvect(NP); W=newvect(NP); U=newvect(NP); - for(K=0; K<NP; K++){ - U[K]=newvect(LM[K]); V[K]=newvect(LM[K]); W[K]=newvect(LM[K]); - } - S=R[I][0]; - for(K=0; K<NP; K++){ - for(Q=J=0; J<LM[K]; J++){ - V[K][J] = S*(U[K][J] = R[I][1][K][J]); - Q+=(W[K][J] = MV[K][J] - V[K][J]); - } - } - if(Q>0 && iand(Only,1)==0) continue; - if(Q==0 && iand(Only,2)==0) continue; - if(Q<0 && iand(Only,4)==0) continue; - for(K=0; K<NP; K++){ - V[K] = vtol(V[K]); W[K] = vtol(W[K]); U[K]=vtol(U[K]); - } - V=vtol(V); W=vtol(W);U=vtol(U); - if(Q<0) S=-S; - RR = cons([V,W], RR); UU = cons(U,UU); SS=cons(S,SS); - } - RR = reverse(RR); UU=reverse(UU); SS=reverse(SS); - if(getopt(dviout)==1 && (Null!=1 || RR!=[])){ - Out=string_to_tb("\\begin{align}\\begin{split}"+s2sp(M1)+"&="); - for(I=0,R=RR, U=UU; R!=[]; I++, R=cdr(R), U=cdr(U)){ - if(I>0) str_tb("\\\\\n &=",Out); - if(T=="pairs"){ - if((S=SS[I])<0) S=-S; - if(S>1) str_tb([my_tex_form(S),"("],Out); - str_tb(s2sp(car(U)),Out); - if(S>1) str_tb(")",Out); - str_tb(" \\oplus ",Out); - if(SS[I]<0){ -#ifdef USEMODULE - str_tb(["-(",s2sp(mtransbys(os_md.abs,car(R)[1],[])),")"],Out); -#else - str_tb(["-(",s2sp(mtransbys(abs,car(R)[1],[])),")"],Out); -#endif - }else - str_tb(s2sp(car(R)[1]),Out); - }else - str_tb([s2sp(car(R)[0])," \\oplus ",s2sp(car(R)[1])],Out); - } - str_tb("\n\\end{split}\\end{align}",Out); - dviout(str_tb(0,Out)|keep=Keep); - } - return RR; - } - for(I=0; I<length(M); I++){ - for(K=0; K<NP; K++) R[I][1][K] = vtol(R[I][1][K]); - R[I] = [R[I][0],vtol(R[I][1])]; - } - R = vtol(R); - return [M0,M1,R]; - } -} - -def spgen(MO) -{ - Eq=(getopt(eq)==1)?1:0; - Sp=getopt(sp); - if(type(Sp)==7) Sp=s2sp(Sp); - St=getopt(str); - LP=getopt(pt); - F=getopt(std); - if(F!=1&&F!=-1) F=0; - if(type(LP)==4){ - L0=LP[0]; L1=LP[1]; - }else{ - L0=0; L1=MO+1; - } - if(MO<=0){ - MO=-MO; - if(iand(MO,1)==1) return []; - if(MO>1){ - if(isMs()==0) return []; - Cmd="okubo "+rtostr(-MO); - MO/=2; - if(L1>0) Cmd=Cmd+"+"+rtostr(L0)+"-"+rtostr(L1); - else L1=MO+4; - Cmd=Cmd+" B"; - Id=getbyshell(Cmd); - if(Id<0) return []; - B=[]; - while((S=get_line(Id)) !=0){ - P0=str_chr(S,1,":")+1; - if(P0>1){ - P1=str_chr(S,P,"\n"); - if(P1<0) P1=str_len(S); - B=cons(sub_str(S,P0,P1-1),B); - } - } - close_file(Id); - }else{ - MO/=2; - if(L1<=1) L1=MO+4; -BB=[ -["11,11,11,11","111,111,111","1^4,1^4,22","1^6,222,33"], -["11,11,11,11,11","1^4,1^4,211","211,22,22,22","1^6,2211,33", -"2211,222,222","22211,2^4,44","2^511,444,66","1^4,22,22,31", -"2^5,3331,55","1^5,1^5,32","1^8,332,44","111,111,21,21","1^5,221,221"], -["11,11,11,11,11,11","1^4,1^4,1^4","1^4,22,22,22","111,111,111,21", -"1^6,21^4,33","21^4,222,222","221^4,2^4,44","2^41^4,444,66", -"1^5,1^5,311","1^8,3311,44","1^6,222,321","321,33,33,33", -"3321,333,333","33321,3^4,66","3^721,666,99","2^5,3322,55", -"1^6,1^6,42","222,33,33,42","1^a,442,55","1^6,33,33,51", -"222,222,33,51","1^9,333,54","2^7,554,77","1^5,2111,221", -"2^41,333,441","1^7,2221,43","211,211,22,22","2211,2211,222", -"22211,22211,44","1^4,211,22,31","2^411,3331,55","1^4,1^4,31,31", -"22,22,22,31,31","1^7,331,331","2221,2221,331","111,21,21,21,21"], -["11,11,11,11,11,11,11","111,111,111,111","1^6,1^6,33", -"1^6,222,222","222,33,33,33","1^5,1^5,221", -"1^4,211,22,22","1^4,1^4,22,31","22,22,22,22,31", -"111,111,21,21,21","21^6,2^4,44","2221^6,444,66", -"1^6,222,3111","3111,33,33,33","33111,333,333", -"333111,3^4,66","3^5111,666,99","2^5,33211,55", -"1^8,3221,44","3222,333,333","33222,3^4,66", -"3^4222,666,99","1^6,1^6,411","222,33,33,411", -"1^a,4411,55","2^4,2^4,431","431,44,44,44", -"2^6,4431,66","4431,444,444","44431,4^4,88", -"4^531,888,cc","1^a,433,55","1^7,1^7,52", -"1^c,552,66","3^4,444,552","1^8,2^4,53", -"1^8,44,44,71","3^5,555,771","21^4,2211,222", -"221^4,22211,44","2221^4,3331,55","1^6,2211,321", -"2^411,3322,55","1^7,322,331","2211,33,33,42", -"3^42,4442,77","2211,222,33,51","3^51,5551,88", -"2^611,554,77","2221,2221,322","2^41,2^41,54", -"1^5,2111,2111","222111,333,441","1^7,22111,43", -"1^5,1^5,41,41","1^9,441,441","22111,2221,331", -"1^5,221,32,41","221,221,221,41","211,211,211,22", -"2211,2211,2211","1^4,211,211,31","211,22,22,31,31", -"1^4,22,31,31,31","1^5,32,32,32","221,221,32,32","21,21,21,21,21,21"], -["11,11,11,11,11,11,11,11","1^4,1^4,22,22","1^8,2^4,44", -"1^6,2211,222","2211,33,33,33","111,111,111,21,21", -"1^5,1^5,2111","1^4,211,211,22","1^4,1^4,211,31", -"211,22,22,22,31","1^4,22,22,31,31","111,21,21,21,21,21", -"221^8,444,66","2^5,331^4,55","1^8,32111,44", -"32211,333,333","332211,3^4,66","3^42211,666,99", -"2^5,32221,55","1^7,1^7,511","1^c,5511,66", -"3^4,444,5511","541,55,55,55","5541,555,555", -"55541,5^4,aa","5^541,aaa,ff","1^8,1^8,62", -"1^a1^4,662,77","1^a,55,55,91","2^71,555,87", -"21^6,22211,44","221^6,3331,55","1^6,2211,3111", -"2^411,33211,55","1^7,3211,331","2211,33,33,411", -"3^42,44411,77","22211,2^4,431","2^511,4431,66", -"1^8,332,431","3^42,4433,77","1^8,22211,53", -"2221,2221,3211","221^5,333,441","1^7,21^5,43", -"1^b,443,65","21^5,2221,331","2^51,3332,65", -"21^4,21^4,222","221^4,221^4,44","1^6,21^4,321", -"2221^4,3322,55","21^4,33,33,42","21^4,222,33,51", -"2^51^4,554,77","2^4,3311,3311","3^411,4442,77", -"321,321,33,33","3321,3321,333","33321,33321,66", -"222,321,33,42","1^6,321,33,51","222,222,321,51", -"1^9,3321,54","1^7,322,322","3^422,5551,88", -"1^6,33,42,42","1^6,222,42,51","33,33,33,42,51", -"1^6,1^6,51,51","222,33,33,51,51","1^b,551,551", -"1^5,221,311,41","2^41,3321,441","22111,2221,322", -"2^51,443,551","222111,2^41,54","21^4,2211,2211", -"1^5,311,32,32","3331,3331,442","2211,2211,33,51", -"221,221,311,32","22111,22111,331","1^5,2111,32,41", -"2111,221,221,41","2111,221,32,32","211,211,211,211", -"211,211,22,31,31","1^4,211,31,31,31","22,22,31,31,31,31"], -["11,11,11,11,11,11,11,11,11","1^5,1^5,1^5","2^5,2^5,55", -"111,111,111,111,21","2^41,333,333","1^4,1^4,211,22", -"211,22,22,22,22","1^8,22211,44","1^4,1^4,1^4,31", -"1^4,22,22,22,31","1^7,1^7,43","1^7,2221,331", -"2221,2221,2221","1^6,21^4,222","21^4,33,33,33", -"1^6,1^6,321","222,321,33,33","1^6,33,33,42", -"222,222,33,42","1^6,222,33,51","222,222,222,51", -"33,33,33,33,51","1^6,2211,2211","111,111,21,21,21,21", -"1^5,1^5,32,41","1^5,221,221,41","1^5,221,32,32", -"221,221,221,32","1^4,211,211,211","211,211,22,22,31", -"1^4,211,22,31,31","1^4,1^4,31,31,31","22,22,22,31,31,31", -"21,21,21,21,21,21,21","21^a,444,66","1^8,31^5,44", -"321^4,333,333","3321^4,3^4,66","3^421^4,666,99", -"2^5,322111,55","32^41,3^4,66","3332^41,666,99", -"1^8,1^8,611","2^4,44,44,611","1^d,6611,77", -"4^5,66611,aa","2^6,444,651","3^4,3^4,651", -"651,66,66,66","3^6,6651,99","6651,666,666", -"66651,6^4,cc","6^551,ccc,ii","2^8,655,88", -"1^9,1^9,72","1^g,772,88","1^c,444,75", -"2^6,3^4,75","1^c,66,66,b1","3^4,444,66,b1", -"3^7,777,ba","1^7,2221,4111","2^41,333,4311", -"1^9,2^41,63","21^8,3331,55","2^411,331^4,55", -"1^7,31^4,331","2^411,32221,55","22211,2^4,422", -"2^511,4422,66","1^8,332,422","2^5,3331,541", -"22211,44,44,62","2^411,2^5,64","2^711,664,88", -"1^a,3331,64","2221,2221,31^4","21^7,333,441", -"333,333,441,81","2^6111,555,87","21^6,221^4,44", -"221^6,3322,55","2^41^6,554,77","1^6,21^4,3111", -"3111,321,33,33","33111,3321,333","333111,33321,66", -"222,3111,33,42","1^6,3111,33,51","222,222,3111,51", -"1^9,33111,54","2221^4,33211,55","1^7,3211,322", -"3^4211,5551,88","2^4,3221,3311","333221,4442,77", -"3222,3321,333","33222,33321,66","1^9,3222,54", -"21^4,33,33,411","3^411,44411,77","222,321,33,411", -"1^6,33,411,42","1^6,222,411,51","33,33,33,411,51", -"221^4,2^4,431","2^41^4,4431,66","1^8,3311,431", -"3^411,4433,77","33321,444,552","1^8,221^4,53", -"3311,44,44,53","4^42,5553,99","2^4,3311,44,71", -"3^421,555,771","4^52,7771,bb","3^611,776,aa", -"2^41,33111,441","22111,2221,3211","2^41,3222,441", -"2^61,4441,76","3331,3331,4411","22211,22211,431", -"3331,3331,433","3^41,3^41,76","1^7,1^7,61,61", -"1^d,661,661","21^5,2221,322","221^5,2^41,54", -"2^51,33311,65","21^5,22111,331","3^41,4441,661", -"1^7,331,43,61","2221,2221,43,61","2221,331,331,61", -"21^4,21^4,2211","21^4,2211,33,51","22211,3311,3311", -"1^5,311,311,32","2211,321,33,42","2211,222,321,51", -"3322,3331,442","2211,222,42,42","2^411,442,442", -"1^6,2211,42,51","2211,33,33,51,51","221,221,311,311", -"1^5,2111,311,41","222111,3321,441","22111,22111,322", -"222111,222111,54","2111,221,311,32","2111,2111,221,41", -"1^5,221,41,41,41","2221,43,43,43","1^5,32,32,41,41", -"331,331,43,43","221,221,32,41,41","221,32,32,32,41", -"211,211,211,31,31","211,22,31,31,31,31","1^4,31,31,31,31,31"]]; - B=BB[MO]; - } - if(St!=1){ - for(R=[]; B!=[]; B=cdr(B)){ - RT=F?s2sp(car(B)|std=F):s2sp(car(B)); - if(length(RT)<L0 || length(RT)>L1) continue; - R=cons(RT,R); - } - return reverse(R); - }else{ - if(L0<=3 && L1>=MO+4) return B; - for(R=[]; B!=[]; B=cdr(B)){ - RT=s2sp(T=car(B)); - if(length(RT)<L0 || length(RT)>L1) continue; - if(F) T=s2sp(s2sp(T|std=K)); - R=cons(T,R); - } - return reverse(R); - } - } - MP=(L1<MO+1)?L1:MO+1; - LL=newvect(MO+1); - R=newvect(MP+2); - R0=newvect(MP+2); - for(I=1; I<=MO; I++) LL[I]=[]; - if(type(Sp)==4){ - if(getopt(basic)==1) Sp=chkspt(Sp[6]); - R=chkspt(Sp); - if(R[1]>MO) return 0; - LL[R[1]]=R; - K=R[1]; - } - if(K==1||type(Sp)!=4){ - LL[1]=[[[1]]]; - for(I=2; I<=MO && I<MP;I++){ - for(T=[], J=0; J<I+1; J++) - T=cons([I-1,1],T); - LL[I]=cons(T,LL[I]); - } - K=2; - } - for(OD=K; OD<MO; OD++){ - for(LT=LL[OD]; LT!=[]; LT=cdr(LT)){ - for(II=0,L=car(LT); L!=[]; II++, L=cdr(L)){ - R0[II]=R[II]=car(L); - } - for(; ;){ - for(S=-2*OD, I=0; I<II; I++){ - S += OD; - if(R[I]!=[]) S-=car(R[I]); - } - --I; - for(;S+OD<=MO && I<=MP;S+=OD,I++){ - if(S<=0) continue; - for(J=0;J<=I;J++){ - if(J>=II){ - if(S<OD) break; - }else - if(S+((R[J]==[])?0:car(R[J]))<car(R0[J])) break; - } - if(--J>=I){ - V=newvect(I); - RRR=[]; - for(;J>=0;J--){ - if(J>=II) RR=[OD,S]; - else{ - K=length(R[J]); - RR=[S+((K==0)?0:car(R[J]))]; - K=length(R0[J])-K; - for(RT=R0[J]; RT!=[]; K--,RT=cdr(RT)){ - if(K!=0) RR=cons(car(RT),RR); - } - } - RRR=cons(reverse(RR),RRR); - } - RRR=qsort(reverse(RRR)); - if(findin(RRR,LL[S+OD])<0) - LL[S+OD]=cons(RRR,LL[S+OD]); - } - } - for(K=0; K<II; K++){ - if(R[K]!=[]){ - S=car(R[K]); - while((R[K]=cdr(R[K]))!=[] && car(R[K])==S); - break; - }else R[K]=R0[K]; - } - if(K>=II) break; - } - } - } - if(L0>0 || L1<MO+1 || St==1 || F){ - for(J=1; J<=MO; J++){ - for(RT=[],R=LL[J];R!=[];R=cdr(R)){ - L=length(T=car(R)); - if(L<L0 || L>L1) continue; - if(F) T=s2sp(T|std=F); - RT=cons((St==1)?s2sp(T):T,RT); - } - LL[J] = reverse(RT); - } - } - if(Eq==1) return LL[MO]; - return LL; -} - -def spType2(L) -{ - C=0;R=[]; - for(LT=L;LT!=[];LT=cdr(LT)){ - D=-1;LP=car(LT); - for(LPT=LP;LPT!=[];LPT=cdr(LPT)){ - if(D==-1) D=car(LPT); - else D=igcd(D,car(LPT)); - if(D==1){ - C++;break; - } - } - if(C==2) return 0; - R=cons(D,R); - } - if(C==0) return L; - if(C==1){ - for(K=length(R)-1;R[K]!=1;K--); - D=-1; - for(I=length(R)-1;I>=0;I--){ - if(I==K) continue; - if(D==-1) D=R[I]; - else D=igcd(D,R[I]); - if(D==1) return 0; - } - } - return L; -} - - -/* ret [#points, order, idx, Fuchs, reduction order, reduction exponents, fund] */ -def chkspt(M) -{ - Opt= getopt(opt); - Mat= getopt(mat); - if(type(M)==7) M=s2sp(M); - if(type(Opt) >= 0){ - if(type(Opt) == 7) - Opt = findin(Opt, ["sp","basic","construct","strip","short","long","sort","root"]); - if(Opt < 0){ - erno(2); - return 0; - } - return fspt(M,Opt); - } - MR = fspt(M,1); - P = length(M); - OD = -1; - XM = newvect(P); - Fu = 0; - for( I = SM = SSM = 0; I < P; I++ ){ - LJ = length(M[I]); - JM = JMV = 0; - for(J = SM = 0; J < LJ; J++){ - MV = M[I][J]; - if(type(MV) == 4){ - Fu += MV[0]*MV[1]; - MV = MV[0]; - } - if(MV > JMV){ - JM = J; JMV = MV; - } - SM += MV; - SSM += MV^2; - } - if(OD < 0) - OD = SM; - else if(OD != SM){ - print("irregal partitions"); - return 0; - } - XM[I] = JM; - } - SSM -= (P-2)*OD^2; - for(I = SM = JM = 0; I < P; I++){ - MV = M[I][XM[I]]; - if(type(MV) == 4){ - MV = MV[0]; JM = 1; - } - if(I == 0) - SMM = MV; - else if(SMM > MV) - SMM = MV; - SM += MV; - } - SM -= (P-2)*OD; - if(SM > SMM && SM != 2*OD){ - print("not realizable"); - return -1; - } - if(JM==1 && Mat!=1) - Fu -= OD - SSM/2; - return [P, OD, SSM, Fu, SM, XM, MR]; -} - -def cterm(P) -{ - V = getopt(var); - if(type(V) != 4) - V=vars(P); - for(; V !=[]; V = cdr(V)) - P = mycoef(P,0,car(V)); - return P; -} - -def terms(P,L) -{ - Lv=getopt(level); - if(type(Lv)!=1) Lv=0; - V=car(L);L=cdr(L); - for(R=[],D=mydeg(P,V);D>=0; D--){ - if((Q=mycoef(P,D,V))==0) continue; - if(L!=[]){ - R0=terms(Q,L|level=Lv+1); - for(;R0!=[];R0=cdr(R0)) R=cons(cons(D,car(R0)),R); - }else R=cons([D],R); - } - if(Lv>0) return R; - R=qsort(R); - Rev = getopt(rev); Dic=getopt(dic); - if(Dic==1 && Rev==1) R=reverse(R); - for(R0=[];R!=[];R=cdr(R)){ - for(RT=car(R),S=0;RT!=[];RT=cdr(RT)) S+=car(RT); - R0=cons(cons(S,car(R)),R0); - } - if(Dic==1) return R0; - if(Rev==1){ - for(R=[];R0!=[];R0=cdr(R0)){ - T=car(R0); - R=cons(cons(-car(T),cdr(T)),R); - } - R0=R; - } - R0=qsort(R0); - if(Rev==1){ - for(R=[];R0!=[];R0=cdr(R0)){ - T=car(R0); - R=cons(cons(-car(T),cdr(T)),R); - } - R0=R; - } - return (Rev==1)?R0:reverse(R0); -} - -def polcut(P,N,L) -{ - if(type(L)==2) L=[L]; - M=getopt(top); - if(type(M)!=1) M=0; - T=terms(P,L); - for(S=0;T!=[];T=cdr(T)){ - LT=car(T); - if(LT[0]<M || LT[0]>N) continue; - for(PW=1,LT=cdr(LT),V=L,Q=P;LT!=[];LT=cdr(LT),V=cdr(V)){ - Q=mycoef(Q,car(LT),car(V));PW*=car(V)^car(LT); - } - S+=Q*PW; - } - return S; -} - -def redgrs(M) -{ - Mat = getopt(mat); - if(Mat!=1) Mat=0; - R = chkspt(M|mat=Mat); - if(type(R) < 4) - return -1; - if(R[4] <= 0) - return 1-R[4]; - if(R[4] == 2*R[1]) - return 0; - V = newvect(R[0]); - Type = type(M[0][0]); - if(Type > 3){ - Mu = Mat-1; - for(I = 0; I < R[0]; I++) - Mu += M[I][R[5][I]][1]; - } - for(I = 0; I < R[0]; I++){ - IR = R[5][I]; L = []; MI = M[I]; MIE=MI[IR]; - for(J = length(MI)-1; J >= 0; J--){ - if(Type <= 3){ - VM = MI[J]; - if(J == IR){ - VM -= R[4]; - if(VM < 0) return -1; - } - L = cons(VM, L); - }else{ - VM = MI[J][0]; - if(J == IR){ - VM -= R[4]; - if(VM < 0) - return -1; - if(I == 0) - EV = 1-Mat-Mu; - else - EV = 0; - }else{ - if(I == 0) - EV = MI[J][1] - M[0][R[5][0]][1] + 1-Mat; /* + MX - Mu; */ - else - EV = MI[J][1] - MIE[1] + Mu; - } - L = cons([VM,EV], L); -/* - if(R[2] >= 2){ */ /* digid */ -/* P = dx^(R[1]); - } */ - } - } - V[I] = L; - } - return [R[5], vtol(V)]; -} - -def cutgrs(A) -{ - for(AL=[] ; A!=[]; A=cdr(A)){ /* AT: level 2 */ - for(ALT=[], AT=car(A); AT!=[]; AT=cdr(AT)){ - M = (type(car(AT)) < 4)?car(AT):car(AT)[0]; - if(M > 0) - ALT = cons(car(AT), ALT); /* ALT: level 2 */ - } - AL = cons(reverse(ALT), AL); /* AL: level 3 */ - } - return reverse(AL); -} - -def mcgrs(G, R) -{ - NP = length(G); - Mat = (getopt(mat)==1)?0:1; - for(R = reverse(R) ; R != []; R = cdr(R)){ - GN = []; - L = length(G)-1; - RT = car(R); - if(type(RT) == 4){ - RT = reverse(RT); S = 0; - for(G = reverse(G); G != []; G = cdr(G), L--){ - AD = car(RT); RT = cdr(RT); - if(L > 0) - S += AD; - else - AD = -S; - for(GTN = [], GT = reverse(car(G)); GT != []; GT = cdr(GT)) - GTN = cons([car(GT)[0],car(GT)[1]+AD], GTN); - GN = cons(GTN, GN); - } - G = GN; - continue; - } - VP = newvect(L+1); GV = ltov(G); - for(I = S = OD = 0; I <= L; I++){ - RTT = (I==0)?(Mat-RT):0; - VP[I] = -1; - for(J = M = 0, GT = GV[I]; GT != []; GT = cdr(GT), J++){ - if(I == 0) - OD += car(GT)[0]; - if(car(GT)[1] == RTT && car(GT)[0] > M){ - S += car(GT)[0]-M; - VP[I] = J; - } - } - S -= (L-1)*OD; - for(GN = [] ; L >= 0; L--){ - GT = GV[L]; - RTT = (L==0)?(-RT):RT; - FTN = (VP[L] >= 0 || S == 0)?[]:[-S,(L==0)?(Mat-RT):0]; - for(J = 0; GT != []; GT = cdr(GT), J++){ - if(J != VP[L]){ - GTN = cons([car(GT)[0],car(GT)[1]+RTT], GTN); - continue; - } - K = car(GT)[0] - S; - if(K < 0){ - print("Not realizable"); - return; - } - GTN = cons([K,(L==0)?(Mat-RT):0], GTN); - } - GN = cons(reverse(GTN), GN); - } - } - G = cutgrs(GN); - } - return G; -} - -/* - F=0 : unify - F=["add",S] : - F=["sub",S] : - F=["+",A,B] : - F=["*",A,B] : - F=["mul",K]; - F=["get",F,V] : - F=["put",F,V] : - F=["get1",F,V] : - F=["put1",F,V] : - F=["put1"] : - F=["val",F]; - F=["swap"]; - */ -def anal2sp(R,F) -{ - if(type(F)==4&&type(F[0])==4){ /* multiple commands */ - for(;F!=[];F=cdr(F)) R=anal2sp(R,car(F)); - return R; - } - if(type(F)==7) F=[F]; - if(F==0){ /* unify */ - R=ltov(R); - L=length(R); - for(J=1;J<L;J++){ - for(I=0;I<J;I++){ - if(cdr(R[I])==cdr(R[J])){ - R[I]=cons(R[I][0]+R[J][0],cdr(R[I])); - R[J]=cons(0,cdr(R[J])); - break; - } - } - } - for(G=[],I=L-1;I>=0;I--) - if(R[I][0]!=0) G=cons(R[I],G); - if(length(G[0])==2){ /* sort by multiplicity */ - R=ltov(G); - L=length(R); - for(I=1;I<L;I++){ - for(J=I;J>0;J--){ - if(R[J-1][0]>R[J][0]) break; - if(R[J-1][0]==R[J][0]){ - S1=rtostr(R[J-1][1]);S2=rtostr(R[J][1]); - if((K=str_len(S1)-str_len(S2))<0) break; - if(!K&&S1<S2) break; - } - S=R[J-1];R[J-1]=R[J];R[J]=S; - } - } - G=vtol(R); - } - return G; - } - if(F[0]=="add") return append(R,F[1]); - R=reverse(R); - if(F[0]=="sub"){ - for(S=F[1];S!=[];S=cdr(S)) - R=cons(cons(-car(S)[0],cdr(car(S))),R); - return reverse(R); - } - if(F[0]=="swap"){ - for(G=[];R!=[];R=cdr(R)) - G=cons([car(R)[0],car(R)[2],car(R)[1]],G); - return G; - } - if(F[0]=="+"){ - for(G=[];R!=[];R=cdr(R)) - G=cons([car(R)[0],car(R)[1]+F[1],car(R)[2]+F[2]],G); - return G; - } - if(F[0]=="*"){ - for(G=[];R!=[];R=cdr(R)) - G=cons([car(R)[0],car(R)[1]*F[1]+car(R)[2]*F[2]],G); - return G; - } - if(F[0]=="mult"){ - K=F[1]; - for(G=[];R!=[];R=cdr(R)) G=cons(cons(K*car(R)[0],cdr(car(R))),G); - return G; - } - if(F[0]=="get"){ - for(G=[];R!=[];R=cdr(R)) - if(car(R)[F[1]]==F[2]) G=cons(car(R),G); - return G; - } - if(F[0]=="put"){ - if(F[1]==1){ - for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],F[2],car(R)[2]],G); - }else{ - for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],car(R)[1],F[2]],G); - } - return G; - } - if(F[0]=="get1"){ - if(length(F)==2){ - for(G=[];R!=[];R=cdr(R)) G=cons([R[0][0],car(R)[F[1]]],G); - return G; - } - for(G=[];R!=[];R=cdr(R)) - if(car(R)[F[1]]==F[2]) G=cons([R[0][0],car(R)[3-F[1]]],G); - return G; - } - if(F[0]=="put1"){ - if(length(F)==1) - for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],car(R)[1],car(R)[1]],G); - else if(F[1]==1) - for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],F[2],car(R)[1]],G); - else{ - for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],car(R)[1],F[2]],G); - } - return G; - } - if(F[0]=="val"){ - V=(length(F)==1)?1:F[1]; - for(I=J=0;R!=[];R=cdr(R)){ - I+=car(R)[0]; - J+=car(R)[0]*car(R)[V]; - } - return [I,J]; - } - return 0; -} - -/* - G=0 get trivial common spct - G="..,..," spectre type of 4 singular points - P=["get"] all spct - P=["get",L] - L=n for variable x_n - L=[m,n] for residue [m,n] - L=[[m,n],[m',n']] for common spct - P=["get0",[m,n],[m',n']] for the sum of residues - P=["swap",[m,n]] for symmetry - P=["perm",[...]] for symmetry - P=["deg"] - P=["homog"] - P=["sort"] - P=[[[m,n],c],...] for addition - P=[c] or [[c],...] for middle convolution wrt 0 - P=[m,c] or [[m,c],...] for general middle convolution - P=[[a,b,c]] for special additions - P=[[d,a,b,c]] for middle convotution and additions - P=["multi",...] multiple commands - P=0,1,3 : return sim. spectre of 4 singular points -*/ -def mc2grs(G,P) -{ - if(G==0){ - G=[]; - for(I=4;I>=0;I--){ - V=lsort([0,1,2,3,4],[I],1); - for(J=1;J<4;J++){ - for(T=[],K=3;K>0;K--) - if(K!=J) T=cons(V[K],T); - G=cons([[[V[0],V[J]],T],[1,0,0]],G); - } - } - G=mc2grs(G,"sort"); - }else if(type(G)==7||(type(G)==4&&length(G)==4)){ - if(type(G)==7) G=s2sp(G); - F=(getopt(top)==0)?1:0; - K=[]; - if(type(P)==1&&iand(P,1)&&type(G[0][0])<4){ - G=s2sp(G|std=1); - if(F) G=[G[1],G[2],G[3],G[0]]; - G=sp2grs(G,[d,c,b,a],[1,length(G[0]),-1]|mat=1); - G=reverse(G); - if(iand(P,3)==3){ - V=vars(G); - for(H=L=[a,b,c,d];H!=[];H=cdr(H)) - if(findin(car(H),V)>=0) G=subst(G,car(H),makev([car(H),1])); - G=shortv(G,[a,b,c,d]); - V=vars(G); - for(H=G[3];H!=[];H=cdr(H)){ - T=car(H)[1]; - if(type(T)>1&&!isvar(T)){ - K=[car(H)[0],T]; - break; - } - } - } - F=1; - } - if(F) G=[G[3],G[0],G[1],G[2]]; - S=cons(["anal",1],getopt()); - if(!(R=m2mc(G,0|option_list=S))) return R; - for(G=0,R=cdr(R);R!=[];R=cdr(R)){ - TR=car(R)[0]; - if(TR[0]) G=mc2grs(G,[[TR[0]]]); - G=mc2grs(G,[cdr(TR)]); - } - if(type(P)==1&&K!=[]){ - for(T=10;T<36;T++){ - if(findin(X=makev([T]),V)>=0) continue; - F=K[0]*(X-K[1]); - return [F,simplify(G,[F],4)]; - } - } - } - if(type(P)<2) return G; - F=0; - if(type(P)==7||(type(P)==4&&type(P[0])<4)) P=[P]; - if((Dvi=getopt(dviout))!=1&&Dvi!=2&&Dvi!=-1) Dvi=0; - Keep=(Dvi==2)?1:0; - if(type(P)==4&&type(F=car(P))==7){ - if(F=="mult"){ - for(P=cdr(P);P!=[];P=cdr(P)) G=mc2grs(G,car(P)|option_list=getopt()); - return G; - } - if(F=="show"){ - for(R=str_tb(0,0);G!=[];){ - L=car(G); - I=L[0][0];J=L[0][1]; - str_tb("[A_{"+rtostr(I[0])+rtostr(I[1])+"}:A_{"+rtostr(J[0])+rtostr(J[1]) - +"}]&=\\left\\{",R); - for(L=cdr(L);;){ - S=car(L); - str_tb("["+my_tex_form(S[1])+":"+my_tex_form(S[2])+"]",R); - if(S[0]!=1) str_tb("_{"+rtostr(S[0])+"}",R); - if((L=cdr(L))==[]) break; - str_tb(",\\,",R); - } - str_tb("\\right\\}",R); - if((G=cdr(G))==[]) break; - str_tb(",\\\\\n",R); - } - R=texbegin("align*",str_tb(0,R)); - if(Dvi!=-1) dviout(R|keep=Keep); - return R; - } - if(F=="show0"){ - for(S="",L=[];G!=[];G=cdr(G)){ - for(TL=[],TG=cdr(car(G));TG!=[];TG=cdr(TG)) TL=cons(car(TG)[0],TL); - TL=msort(TL,[-1,0]); - if(Dvi){ - if(S!="") S=S+","; - for(I=J=0,T=append(TL,[[0]]);T!=[];T=cdr(T)){ - if(car(T)==I) J++; - else{ - if(I>0&&J>0){ - if(I>9) S=S+"("+rtostr(I)+")"; - else S=S+rtostr(I); - if(J>1){ - if(J>9) S=S+"^{"+rtostr(J)+"}"; - else S=S+"^"+rtostr(J); - } - } - I=car(T);J=1; - } - } - } - L=cons(TL,L); - } - if(Dvi){ - if(Dvi!=-1) dviout(S|eq=0); - return S; - } - return reverse(L); - } - if(F=="sort"){ - G=ltov(G);L=length(G); - for(I=0;I<L;I++){ - S=G[I][0]; - if(S[0][0]>S[0][1]) S=[[S[0][1],S[0][0]],S[1]]; - if(S[1][0]>S[1][1]) S=[S[0],[S[1][1],S[1][0]]]; - if(S[0]>S[1]){ - F=0;S=[S[1],S[0]]; - } - if(S!=G[I][0]){ - if(F==0) G[I]=cons(S,anal2sp(cdr(G[I]),"swap")); - else G[I]=cons(S,cdr(G[I])); - } - for(J=I;J>0;J--){ - if(G[J-1][0]<G[J][0]) break; - S=G[J-1];G[J-1]=G[J];G[J]=S; - } - } - return vtol(G); - } - if(F=="get"||F=="get0"){ - if(Dvi!=0) F="get"; - if(length(P)==1||type(P[1])<2){ - L=[]; - if(length(P)==1){ - for(I=3;I>=0;I--){ - for(J=4;J>I;J--) L=cons(mc2grs(G,[F,[I,J]]),L); - } - }else{ - for(I=P[1],J=4;J>=0;J--){ - if(I==J) continue; - L=cons(mc2grs(G,[F,(I<J)?[I,J]:[J,I]]),L); - } - } - if(Dvi){ - if(length(L)==10){ - R=ltov(L); - if(R[6][0]==[1,4]){ - S=R[6];R[6]=R[7];R[7]=S; - L=vtol(R); - } - } - for(R=S=[],L=reverse(L);L!=[];L=cdr(L)){ - T=car(L); - R=cons(cdr(T),R); - if(S==[]) S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}\\\\\n"; - else S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}&"+S; - } - L=ltotex(R|opt="GRS",pre=S); - if(Dvi>0) dviout(L|eq=0,keep=Keep); - } - return L; /* get all spct */ - } - if(type(T=P[1])==4){ - if(F=="get0"&&length(P)==3&&type(I=P[1])==4&&type(J=P[2])==4){ - if(I[0]>I[1]) I=[I[1],I[0]]; - if(J[0]>J[1]) J=[J[1],J[0]]; - if(I[0]>I[0]){S=I;I=J;J=S;}; - K=lsort(I,J,0); - if(length(K)==4){ - S=sp2grs(G,["get0",[I,J]]); - return anal2sp(S,[["*",1,1],0]); - } - I=lsort(K,lsort(I,J,2),1); - S=lsort([0,1,2,3,4],K,1); - D=sp2grs(G,"deg"); - if(findin(4,S)<0) D=-D; - J=sp2grs(G,["get0",[I,S]]); - if(I[0]>S[0]) J=sp2grs(J,"swap"); - return anal2sp(J,[["+",0,D],["*",-1,1]]); - } - if(type(car(T))==4){ - if(T[0][0]>T[0][1]) T=[[T[0][1],T[0][0]],T[1]]; - if(T[1][0]>T[1][1]) T=[T[0],[T[1][1],T[1][0]]]; - if(T[0][0]>T[1][0]) T=[T[1],T[0]]; - for(PG=G;PG!=[];PG=cdr(PG)) - if(car(PG)[0]==T) return (F=="get")?car(PG):cdr(car(PG)); - return []; /* get common spct */ - } - if(T[0]>T[1]) T=[T[1],T[0]]; - for(FT=0,PG=G;PG!=[];PG=cdr(PG)){ - if(car(PG)[0][0]==T){ - FT=1;break; - } - if(car(PG)[0][1]==T){ - FT=2;break; - } - } - if(!FT) return []; - L=anal2sp(cdr(car(PG)),[["get1",FT],0]); - return (F=="get")?cons(T,L):L; - } - } - if(F=="deg"){ - for(S=I=0;I<3;I++){ - for(J=I+1;J<4;J++){ - L=mc2grs(G,["get0",[I,J]]); - L=anal2sp(L,"val"); - S+=L[1]; - } - } - return S/L[0]; - } - if(F=="spct"){ - G=mc2grs(G,"get"); - M=newmat(5,5); - for(;G!=[];G=cdr(G)){ - GT=car(G);I=GT[0][0];J=GT[0][1]; - for(S=0,L=[],GT=cdr(GT);GT!=[];GT=cdr(GT)){ - L=cons(car(GT)[0],L); - } - L=reverse(qsort(L)); - M[I][J]=M[J][I]=L; - } - for(D=0,GT=M[0][1];GT!=[];GT=cdr(GT)) D+=car(GT); - for(I=0;I<5;I++){ - S=-2*D^2; - for(J=0;J<5;J++){ - if(I==J) continue; - for(L=M[I][J];L!=[];L=cdr(L)) S+=car(L)^2; - } - M[I][I]=S; - } - if(Dvi){ - S=[]; - for(I=4;I>=0;I--){ - L=[M[I][I]]; - for(J=4;J>=0;J--){ - if(I==J) L=cons("",L); - else L=cons(s2sp([M[I][J]]),L); - } - S=cons(L,S); - } - S=cons([x0,x1,x2,x3,x4,"idx"],S); - M=ltotex(S|opt="tab",hline=[0,1,z],vline=[0,1,z-1,z],left=["","$x_0$","$x_1$","$x_2$","$x_3$","$x_4$"]); - if(Dvi>0) dviout(M|keep=Keep); - } - return M; - } - if(F=="swap"||F=="perm"){ - if(F=="perm") TR=P[1]; - else{ - TR=newvect(5,[0,1,2,3,4]); - K=P[1][0];L=P[1][1]; - TR[K]=L;TR[L]=K; - if(TR[4]!=4) G=mc2grs(G,"deg"); - } - V=newvect(2); - for(L=[],T=G;T!=[];T=cdr(T)){ - TP=car(T)[0]; - for(TQ=[],I=1;I>=0;I--){ - V=[TR[TP[I][0]],TR[TP[I][1]]]; - if(V[0]>V[1]) V=[V[1],V[0]]; - TQ=cons(V,TQ); - } - if(TQ[0][0]<TQ[1][0]){ - L=cons(cons(TQ,cdr(car(T))),L); - continue; - } - TQ=[[TQ[1],TQ[0]]]; - for(TP=cdr(car(T));TP!=[];TP=cdr(TP)) - TQ=cons([car(TP)[0],car(TP)[2],car(TP)[1]],TQ); - L=cons(reverse(TQ),L); - } - return mc2grs(L,"sort"); - } - if(F=="homog"){ - V=mc2grs(G,"deg"); - return mc2grs(G,[[[2,3],-V]]); - }else if(F=="deg"){ - R=mc2grs(G,4); - for(V=0;R!=[];R++){ - for(TR=cdr(R);TR!=[];TR=cdr(TR)) - V+=car(TR)[0]*car(TR)[1]; - } - return -V; - } - } - if(type(F)!=4) return 0; - if(type(P[0])!=4) P=[P]; - for(;P!=[];P=cdr(P)){ - if(type((S=P[0])[0])==4){ /* addition */ - T=P[0][0]; - if(T[0]>T[1]) T=[T[1],T[0]]; - T1=[T[0],4];T2=[T[1],4]; - for(L=[],PG=reverse(G);PG!=[];PG=cdr(PG)){ - R=car(PG);R0=R[0];F=0;K=P[0][1]; - if(R0[0]==T) F=1; - else if(R0[1]==T) F=2; - else if(getopt(unique)!=1){ - K=-K; - if(R0[0]==T1||R0[0]==T2) F=1; - else if(R0[1]==T1||R0[1]==T2) F=2; - } - if(F==0) L=cons(R,L); - else{ - R1=anal2sp(cdr(R),(F==1)?["+",K,0]:["+",0,K]); - L=cons(cons(R0,R1),L); - } - } - G=L; - }else if(type(S[0])<4){ - if(length(S)==1){ /* mc wrt0 4:cases */ - U=mc2grs(G,"deg"); - C=P[0][0]; - L=[]; - /* [[0,1],[2,3]] : [K=[0,k],J=[i,j]], S=[k,4] : 3 cases */ - for(K=1;K<4;K++){ - J=lsort([1,2,3],[K],1); - K4=[K,4];K0=[0,K]; - G0=mc2grs(G,["get0",[K0,J]]); - LT=anal2sp(G0,["+",C,0]); - G0=mc2grs(G,["get0",J]); - L0=anal2sp(G0,["put1",1,0]); - LT=anal2sp(LT,["add",L0]); - G0=mc2grs(G,["get0",K4]); - L0=anal2sp(G0,[["put1",1,0],["+",0,U]]); - LT=anal2sp(LT,["add",L0]); - G0=mc2grs(G,["get0",[[0,J[0]],K4]]); - L0=anal2sp(G0,[["get",1,0],["+",0,U]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[[0,J[1]],K4]]); - L0=anal2sp(G0,[["get",1,0],["+",0,U]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[K0,J]]); - L0=anal2sp(G0,[["get",1,0],["+",C,0]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[[0,4],J]]); - L0=anal2sp(G0,[["+",-C,0],["get",1,0]]); - LT=anal2sp(LT,[["sub",L0],0]); - L=cons(cons([K0,J],LT),L); - } - /* [[0,1],[2,4]] : [K,I]=[[0,k],[i,4]] S=[j,k] : 6 cases */ - for(K=1;K<4;K++){ - for(I=1;I<4;I++){ - if(I==K) continue; - for(J=1;J<4;J++) if(J!=I&&J!=K) break; - I4=[I,4];S=(J<K)?[J,K]:[K,J];K0=[0,K]; - G0=cdr(mc2grs(G,["get",[K0,I4]])); - LT=anal2sp(G0,["+",C,0]); - G0=cdr(mc2grs(G,["get",I4])); - L0=anal2sp(G0,["put1",1,0]); - LT=anal2sp(LT,["add",L0]); - G0=cdr(mc2grs(G,["get",S])); - L0=anal2sp(G0,[["put1",1,0],["+",0,-C-U]]); - LT=anal2sp(LT,["add",L0]); - - G0=cdr(mc2grs(G,["get",[[0,I],S]])); - L0=anal2sp(G0,[["get",1,0],["+",0,-C-U]]); - LT=anal2sp(LT,["sub",L0]); - G0=cdr(mc2grs(G,["get",[[0,J],I4]])); - L0=anal2sp(G0,["get",1,0]); - LT=anal2sp(LT,["sub",L0]); - G0=cdr(mc2grs(G,["get",[K0,I4]])); - L0=anal2sp(G0,[["get",1,0],["+",C,0]]); - LT=anal2sp(LT,["sub",L0]); - G0=cdr(mc2grs(G,["get",[[0,4],S]])); - L0=anal2sp(G0,[["get",1,C],["+",-C,-C-U]]); - LT=anal2sp(LT,[["sub",L0],0]); - L=cons(cons([K0,I4],LT),L); - } - } - /* [[0,4],[2,3]] : [[0,4],J]=[[0,4],[i,j]] 3 cases */ - for(K=3;K>0;K--){ - J=lsort([1,2,3],[K],1); - G0=mc2grs(G,["get0",[[0,4],J]]); - LT=anal2sp(G0,["+",-C,0]); - G0=mc2grs(G,["get0",J]); - L0=anal2sp(G0,["put1",1,-C]); - LT=anal2sp(LT,["add",L0]); - G0=mc2grs(G,["get0",[K,4]]); - L0=anal2sp(G0,[["put1",1,-C],["+",0,U]]); - LT=anal2sp(LT,["add",L0]); - - G0=mc2grs(G,["get0",[[0,J[0]],[K,4]]]); - L0=anal2sp(G0,[["get",1,0],["+",-C,U]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[[0,J[1]],[K,4]]]); - L0=anal2sp(G0,[["get",1,0],["+",-C,U]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[[0,K],J]]); - L0=anal2sp(G0,[["get",1,0],["+",-C,0]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[[0,4],J]]); - L0=anal2sp(G0,[["get",1,C],["put",1,0]]); - LT=anal2sp(LT,[["sub",L0],0]); - L=cons(cons([[0,4],J],LT),L); - } - /* [[1,2],[3,4]] : [J,K]=[[i,j],[k,4]] 3 cases */ - for(K=3;K>0;K--){ - J=lsort([1,2,3],[K],1); - if(K>1) - LT=mc2grs(G,["get0",[J,[K,4]]]); - else{ - LT=mc2grs(G,["get0",[[K,4],J]]); - LT=anal2sp(LT,"swap"); - } - G0=mc2grs(G,["get0",J]); - L0=anal2sp(G0,[["put1"],["+",0,-C-U]]); - LT=anal2sp(LT,["add",L0]); - G0=mc2grs(G,["get0",[K,4]]); - L0=anal2sp(G0,[["put1"],["+",U,0]]); - LT=anal2sp(LT,["add",L0]); - - G0=mc2grs(G,["get0",[[0,J[0]],[K,4]]]); - L0=anal2sp(G0,[["get1",1,0],["put1"],["+",U,0]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[[0,J[1]],[K,4]]]); - L0=anal2sp(G0,[["get1",1,0],["put1"],["+",U,0]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[[0,K],J]]); - L0=anal2sp(G0,[["get1",1,0],["put1"],["+",0,-C-U]]); - LT=anal2sp(LT,["sub",L0]); - G0=mc2grs(G,["get0",[[0,4],J]]); - L0=anal2sp(G0,[["get1",1,C],["put1"],["+",0,-C-U]]); - LT=anal2sp(LT,[["sub",L0],0]); - if(K==1){ - LT=anal2sp(LT,"swap"); - L=cons(cons([[K,4],J],LT),L); - }else L=cons(cons([J,[K,4]],LT),L); - } - G=L; - }else if(length(S)==2){ /* general mc */ - if(S[1]!=0){ - I=S[0]; - if(I!=0) G=mc2grs(G,["swap",[0,I]]); - G=mc2grs(G,[S[1]]); - if(I!=0) G=mc2grs(G,["swap",[0,I]]); - } - }else if(length(S)==3||length(S)==4){ /* addition */ - for(I=1;I<4;I++,S=cdr(S)) - if(S[0]) G=mc2grs(G,[[[0,I],S[0]]]); - if(length(S)==1 && S[0]) /* mc */ - G=mc2grs(G,[S[0]]); - } - } - } - return mc2grs(G,"sort"); -} - -def mcmgrs(G,P) -{ - if(type(G)<2){ - if(G>1){ - N=G+2;G=[]; - for(I=1;I<=N;I++){ - for(J=1;J<N;J++){ - if(I==J) continue; - for(K=J+1;K<=N;K++){ - if(I==K) continue; - G=cons([[[0,I],[J,K]],[1,0,0]],G); - } - } - } - for(I=1;I<=N;I++){ - for(J=1;J<I;J++) G=cons([[[0,I],[0,J,I]],[1,0,0]],G); - for(J=I+1;J<=N;J++) G=cons([[[0,I],[0,I,J]],[1,0,0]],G); - } - return reverse(G); - } - return 0; - } - if(type(G)==7) G=os_md.s2sp(G); - if(type(G)!=4||type(G[0])!=4) return 0; - if(type(G[0][0])!=4){ /* spectre type -> GRS */ - G=s2sp(G|std=1); - L=length(G); - for(V=[],I=L-2;I>=0;I--) V=cons(makev([I+10]),V); - V=cons(makev([L+9]),V); - G=sp2grs(G,V,[1,length(G[0]),-1]|mat=1); - if(getopt(short)!=0){ - V=append(cdr(V),[V[0]]); - G=shortv(G,V); - } - R=chkspt(G|mat=1); - if(R[2] != 2 || R[3] != 0 || !(R=getbygrs(G,1|mat=1))) return 0; - if(getopt(anal)==1) return R; /* called by mcmgrs() */ - if(!(G=mcmgrs(L-2,0))) return 0; - for(R=cdr(R);R!=[];R=cdr(R)){ - TR=car(R)[0]; - if(TR[0]) G=mcmgrs(G,[[TR[0]]]); - G=mcmgrs(G,[cdr(TR)]); - } - } - L=length(G); - for(N=4;N<25;N++){ - K=N^2*(N-1)/2; - if(K>L) return 0; - if(K==L) break; - } - if(type(P)<2) return G; - F=0; - if(type(P)==7||(type(P)==4&&type(P[0])<4)) P=[P]; - if((Dvi=getopt(dviout))!=1&&Dvi!=2&&Dvi!=-1) Dvi=0; - Keep=(Dvi==2)?1:0; - if(type(P)==4 && type(F=car(P))==7){ - if(F=="mult"){ - for(P=cdr(P);P!=[];P=cdr(P)) G=os_md.mc2grs(G,car(P)|option_list=getopt()); - return G; - } - if(F=="get"||F=="get0"){ - if(Dvi!=0) F="get"; - if(length(P)==2){ - if(type(P[1])==4){ - if(type(P[1][1])==4){ /* [[,],[,]] */ - for(PG=reverse(G);PG!=[];PG=cdr(PG)){ - TP=car(PG); - if(TP[0]==P[1]) return (F=="get")?TP:cdr(TP); - } - return []; - } - if(P[1][0]==0){ - if(length(P[1])==2){ /* [0,] */ - for(J=1;J<=N;J++) if(J!=P[1][1]) break; - for(K=J+1;K<=N;K++) if(K!=P[1][1]) break; - L=mcmgrs(G,["get0",[P[1],[J,K]]]); - L=anal2sp(L,["get1",1]); - }else{ /* [0,*,*] */ - L=mcmgrs(G,["get0",[[P[1][0],P[1][1]],P[1]]]); - L=anal2sp(L,["get1",2]); - } - }else{ /* [,] */ - for(J=1;J<=N;J++) if(J!=P[1][0]&&J!=P[1][1]) break; - L=mcmgrs(G,["get0",[[0,J],P[1]]]); - L=anal2sp(L,["get1",2]); - } - L=anal2sp(L,0); - if(F=="get") L=cons(P[1],L); - return L; - }else{ /* I */ - for(L=[],I=P[1],J=0;J<=N;J++){ - if(I==J) continue; - II=(I<J)?[I,J]:[J,I]; - L=cons(mcmgrs(G,[F,II]),L); - } - } - }else{ - for(L=[],I=0;I<N;I++){ - for(J=I+1;J<=N;J++) L=cons(mcmgrs(G,[F,[I,J]]),L); - } - } - if(Dvi){ - for(R=S=[];L!=[];L=cdr(L)){ - T=car(L); - R=cons(cdr(T),R); - if(S==[]) S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}\\\\\n"; - else S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}&"+S; - } - L=ltotex(R|opt="GRS",pre=S); - if(type(V=getopt(div))!=4) V=[]; - if(V==[]&&(K=length(R))>10) - for(I=9;I<K;I+=9) V=cons(I,V); - V=reverse(V); - if(V!=[]) L=divmattex(L,V); - if(Dvi>0){ - if(V!=[]) dviout(L|keep=Keep); - else dviout(L|eq=0,keep=Keep); - } - }else L=reverse(L); - return L; - } - if(F=="show"){ - for(R=str_tb(0,0);G!=[];){ - L=car(G); - I=L[0][0];J=L[0][1]; - str_tb("[A_{"+rtostr(I[0])+rtostr(I[1])+"}:A_{"+rtostr(J[0])+rtostr(J[1]),R); - if(length(J)==3) str_tb(rtostr(J[2]),R); - str_tb("}]&=\\left\\{",R); - for(L=cdr(L);;){ - S=car(L); - str_tb("["+my_tex_form(S[1])+":"+my_tex_form(S[2])+"]",R); - if(S[0]!=1) str_tb("_{"+rtostr(S[0])+"}",R); - if((L=cdr(L))==[]) break; - str_tb(",\\,",R); - } - str_tb("\\right\\}",R); - if((G=cdr(G))==[]) break; - str_tb(texcr(43),R); - } - R=texbegin("align*",str_tb(0,R)); - if(Dvi!=-1) dviout(R|keep=Keep); - return R; - } - if(F=="show0"){ - for(C=N*(N-1)*(N-2)/2,S="",L=[];G!=[];G=cdr(G)){ - for(TL=[],TG=cdr(car(G));TG!=[];TG=cdr(TG)) TL=cons(car(TG)[0],TL); - TL=msort(TL,[-1,0]); - if(Dvi){ - if(S!=""){ - if(--C==0) S=S+";"; - else S=S+","; - } - for(I=J=0,T=append(TL,[[0]]);T!=[];T=cdr(T)){ - if(car(T)==I) J++; - else{ - if(I>0&&J>0){ - if(I>9) S=S+"("+rtostr(I)+")"; - else S=S+rtostr(I); - if(J>1){ - if(J>9) S=S+"^{"+rtostr(J)+"}"; - else S=S+"^"+rtostr(J); - } - } - I=car(T);J=1; - } - } - } - L=cons(TL,L); - } - if(Dvi){ - if(Dvi!=-1) dviout(S|eq=0); - return S; - } - return reverse(L); - } - if(F=="spct"){ - G=mcmgrs(G,"get"); - M=newmat(N+1,N+1); - for(;G!=[];G=cdr(G)){ - GT=car(G);I=GT[0][0];J=GT[0][1]; - for(S=0,L=[],GT=cdr(GT);GT!=[];GT=cdr(GT)){ - L=cons(car(GT)[0],L); - } - L=reverse(qsort(L)); - M[I][J]=M[J][I]=L; - } - for(D=0,GT=M[0][1];GT!=[];GT=cdr(GT)) D+=car(GT); - for(I=0;I<=N;I++){ - S=-(N-2)*D^2; - for(J=0;J<=N;J++){ - if(I==J) continue; - for(L=M[I][J];L!=[];L=cdr(L)) S+=car(L)^2; - } - M[I][I]=S; - } - if(Dvi){ - S=[]; - for(LS=[],I=N;I>=0;I--){ - L=[M[I][I]]; - for(J=N;J>=0;J--){ - if(I==J) L=cons("",L); - else L=cons(s2sp([M[I][J]]),L); - } - S=cons(L,S); - LS=cons("$x_"+rtostr(I)+"$",LS); - } - S=cons(append(LS,["idx"]),S); - M=ltotex(S|opt="tab",hline=[0,1,z],vline=[0,1,z-1,z],left=cons("",LS)); - if(Dvi>0) dviout(M|keep=Keep); - } - return M; - } - if(F=="deg"){ - for(S=I=0;I<N-1;I++){ - for(J=I+1;J<N;J++){ - L=mcmgrs(G,["get0",[I,J]]); - L=anal2sp(L,"val"); - S+=L[1]; - } - } - return S/L[0]; - } - } - L=[]; - if(type(F)!=4) return 0; - if(type(P[0])!=4||length(P[0])==2) P=[P]; - for(;P!=[];P=cdr(P)){ - if(type(T=(S=car(P))[0])==4){ /* addition */ - if((K=P[0][1])!=0){ - if(T[0]>T[1]) T=[T[1],T[0]]; - T1=[T[0],N];T2=[T[1],N]; - T01=cons(0,T1);T02=cons(0,T2); - for(PG=G;PG!=[];PG=cdr(PG)){ - R=car(PG);R0=R[0];K1=K2=0; - TP=R0[0]; - if(TP==T) K1=K; - else if(TP==T1||TP==T2) K1=-K; - if(length(TP=R0[1])==2){ - if(TP==T) K2=K; - else if(TP==T1||TP==T2) K2=-K; - }else{ - S=0; - if(findin(T[0],TP)>=0) S++; - if(findin(T[1],TP)>=0) S++; - if(S>0&&TP[2]==N) K2=-K; - else if(S==2) K2=K; - } - R1=anal2sp(cdr(R),["+",K1,K2]); - L=cons(cons(R0,R1),L); - } - G=reverse(L); - } - }else if(length(S)==1){ /* middle convolution */ - C=S[0];L=[]; - for(I=1;I<=N;I++){ - for(J=1;J<=N;J++){ - if(I==J) continue; - for(K=J+1;K<=N;K++){ /* [[0,I],[J,K]] */ - if(I==K)continue; - T=[[0,I],JK=[J,K]]; - if(I==N){ - LT=mcmgrs(G,["get0",T]); - G0=mcmgrs(G,["get0",JK]); - L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]); - G0=mcmgrs(G,["get0",[0,J,K]]); - LT=anal2sp(LT,["add",L0]); - L0=anal2sp(G0,["put1",1,0]); - LT=anal2sp(LT,["add",L0]); - for(V=1;V<=N;V++){ - if(V==I){ - G0=mcmgrs(G,["get0",T]); - L0=anal2sp(G0,["get",1,C]); - }else if(V==J||V==K){ - G0=mcmgrs(G,["get0",[[0,V],[0,J,K]]]); - L0=anal2sp(G0,["get",1,0]); - }else{ - G0=mcmgrs(G,["get0",[[0,V],JK]]); - L0=anal2sp(G0,["get",1,0]); - } - LT=anal2sp(LT,["sub",L0]); - } - LT=anal2sp(LT,["+",-C,0]); - }else if(K==N){ - LT=mcmgrs(G,["get0",T]); - LT=anal2sp(LT,["+",C,0]); - G0=mcmgrs(G,["get0",JK]); - L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]); - LT=anal2sp(LT,["add",L0]); - G0=mcmgrs(G,["get0",[0,J,K]]); - L0=anal2sp(G0,[["put1",1,0],["+",0,-C]]); - LT=anal2sp(LT,["add",L0]); - for(V=1;V<=N;V++){ - if(V==I){ - G0=mcmgrs(G,["get0",T]); - L0=anal2sp(G0,[["get",1,0],["+",C,0]]); - }else if(V==J){ - G0=mcmgrs(G,["get0",[[0,V],[0,J,K]]]); - L0=anal2sp(G0,[["get",1,0],["+",0,-C]]); - }else if(V==N){ - G0=mcmgrs(G,["get0",[[0,V],[0,J,K]]]); - L0=anal2sp(G0,[["get",1,C],["+",-C,-C]]); - }else{ - G0=mcmgrs(G,["get0",[[0,V],JK]]); - L0=anal2sp(G0,["get",1,0]); - } - LT=anal2sp(LT,["sub",L0]); - } - }else{ - G0=mcmgrs(G,["get0",T]); - LT=anal2sp(G0,["+",C,0]); - G0=mcmgrs(G,["get0",JK]); - L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]); - LT=anal2sp(LT,["add",L0]); - G0=mcmgrs(G,["get0",[0,J,K]]); - L0=anal2sp(G0,["put1",1,0]); - LT=anal2sp(LT,["add",L0]); - for(V=1;V<=N;V++){ - if(V==I){ - G0=mcmgrs(G,["get0",T]); - L0=anal2sp(G0,[["get",1,0],["+",C,0]]); - }else if(V==J||V==K){ - G0=mcmgrs(G,["get0",[[0,V],[0,J,K]]]); - L0=anal2sp(G0,["get",1,0]); - }else if(V==N){ - G0=mcmgrs(G,["get0",[[0,V],JK]]); - L0=anal2sp(G0,[["get",1,C],["+",-C,0]]); - }else{ - G0=mcmgrs(G,["get0",[[0,V],JK]]); - L0=anal2sp(G0,["get",1,0]); - } - LT=anal2sp(LT,["sub",L0]); - } - } - LT=anal2sp(LT,0); - L=cons(cons(T,LT),L); - } - T=[[0,I],(I<J)?[0,I,J]:[0,J,I]]; /* [0,I], [0,I,J] */ - JK=(I<J)?[I,J]:[J,I]; - if(I==N){ - G0=mcmgrs(G,["get0",T]); - LT=anal2sp(G0,["+",-C,0]); - G0=mcmgrs(G,["get0",JK]); - L0=anal2sp(G0,[["put1",1,-C],["mult",N-3]]); - LT=anal2sp(LT,["add",L0]); - G0=mcmgrs(G,["get0",T[1]]); - L0=anal2sp(G0,["put1",1,-C]); - LT=anal2sp(LT,["add",L0]); - for(V=1;V<=N;V++){ - if(V==J){ - G0=mcmgrs(G,["get0",T]); - L0=anal2sp(G0,[["get",1,0],["+",-C,0]]); - }else if(V==N){ - G0=mcmgrs(G,["get0",[[0,V],T[1]]]); - L0=anal2sp(G0,[["get",1,C],["+",-C,0]]); - }else{ - G0=mcmgrs(G,["get0",[[0,V],JK]]); - L0=anal2sp(G0,[["get",1,0],["+",-C,0]]); - } - LT=anal2sp(LT,["sub",L0]); - } - LT=anal2sp(LT,["+",0,C]); - }else if(J==N){ - G0=mcmgrs(G,["get0",T]); - LT=anal2sp(G0,["+",C,0]); - G0=mcmgrs(G,["get0",T[0]]); - L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]); - LT=anal2sp(LT,["add",L0]); - G0=mcmgrs(G,["get0",T[1]]); - L0=anal2sp(G0,["put1",1,0]); - LT=anal2sp(LT,["add",L0]); - for(V=1;V<=N;V++){ - if(V==I){ - G0=mcmgrs(G,["get0",T]); - L0=anal2sp(G0,[["get",1,0],["+",C,0]]); - }else if(V==N){ - G0=mcmgrs(G,["get0",[[0,V],T[1]]]); - L0=anal2sp(G0,[["get",1,C],["+",-C,0]]); - }else{ - G0=mcmgrs(G,["get0",[[0,V],JK]]); - L0=anal2sp(G0,["get",1,0]); - } - LT=anal2sp(LT,["sub",L0]); - } - LT=anal2sp(LT,["+",0,-C]); - }else{ - G0=mcmgrs(G,["get0",T]); - LT=anal2sp(G0,["+",C,C]); - G0=mcmgrs(G,["get0",JK]); - L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]); - LT=anal2sp(LT,["add",L0]); - G0=mcmgrs(G,["get0",T[1]]); - L0=anal2sp(G0,[["put1",1,0],["+",0,C]]); - LT=anal2sp(LT,["add",L0]); - for(V=1;V<=N;V++){ - if(V==I){ - G0=mcmgrs(G,["get0",T]); - L0=anal2sp(G0,[["get",1,0],["+",C,C]]); - }else if(V==J){ - G0=mcmgrs(G,["get0",[[0,V],T[1]]]); - L0=anal2sp(G0,[["get",1,0],["+",0,C]]); - }else if(V==N){ - G0=mcmgrs(G,["get0",[[0,V],JK]]); L0=anal2sp(G0,[["get",1,C],["+",-C,0]]); - }else{ - G0=mcmgrs(G,["get0",[[0,V],JK]]); - L0=anal2sp(G0,["get",1,0]); - } - LT=anal2sp(LT,["sub",L0]); - } - } - LT=anal2sp(LT,0); - L=cons(cons(T,LT),L); - } - } - for(G0=G=[];L!=[];L=cdr(L)){ - if(length(car(L)[0][1])==2) G0=cons(car(L),G0); - else G=cons(car(L),G); - } - G=append(G0,G); - }else{ - if(length(S)==N-1||length(S)==N){ /* [a_1,...,a_{N-1},c] */ - for(I=1;I<N;S=cdr(S),I++) G=mcmgrs(G,[[0,I],car(S)]); - if(length(S)==1) G=mcmgrs(G,[S[0]]); - }else return 0; - } - } - return G; -} - - -def delopt(L,S) -{ - if((Inv=getopt(inv))!=1) Inv=0; - for(R=[];L!=[];L=cdr(L)){ - if(type(car(L))!=4) F=0; - else if(type(S)==4) F=(findin(car(L)[0],S)<0)?0:1; - else F=(car(L)[0]==S)?1:0; - if(F==Inv) R=cons(car(L),R); - } - return reverse(R); -} - -def str_char(S,N,L) -{ - if(type(S)==7){ - if(type(L)==1) L=asciitostr([L]); - return str_chr(S,N,L); - } - if(type(L)==7) L=strtoascii(L)[0]; - if(type(S)==4){ - M=N; - while(M-->0) S=cdr(S); - M=findin(L,S); - return (M>=0)?findin(L,S)+N:-1; - }else if(type(S)==5){ - K=length(S); - for(I=N;I<K;I++) - if(S[I]==L) return I; - } - return -1; -} - -def str_pair(S,N,I,J) -{ - if(type(I)==7) I=(II=strtoascii(I))[0]; - if(type(J)==7) J=(JJ=strtoascii(J))[0]; - if(type(S)==7) S=strtoascii(S); - if(getopt(inv)==1){ - if(II!=0){ - I=asciitostr(reverse(II)); - IL=length(II); - }else IL=1; - if(JJ!=0) J=asciitostr(reverse(JJ)); - R=str_pair(reverse(S),length(S)-N-1,J,I); - if(R>=0) R=length(S)-IL-R; - return R; - } - if((SJIS=getopt(sjis))!=1) SJIS=0; - if((II!=0&&length(II)>1)||(JJ!=0&&length(JJ)>1)){ - for(;;){ - MJ=str_str(S,N|top=JJ,sjis=SJIS); - if(MJ>=0){ - MI=str_str(S,II|top=N,sjis=SJIS); - if(MI<0 || MI>MJ){ - if(C==0) return MJ; - C--; N=MJ+length(II); - }else if(MI>=0){ - C++; N=MI+length(JJ); - } - } - return -1; - } - } - if(type(S)==4){ - M=N; - while(M-->0) S=cdr(S); - while(S!=[]){ - if(car(S)==I) C++; - else if(car(S)==J){ - if(C==0) return N; - C--; - } - S=cdr(S);N++; - } - }else if(type(S)==5){ - K=length(S); - for(T=N;T<K && C>=0;T++){ - if(S[T]==I) C++; - else if(S[T]==J){ - if(C==0) return T; - C--; - } - } - } - return -1; -} - - -def str_cut(S,I,J) -{ - if(type(S)==7) return sub_str(S,I,J); - if((JJ=length(S))<=J) J=JJ-1; - if(type(S)==5){ - for(L=[],K=J; K>=I; K--) L=cons(S[K],L); - }else if(type(S)==4){ - J-=I; - while(I-->0) S=cdr(S); - for(L=[];J-->=0;S=cdr(S)) L=cons(car(S),L); - L=reverse(L); - } - return asciitostr(L); -} - -def str_str(S,T) -{ - if(S==0) return -1; - if(type(S) == 7) - S = strtoascii(S); - if(type(J=getopt(top))!=1 || J<0) J=0; - LS=length(S); - if(LS-J<1) return -1; - if(type(S)==4){ - LS-=(J0=J); - for( ; J>0 && S!=[]; S=cdr(S),J--); - } - if(type(JJ=getopt(end))!=1 && JJ!=0) JJ=LS; - else JJ-=J0; - if((SJIS=getopt(sjis))!=1) SJIS=0; - if(JJ-J<0) return -1; - /* search from J-th to JJ-th */ - if(type(T)==1) T=[T]; - else if(type(T)==7) T = strtoascii(T); - else if(type(T)==4 && type(T[0])>3){ - for(K=(KF=-1)-J0; T!=[]; F++,T=cdr(T)){ - JK=str_str(S,car(T)|top=J,end=JJ,sjis=SJIS); - if(JK>=0){ - JJ=(K=JK)-1; KF=F; - if(J>JJ) break; - } - } - return [KF,J0+K]; - } - if(type(T)==4) T=ltov(T); - LT = length(T); - if(LT>0){ - LE = LS-LT; - LP = T[0]; - if(JJ==0 ||(type(JJ)==1 && JJ<LE)) LE=JJ; - if(type(S)==5){ - for(; J <= LE; J++){ - if(S[J] != LP){ - if(SJIS && (V=S[J])>128){ - if(V<160 || (V>223 && V<240)) J++; - } - continue; - } - for(I = 1; I < LT && S[I+J] == T[I]; I++); - if(I >= LT) return J; - } - }else if(type(S)==4){ - for(; J<=LE; S=cdr(S),J++){ - if(car(S) != LP){ - if(SJIS && (V=S[J])>128){ - if(V<160 || (V>223 && V<240)) J++; - } - continue; - } - for(ST=cdr(S), I = 1; I < LT && car(ST) == T[I]; I++, ST=cdr(ST)); - if(I >= LT) return J0+J; - } - } - } - return -1; -} - -def str_times(S,N) -{ - if(!isint(N)) return ""; - if(type(S)==7){ - for(Tb=str_tb(0,0);N-->0;) - str_tb(S,Tb); - return str_tb(0,Tb); - } - if(type(S)==4){ - for(LT=[],I=0;I<N;I++){ - if(type(car(S))==7){ - LT=cons(car(S),LT); - S=cdr(S); - if(S==[]) S=[[""]]; - }else if(type(car(S))==4){ - ST=car(S); - for(J=0;I<N;I++){ - if(J==length(ST)) J=0; - LT=cons(ST[J++],LT); - } - } - } - return reverse(LT); - } - return S; -} - -def ssubgrs(M,L) -{ - if(type(L)==7) L=s2sp(L); - for(S=0, L=L, M=M; L!=[]; L=cdr(L), M=cdr(M)){ - for(LT=car(L), MT=car(M); LT!=[]; LT=cdr(LT), MT=cdr(MT)){ - S += car(LT)*car(MT)[1]; - } - } - return S; -} - -def s2os(S) -{ - return str_subst(S,[["\\","\\\\"],["\"","\\\""]],0); -} - -def l2os(S) -{ - if(type(S)==6) - S=m2ll(S); - else if(type(S)==5) - S=vtol(S); - else if(type(S)==7) return "\""+s2os(S)+"\""; - else if(type(S)<4) return rtostr(S); - if(type(S)==4){ - for(F=0,Tb=str_tb("[",0);S!=[];S=cdr(S)){ - if(F++) str_tb(", ",Tb); - str_tb(l2os(car(S)),Tb); - } - str_tb("]",Tb); - return str_tb(0,Tb); - } - return 0; -} - -def r2os(S) -{ - if(type(S)==6){ - for(T="",S=m2ll(S);S!=[];S=cdr(S)){ - if(T!="") T=T+","+r2os(car(S)); - else T=r2os(car(S)); - } - return "mat("+T+")\n"; - }else if(type(S)==5){ - for(T="",S=v2l(S);S!=[];S=cdr(S)){ - if(T!="") T=T+","+r2os(car(S)); - else T=r2os(car(S)); - } - return "vect("+T+")\n"; - }else if(type(S)<4) return rtostr(S); - else if(type(S)==4){ - for(T="";S!=[];S=cdr(S)){ - if(T!="") T=T+","+r2os(car(S)); - else T=r2os(car(S)); - } - return "["+T+"]"; - }else if(type(S)==7) return "\""+s2os(S)+"\""; - return ""; -} - -def s2euc(S) -{ - for(R=[],CR=0,L=strtoascii(S);L!=[];L=cdr(L)){ - if((C=car(L)) == 0x1b && length(L)>1) { - if((C=car(L=cdr(L)))==0x24 && length(L)>1){ /* $ */ - if((C = car(L=cdr(L))) == 0x40 || C == 0x42) { /* @, B */ - Mode = 1; - } else return 0; - }else if(C == 0x28 && length(L)>1) { /* ( */ - if((C = car(L=cdr(L)))== 0x42 || C == 0x4a) { /* B, J */ - Mode = 0; - }else if(C == 0x49) { /* I */ - Mode = 2; - }else{ - R=cons(0x1b,R);R=cons(0x28,R);R=cons(C,R); - } - }else if (C == 0x26 && length(L)>1 && car(cdr(L))==0x1b) { /* & ESC */ - L=cdr(L); - }else{ - R=cons(0x1b,R);R=cons(C,R); - } - }else if(C == 0x0e) { - Mode = 2; - }else if(C == 0x0f) { - Mode = 0; - }else if(Mode == 1 && C>0x20 && C<0x7f && length(L)>1) { /* JIS KANJI */ - D=car(L=cdr(L)); - if(D>0x20 && D<0x7f) { - R=cons(ior(C,0x80),R);R=cons(ior(D,0x80),R); - } else return 0; - }else if(Mode == 2 && C > 0x1f && C < 0x60) { /* JIS KANA */ - R=cons(0x8e,R); R=cons(ior(C,0x80),R); - }else if(((C>0x80 && C<0xa0) || (C>0xdf && C<0xf0)) && length(L)>1) { /* ShiftJIS */ - D=car(L=cdr(L)); - if(D>0x3f && D<0xfd && D!=0x7f) { - T=sjis2jis([C,D]); - R=cons(ior(T[0],0x80),R); R=cons(ior(T[1],0x80),R); - }else return 0; - }else if(C>0x9f && C<0xe0) { /* HanKana */ - R=cons(0x8e,R); R=cons(C,R); - }else if(C == 0x0a){ - CR++; - }else if(C == 0x0d){ - R=cons(0x0d,R); - CR=0; - }else{ - while(CR-->0) R=cons(0x0d,R); - R=cons(C,R); - } - } - while(CR-->0) R=cons(0x0d,R); - return asciitostr(reverse(R)); -} - -def s2sjis(S) -{ - for(R=[],CR=0,L=strtoascii(S);L!=[];L=cdr(L)){ - if((C=car(L)) == 0x1b && length(L)>1) { - if((C=car(L=cdr(L)))==0x24 && length(L)>1){ /* $ */ - if((C = car(L=cdr(L))) == 0x40 || C == 0x42) { /* @, B */ - Mode = 1; - } else return 0; - }else if(C == 0x28 && length(L)>1) { /* ( */ - if((C = car(L=cdr(L)))== 0x42 || C == 0x4a) { /* B, J */ - Mode = 0; - }else if(C == 0x49) { /* I */ - Mode = 2; - }else{ - R=cons(0x1b,R);R=cons(0x28,R);R=cons(C,R); - } - }else if (C == 0x26 && length(L)>1 && car(cdr(L))==0x1b) { /* & ESC */ - L=cdr(L); - }else{ - R=cons(0x1b,R);R=cons(C,R); - } - }else if(C == 0x0e) { - Mode = 2; - }else if(C == 0x0f) { - Mode = 0; - }else if(Mode == 1 && C>0x20 && C<0x7f && length(L)>1) { /* JIS KANJI */ - D=car(L=cdr(L)); - if(D>0x20 && D<0x7f) { - T=jis2sjis([C,D]); - R=cons(T[0],R);R=cons(T[1],R); - } else return 0; - }else if(Mode == 2 && C > 0x1f && C < 0x60) { /* JIS KANA */ - R=cons(ior(C,0x80),R); - }else if(C>0xa0 && C<0xff && length(L)>1) { /* EUC */ - D=car(L=cdr(L)); - if(D>0xa0 && D<0xff) { - T=jis2sjis([iand(C,0x7f),iand(D,0x7f)]); - R=cons(T[0],R);R=cons(T[1],R); - }else return 0; - }else if(C == 0x0a){ - CR++; - }else if(C == 0x0d){ - R=cons(0x0a,R);R=cons(0x0d,R); - CR=0; - }else{ - while(CR-->0){ - R=cons(0x0a,R);R=cons(0x0d,R); - } - R=cons(C,R); - } - } - while(CR-->0){ - R=cons(0x0a,R);R=cons(0x0d,R); - } - return asciitostr(reverse(R)); -} - -def r2ma(S) -{ - return evalma(S|inv=1); -} - -def evalma(S) -{ - L0=["\n","\d","{","}","[","]","Log","Exp","Sinh","Cosh","Tanh","Sin","Cos","Tan", - "ArcSin","ArcCos","ArcTan"]; - L1=["", "" ,"[","]","(",")","log","exp","sinh","cosh","tanh","sin","cos","tan", - "asin", "acos", "atan"]; - if(getopt(inv)==1){ - if(type(S)==6) S=m2ll(S); - else if(type(S)==5) S=vtol(S); - if(type(S)==4){ - for(L=[];S!=[];S=cdr(S)){ - if(type(car(S))==6) L=cons(m2ll(car(S)),L); - else if(type(car(S))==5) L=cons(vtol(car(S)),L); - else L=cons(car(S),L); - } - S=reverse(L); - }else return 0; - return str_subst(rtostr(S),cdr(cdr(L1)),cdr(cdr(L0))); - } - if(S==0){ - print("Mathematica text (terminated by ;) ?"); - purge_stdin(); - Tb=str_tb(0,0); - for(;;){ - S=get_line(); - str_tb(S,Tb); - if(str_char(S,0,";")>=0) break; - } - S=str_tb(0,Tb); - } -/* - while((P=str_chr(S,0,";"))>=0){ - V0=evalma(str_cut(S,0,P+1)); - S=str_cut(S,P+1,length(S)); - } - if((P=str_char(S,0,"="))>=0){ - X=strtoascii(str_cut(S,0,P)); - L=length(X); - for(P0=P1=-1,I=0;I<L;I++){ - if(L(I)<=32) continue; - if(isalphanum(L[I])){ - if(P0<0){ - if(isnum(L[I])) break; - P0=I; - } - else if(P1!=I+1) break; - P1=I; - } - } - if(I==L && P0>=0){ - for(I==P0;I-->0;) X=cdr(X); - if((X0=car(X))>96) X0-=32; - Y=[X0];X=cdr(X); - for(I=P1-P0;I-->0;X=cdr(X)) - Y=cons(car(X),Y); - Y=cons(61,Y); - Var=asciitostr(reverse(Y)); - S=str_cut(S,P,length(S)); - } - } -*/ - S=eval_str(str_subst(S,L0,L1)); - if(type(S)==4){ - for(L=-1,T=S;T!=[];T=cdr(T)){ - if(type(T0=car(T))>4) break; - if(type(T0)<4){ - if(L>=0) break; - L=-2;continue; - } - if(L<-2) break; - if(L==-1) L=length(T0); - else if(L!=length(T0)) break; - } - if(T==[]){ - if(L>0) S=s2m(S); - else S=ltov(S); - } - } -/* - if(S==0 && V0!=0) return V0; - if(type(Var)==7){ - T=rtostr(S); - if(type(S)==7) T="\""+T+"\""; - S=eval_str(Var+T); - mycat(["Define",Var]); - } -*/ - return S; -} - -def i2hex(N) -{ - Opt=getopt(); - if(type(N)==4 && isint(car(N))){ -#ifdef USEMODULE - L=mtransbys(os_md.i2hex,N,[]|option_list=Opt); -#else - L=mtransbys(i2hex,N,[]|option_list=Opt); -#endif - return rtostr(L); - } - if(!isint(N) || N<0) return 0; - if(!N) L=[]; - else{ - Cap=(getopt(cap)==1)?32:0; - for(L=[];N!=0;N=ishift(N,4)){ - J=iand(N,15); - L=cons(((J>9)?(87-Cap):48)+J,L); - } - } - if(!isint(Min=getopt(min))) Min=2; - for(Min-=length(L);Min-->0;) - L=cons(48,L); - if(getopt(num)==1){ - L=cons(120,L);L=cons(48,L); - } - return asciitostr(L); -} - -def sjis2jis(L) -{ - L1=L[1]; - if((L0=L[0])<=0x9f){ - if(L1<0x9f) L0=L0*2-0xe1; - else L0=(L0*2)-0xe0; - }else{ - if(L1<0x9f) L0=L0*2-0x161; - else L0=L0*2-0x160; - } - if(L1<0x7f) return [L0,L1-0x1f]; - else if(L1<0x9f) return [L0,L1-0x20]; - return [L0,L1-0x7e]; -} - -def jis2sjis(L) -{ - L1=L[1]; - if(iand(L0=L[0],1)){ - if(L1<0x60) L=[L1+0x1f]; - else L=[L1+0x20]; - }else L=[L1+0x7e]; - if(L0<0x5f) return cons(ishift(L0+0xe1,1),L); - return cons(ishift(L0+0x161,1),L); -} - -def verb_tex_form(P) -{ - L = reverse(strtoascii(rtostr(P))); - for(SS = []; L != []; L = cdr(L)){ - Ch = car(L); /* ^~\{} */ - if(Ch == 92 || Ch == 94 || Ch == 123 || Ch == 125 || Ch == 126){ - SS = append([92,Ch,123,125],SS); /* \Ch{} */ - if(Ch != 94 && Ch != 126) /* \char` */ - SS = append([92,99,104,97,114,96],SS); - continue; - } - SS = cons(Ch, SS); - if((Ch >= 35 && Ch <= 38) || Ch == 95) /* #$%&_ */ - SS = cons(92, SS); /* \Ch */ - } - return asciitostr(SS); -} - -def tex_cuteq(S,P) -{ - if(P==0) return 0; - if(S[P]==125){ /* } */ - if((Q=str_pair(S,P-1,"{","}"|inv=1))<0) return -1; - if(Q<2||S[Q-1]!=95) return Q; - return tex_cuteq(S,Q-2); - } - if(!isalphanum(S[Q=P--])) return -1; - while(P>0&&isalphanum(S[P])) P--; - if(S[P]==92){ /* \ */ - if(P==0) return P; - else P--; - } - if(S[P]!=95||P==0) return Q; /* _ */ - return tex_cuteq(S,P-1); -} - - -def texket(S) -{ - if(!isint(F=getopt(all))) F=0; - if(type(S)==7){ - L=str_len(S); - SS=strtoascii(S); - }else{ - L=length(S); - SS=S; - } - for(T="",I=I0=0;I<L-1;){ - J=str_char(SS,I,"("); - if(J<0) break; - if(J<L-1 && J>4 && str_str(SS,"\\left"|top=J-5,end=J-1)>=0){ - I=J+1;continue; - } - if((K=str_pair(SS,J+1,"(",")"))>=0){ - KK=str_char(SS,J+2,"("); - if(KK>K||KK<0){ - if(F!=1){ - if(!F){ - for(N=J+1;N<K;N++) /* + - _ { } */ - if(!isalphanum(P=SS[N])&&findin(P,[32,43,45,95,123,125])<0) break; - }else N=K; - if(N==K){ - I=K+1;continue; - } - } - T=T+str_cut(SS,I0,J-1)+"\\left"+str_cut(SS,J,K-1)+"\\right)"; - I0=I=K+1; - }else{ - T=T+str_cut(SS,I0,J-1)+"\\left("+texket(str_cut(SS,J+1,K-1)|all=F) +"\\right)"; - I0=I=K+1; - } - }else break; - } - return T+str_cut(SS,I0,L); -} - - -def my_tex_form(S) -{ - if(getopt(skip) != 1){ - if(type(S)==1 && S<0) return "-"+print_tex_form(-S); - if(type(S)==6) return mtotex(S); - S = print_tex_form(S); - for(F=Top=0;(L=str_str(S,"\\verb`"|top=Top))>=0;Top=LV+1){ - F++; - if(Top==0) Tb = string_to_tb(""); - LV = str_chr(S, L+6, "`"); - if(LV<0) LV=str_len(S); - str_tb([my_tex_form(sub_str(S, Top, L-1)|skip=1), "\\texttt{"], Tb); - str_tb([verb_tex_form(sub_str(S,L+6, LV-1)),"}"], Tb); - Top=LV+1; - } - if(F>0){ - str_tb(my_tex_form(sub_str(S, Top,str_len(S)-1)|skip=1), Tb); - return tb_to_string(Tb); - } - } - if(S==0) return ""; - S = ltov(strtoascii(S)); - L = length(S)-1; - while(L >= 1 && S[L] == 10) - L--; - if((Fr=getopt(frac))!=0 && Fr!=1) Fr=2; - for(I = L+1, T = K = 0, SS = []; --I >= 0; ){ - if(S[I] == 32 && I!=L){ - if(I==L) continue; - if(findin(S[I+1], [32,40,41,43,45,123,125]) >= 0 /* " ()+-{}" */ - || (S[I+1] >= 49 && S[I+1] <= 57)) /* 1 - 9 */ - if(I == 0 || S[I-1] >= 32) continue; - } - if(Fr && S[I]>=48 && S[I]<=57){ /* 2/3 -> \tfrac{2}{3} */ - for(K=0,II=I; II>=0; II--){ - if(S[II]>=48 && S[II]<=57) continue; - if(S[II]==47){ /* / */ - if(K>0) break; - K=II; - }else break; - } - if(K>II+1){ - SS=cons(125,SS); - for(J=I; J>K; J--) SS=cons(S[J],SS); - if(AMSTeX){ - SS=cons(123,SS);SS=cons(125,SS); - }else{ - for(J=[114,101,118,111,92];J!=[];J=cdr(J)) /* \over */ - SS=cons(car(J),SS); - } - for(J=K-1;J>II;J--) SS=cons(S[J],SS); - SS=cons(123,SS); - if(AMSTeX){ - J=(Fr==2)?[99,97,114,102,116,92]:[99,97,114,102,92]; - for(;J!=[];J=cdr(J)) /* \tfrac */ - SS=cons(car(J),SS); - } - I=II+1; - }else{ - for(;I>II;I--) SS = cons(S[I], SS); - I++; - } - continue; - } - SS = cons(S[I], SS); - } - SS=str_subst(SS,"\\\\\n\\end{pmatrix}","\n\\end{pmatrix}"|raw=1); - Subst=getopt(subst); - Sub0=["{asin}","{acos}","{atan}"]; - Sub1=["\\arcsin ","\\arccos","\\arctan "]; - if(type(Subst) == 4){ - Sub0=append(Sub0,Subst[0]);Sub1=append(Sub1,Subst[1]); - } - SS = str_subst(SS,Sub0,Sub1|raw=1); - S = ltov(SS); - L = length(S); - SS = []; - while(--L >= 0){ - if(S[I=L] == 125){ - while(--I >= 0 && S[I] == 125); - J = 2*I - L; - if(J >= 0 && S[I] != 123){ - for(K = J; K < I && S[K] == 123; K++); - if(K == I){ - if(J-- <= 0 || S[J] < 65 || S[J] > 122 || (S[J] > 90 && S[J] < 97)){ - SS = cons(S[I],SS); - L = J+1; - continue; - } - } - } - } - SS = cons(S[L],SS); - } - RT=getopt(root); - for(Top=0;;Top++){ /* ((x+1))^{y} , 1/y=2,3,...,9 */ -#if 1 - P=str_str(SS,["))^","^{\\tfrac{1}"]|top=Top); - if(P[0]<0) break; - Sq=0; - if(P[0]==0){ - P=P[1]; - if((Q=str_pair(SS,P,"(",")"|inv=1))<0||SS[Q+1]!=40) continue; - if((RT==2||(RT!=0 && P-Q<33)) && str_str(SS,"{\\tfrac{1}"|top=P+3,end=P+3)==P+3 - && SS[P+14]==125){ - if((Sq=SS[P+13]-48)<2||Sq>9) Sq=0; - } - F=2; - }else{ - P=P[1]; - if(SS[P+12]!=125||(Sq=(SS[P+11]-48))<2||Sq>9) break; - if(SS[P-1]==125){ - if((Q=str_pair(SS,P-2,"{","}"|inv=1))<0) break; - if(Q>1&&SS[Q-1]==95){ - if((Q=tex_cuteq(SS,Q-2))<0) break; - F=0; - }else F=1; - }else{ - if(!isalphanum(SS[Q=P-1]) || (Q=tex_cuteq(SS,Q))<0) break; - F=0; - } - if(RT!=2&&P-Q>32) break; - } -#else - if((P=str_str(SS,"))^"|top=Top))<0 || (Q=str_pair(SS,P,"(",")"|inv=1))<0) break; - else F=2; - Sq=0; - if((RT==2||(RT!=0 && P-Q<33)) && str_str(SS,"{\\tfrac{1}"|top=P+3,end=P+3)==P+3 - && SS[P+14]==125){ - if((Sq=SS[P+13]-48)<2||Sq>9) Sq=0; - } -#endif - for(I=0,S=[];SS!=[];SS=cdr(SS),I++){ - if(I==Q){ - if(Sq){ - S=append([116,114,113,115,92],S); - if(Sq>2) S=append([93,Sq+48,91],S); - S=cons(123,S); - if(F==2) SS=cdr(SS); - else if(F==0) S=cons(car(SS),S); - }else if(F==2&&P-Q==3){ /* (2)^x -> 2^x*/ - SS=cdr(SS);SS=cdr(SS); - S=cons(123,S);S=cons(car(SS),S);S=cons(125,S); - SS=cdr(SS);SS=cdr(SS); - I+=3; - } - continue; - }else if(I==P){ - if(Sq){ - if(F>0) S=cdr(S); - S=cons(125,S); - if(F==2) SS=cdr(SS); - for(J=0;J<12;J++) SS=cdr(SS); - } - continue; - } - S=cons(car(SS),S); - } - SS=reverse(S); - Top=P; - } - S=asciitostr(SS); - if((K=getopt(ket))==1) S=texket(S); - else if(K==2) S=texket(S|all=1); - return S; -} - -def smallmattex(S) -{ - return str_subst(S,[["\\begin{pmatrix}","\\left(\\begin{smallmatrix}"], - ["\\end{pmatrix}","\\end{smallmatrix}\\right)"], - ["\\begin{Bmatrix}","\\left\\{\\begin{smallmatrix}"], - ["\\end{Bmatrix}","\\end{smallmatrix}\\right\\}"], - ["\\begin{bmatrix}","\\left[{\\begin{smallmatrix}"], - ["\\end{bmatrix}","\\end{smallmatrix}\\right]"], - ["\\begin{vmatrix}","\\left|\\begin{smallmatrix}"], - ["\\end{vmatrix}","\\end{smallmatrix}\\right|"], - ["\\begin{Vmatrix}","\\left\\|\\begin{smallmatrix}"], - ["\\end{Vmatrix}","\\end{smallmatrix}\\right\\|"], - ["\\begin{matrix}","\\begin{smallmatrix}"], - ["\\end{matrix}","\\end{smallmatrix}"]],0); -} - - -def divmattex(S,T) -{ - TF=["matrix","pmatrix","Bmatrix","bmatrix","vmatrix","Vmatrix"]; - TG=[0,"(","\\{","[","|","\\|"]; - TH=[0,")","\\}","]","|","\\|"]; - if(type(S)!=7) S=mtotex(S); - S=strtoascii(S0=S); - if((P0=str_str(S,"\\begin{"))<0 || (P1=str_str(S,"}"|top=P0+7))<0) - return S0; - F=str_cut(S,P0+7,P1-1); - if((K=findin(F,TF))<0) return S0; - Q=str_str(S,"\\end{"+F+"}"); - if(Q<0) return S0; - for(J=P1+1;S[J]<33;J++); - for(L0=L=[],I=J;J<Q;J++){ - if(S[J]==38){ /* & */ - if(I>=J) L0=cons(0,L0); - else L0=cons(str_cut(S,I,J-1),L0); - I=J+1; - } - if(S[J]==92&&S[J+1]==92){ /* \\ */ - if(I>=J) L0=cons(0,L0); - else L0=cons(str_cut(S,I,J-1),L0); - L=cons(reverse(L0),L); - L0=[]; - J++; - for(I=J+1;S[I]<33;I++); - } - } - J--; - if(S[J]<33) J--; - if(I<=J) L0=cons(str_cut(S,I,J),L0); - if(length(L0)>0) L=cons(reverse(L0),L); - L=lv2m(reverse(L)); /* get matrix */ - if(T==0) return L; - Size=size(L);S0=Size[0]; - if(type(T[0])!=4){ - S1=Size[1]; - T=append(T,[S1]); - for(TT=[],I=0;T!=[];T=cdr(T)){ - J=car(T); - if(J>S1) J=S1; - for(T0=[];J>I;J--) T0=cons(J-1,T0); - if(T0!=[]) TT=cons(T0,TT); - I=car(T); - } - T=reverse(TT); - } - SS=length(T); - St=str_tb(0,0); - if(SS==1) St=str_tb("\\begin{"+F+"}\n",St); - else{ - if(K>0) St=str_tb("&\\left"+TG[K],St); - St=str_tb("\\begin{matrix}\n",St); - } - for(;T!=[];T=cdr(T)){ - for(I=0;I<S0;I++){ - for(J=0,TT=car(T);TT!=[];TT=cdr(TT),J++){ - if(J>0) St=str_tb("&",St); - if(L[I][car(TT)]!=0) St=str_tb(L[I][car(TT)],St); - } - if(I<S0-1) St=str_tb("\\\\",St); - St=str_tb("\n",St); - } - if(length(T)>1) - St=str_tb("\\end{matrix}\\right.\\\\\n&\\quad\\left.\\begin{matrix}\n",St); - else{ - if(SS==1) St=str_tb("\\end{"+F+"}\n",St); - else St=str_tb("\\end{matrix}\\right"+TH[K]+"\n",St); - } - } - S=str_tb(0,St); - if(SS==1) return S; - return texbegin("align*",S); -} - -def str_subst(S, L0, L1) -{ - if(type(S) == 7) - S = strtoascii(S); - if(type(S) == 4) - S = ltov(S); - SE = length(S); - if(L1 == 0){ - for(L1 = L = [], L0 = reverse(L0); L0 != []; L0 = cdr(L0)){ - L = cons(car(L0)[0], L); - L1 = cons(car(L0)[1], L1); - } - L0 = L; - } - if(type(L0)==7) L0 = [strtoascii(L0)]; - else{ - for(LT = []; L0 != []; L0 = cdr(L0)) - LT = cons(strtoascii(car(L0)), LT); - L0 = ltov(LT); - } - E0 = length(L0); - if(type(L1)==7) L1 = [strtoascii(L1)]; - else{ - for(LT = []; L1 != []; L1 = cdr(L1)) - LT = cons(strtoascii(car(L1)), LT); - L1 = ltov(LT); - } - if(getopt(inv)==1){ - L2=L0;L0=L1;L0=L2; - } - if((SJIS=getopt(sjis))!=1) SJIS=0; - for(J = JJ = 0, ST = []; J < SE; J++){ - SP = S[J]; - for(I = E0-1; I >= 0; I--){ - if(SP != L0[I][0] || J + (K = length(L0[I])) > SE) - continue; - while(--K >= 1) - if(L0[I][K] != S[J+K]) break; - if(K > 0) continue; - for(KE = length(L1[I]), K = 0 ;K < KE; K++) - ST = cons(L1[I][K],ST); - J += length(L0[I])-1; - break; - } - if(I < 0){ - ST = cons(S[J],ST); - if(SJIS && (V=S[J])>128){ - if(V<160 || (V>223 && V<240)) ST = cons(S[J++],ST); - } - } - } - if(getopt(raw)==1) return reverse(ST); - return asciitostr(reverse(ST)); -} - -def dviout0(L) -{ - Cmd=["TikZ","TeXLim","TeXEq","DVIOUT","XYPrec","XYcm","XYLim","Canvas"]; - if(type(Opt=getopt(opt))==7){ - if((F=findin(Opt,Cmd)) < 0) return -1; - if(L==-1){ - if(F<=3){ - if(F==0) V=TikZ; - else if(F==1) V=TeXLim; - else if(F==2) V=TeXEq; - else V=iand(DVIOUTF,1); - }else{ - if(F==4) V=XYPrec; - else if(F==5) V=XYcm; - else if(F==6) V=XYLim; - else V=Canvas; - } - return V; - } - if(F==0) TikZ=L; - else if(F==2) TeXEq=L; - else if(F==3){ - if(iand(DVIOUTF,1)==L) - mycat0(["DVIOUTA=\"", DVIOUTA,"\""],1); - else dviout0(4); - return 1; - }else if(F==7&&type(L)==4) - Canvas=L; - else if(L>0){ - if(F==1) TeXLim=L; - else if(F==4) XYPrec=L; - else if(F==5) XYcm=L; - else if(F==6) XYLim=L; - } - mycat0([Cmd[F],"=",L],1); - return 1; - } - if(type(L) == 4){ - for( ; L != []; L = cdr(L)) dviout0(car(L)); - return 1; - } - if(type(L) == 7){ - if(L=="") dviout(" \n"|keep=1); - else if(L=="cls") dviout0(0); - else if(L=="show") dviout(" "); - else if(L=="?") dviout0(3); - else dviout("\\"+L+"\n"|keep=1); - return 1; - } - if(L == 0) - dviout(" "|keep=1,clear=1); - else if(L == 1) - dviout(" "); - else if(L == 2) - dviout(" "|clear=1); - else if(L>10) - dviout("\\setcounter{MaxMatrixCols}{"+rtostr(L)+"}%"|keep=1); - else if(L < 0) - dviout(" "|delete=-L,keep=1); - else if(L == 3){ - mycat0(["DIROUT =\"", DIROUT,"\""],1); - mycat0(["DVIOUTH=\"", DVIOUTH,"\""],1); - mycat0(["DVIOUTA=\"", DVIOUTA,"\""],1); - mycat0(["DVIOUTB=\"", DVIOUTB,"\""],1); - mycat0(["DVIOUTL=\"", DVIOUTL,"\""],1); - mycat(["Canvas =", Canvas]); - mycat(["TeXLim =", TeXLim]); - mycat(["TeXEq =", TeXEq]); - mycat(["AMSTeX =", AMSTeX]); - mycat(["TikZ =", TikZ]); - mycat(["XYPrec =", XYPrec]); - mycat(["XYcm =", XYcm]); - mycat(["XYLim =", XYLim]); - }else if(L==4){ - Tmp=DVIOUTA; DVIOUTA=DVIOUTB; DVIOUTB=Tmp; - mycat0(["DVIOUTA=\"", DVIOUTA,"\""],1); - DVIOUTF++; - }else if(L==5){ - if(!iand(DVIOUTF,1)) dviout0(4); - }else if(L==6){ - TikZ=1;mycat("TikZ=1"); - }else if(L==7){ - TikZ=0;mycat("TikZ=0"); - } - return 1; -} - -def myhelp(T) -{ - /* extern DVIOUT; */ - /* extern HDVI; */ - /* extern DVIOUTH; */ - - if(type(T)==2){ - if(T==getbygrs){ - getbygrs(0,0); - return 0; - } - else if(T==m2mc){ - m2mc(0,0); - return 0; - } - else if(T==mgen){ - mgen(0,0,0,0); - return 0; - } - else T=rtostr(T); - } - if(type(T)==4 && typeT[0]==7){ - if(length(T)==2 && type(T[1])==1){ - DVIOUTH="start "+T[0]+" -"+rtostr(T[1])+"-hyper:0x90 \"%ASIRROOT%\\help\\os_muldif.dvi\" #r:%LABEL%"; - }else if(str_len(T[0])>2) DVIOUTH=T[0]; - mycat(["DVIOUTH="+DVIOUTH,"\nmyhelp(fn) is set!"]); - return 0; - } - if(T==0){ - mycat([ - "myhelp(t) : show help\n", -#ifdef USEMODULE - " t : -1 (dvi), 1 (pdf) or os_md.getbygrs, os_md.m2mc, os_md.mgen\n", -#else - " t : -1 (dvi), 1 (pdf) or getbygrs, m2mc, mgen\n", -#endif - " \"fn\" : Help of the function fn\n", - " [path,n] : path of dviout, n = # dviout\n", - " [DVIOUTH] : Way to jump to the help of a function\n", - " default: start dviout -2 \"%ASIRTOOT%\\help\\os_muldif.dvi\" #r:%LABEL%" - ]); - return 0; - } - if(type(T)==7){ - if(str_str(T,"os_md.")==0) T=str_cut(T,6,str_len(T)-1); - Dr=str_subst(DVIOUTH,["%ASIRROOT%","%LABEL%"],[get_rootdir(),"r:"+str_subst(T,"_","")]); - shell(Dr); - return 0; - } - Dr=get_rootdir(); - if(T==-1) Dr+="\\help\\os_muldif.dvi"; - else Dr+="\\help\\os_muldif.pdf"; - if(!isMs()) Dr=str_subst(Dr,"\\","/"); - shell(Dr); - return 0; -} - -def isMs() -{ - if(type(Tmp=getenv("TEMP"))!=7) { - if (type(Tmp=getenv("TMP")) != 7) Tmp=getenv("HOME"); - } - if(type(Tmp)==7 && str_chr(Tmp,0,"\\")==2) return 1; - else return 0; -} - -def tocsv(L) -{ - if(type(L)==6) L=m2ll(L); - else if(type(L)==5) L=vtol(L); - Null=getopt(null); - Tb=str_tb(0,0); - for(LL=L; LL!=[]; LL=cdr(LL)){ - LT=car(LL); - if(type(LT)==5) LT=vtol(LT); - if(type(LT)<4) LT=[LT]; - for(N=0; LT!=[]; LT=cdr(LT),N++){ - if(N) str_tb(", ",Tb); - if((T=car(LT))==Null) continue; - if(type(T)==7){ - K=str_len(T); - T=str_subst(T,["\""],["\"\""]); - if(str_len(T)>K||str_char(T,0,",")>=0) T="\""+T+"\""; - str_tb(T,Tb); - }else str_tb(rtostr(T),Tb); - } - str_tb("\n",Tb); - } - S=str_tb(0,Tb); - if(type(EXE=getopt(exe))!=1&&EXE!=0&&type(EXE)!=7) return S; - if(type(F)!=7){ - fcat(-1,0); - F="risaout"; - if(EXE>=2&&EXE<=9) F+=rtostr(EXE); - F=DIROUTD+F+".csv"; - }else F=S; - if(EXE!=0 && access(F)) remove_file(F); - fcat(F,S|exe=1); - return 1; -} - -def readcsv(F) -{ - if((ID=open_file(F))<0) return -1; - SJIS=isMs(); - L=[]; - if(type(V=getopt(eval))!=4){ - if(V=="all") V=1; - else if(type(V)==1) V=[V]; - else V=[]; - } - Eq=getopt(eq); - Sp=getopt(sp); - if(type(T=getopt(col))!=1) T=0; - Null=getopt(null); - if(type(Null)<0) Null=(Eq==1)?0:""; - while((S=get_line(ID))!=0){ - S=strtoascii(S); - N=length(S); - for(I=J=F=0,LL=LT=[];I<N;I++){ - C=S[I]; - if(F==0){ - if(C<=32) continue; - if(C==34){F=2;continue;} - F=1; - } - if(F==2 && C==34){ - if(I<N-1&& S[I+1]==34){ - LT=cons(34,LT);I++;continue; - } - F=-2; - } - if(F==1){ - if((C==44&&Sp!=1)||(C<=32&&Sp==1)) F=-1; - else if(C<32 && C!=9) continue; - } - if(SJIS && I<N-1 && ((C>128 && C<160)||(C>223 && C<240))){ - LT=cons(C,LT);LT=cons(S[++I],LT);continue; - } - if(F>0){ - LT=cons(C,LT);continue; - } - LS=asciitostr(reverse(LT)); - if(V==1||findin(++J,V)>=0){ - if(Eq==1) LS=(LS=="")?Null:eval_str(LS); - else LS=(isdecimal(LS))?eval_str(LS):((LS=="")?Null:LS); - } - if(!T || T==J) LL=cons(LS,LL); - if(F==-2) while(++I<N && Sp!=1 && S[I]!=44); - F=0;LT=[]; - } - if(I<=N && (Sp!=1 || length(LT)>0)){ /* lastline */ - LS=asciitostr(reverse(LT)); - if(V==1||findin(++J,V)>=0){ - if(Eq==1) LS=(LS=="")?Null:eval_str(LS); - else LS=(isdecimal(LS))?eval_str(LS):((LS=="")?Null:LS); - } - if(!T || T==J) LL=cons(LS,LL); - } - L=cons(reverse(LL),L); - } - close_file(ID); - if(T) L=m2l(L|flat=1); - L=reverse(L); - return L; -} - -def showbyshell(S) -{ - Id = getbyshell(S); - if(Id<0) return Id; - while((S=get_line(Id))!=0) print(S,2); - return close_file(Id); -} - - -def getbyshell(S) -{ - /* extern DIROUT; */ - - Home=getenv("HOME"); - if(type(Home)!=7) Home=""; - if(type(Tmp=getenv("TEMP"))!=7 && type(Tmp=getenv("TMP")) != 7) - Tmp=str_subst(DIROUT,["%HOME%","%ASIRROOT%"],[Home,get_rootdir()]); - Sep=isMs()?"\\":"/"; - F=Tmp+Sep+"muldif.tmp"; - if(type(S)<=1 && S>=0) close_file(S); - remove_file(F); - if(type(S)<=1) return -1; - shell(S+" > \""+F+"\""); - return open_file(F); -} - -def show(P) -{ - T=type(P); - S=P; - Var=getopt(opt); - if(Var=="verb"){ - dviout("{\\tt"+verb_tex_form(T)+"}\n\n"); - return; - } - if(type(Var)<0) Var=getopt(var); - if(T==6){ - if((Sp=getopt(sp))==1 || Sp==2) - S=mtotex(P|lim=1,small=2,sp=Sp,null=1,mat="B"); - else if(type(Var)==4 || type(Var)==7) - S=mtotex(P|lim=1,small=2,var=Var); - else - S=mtotex(P|lim=1,small=2); - Size=size(P); - Size=(Size[0]>Size[1])?Size[0]:Size[1]; - if(Size>10) dviout0(Size); - }else if(T<=3){ - X=0; - if(Var=="pfrac") X=var(P); - else X=getopt(pfrac); - if(isvar(X)){ - pfrac(P,X|dviout=1); - return; - } - Opt=cons(["dviout",1],getopt()); - if(type(Var)==2||type(Var)==4||type(Var)==7) fctrtos(P|option_list=Opt); - else{ - if(isdif(P)!=0) Opt=cons(["var","dif"],Opt); - else Opt=cons(["br",1],Opt); - fctrtos(P|option_list=Opt); - } - return; - }else if(T==4){ - if(type(Var)==4 || type(Var)==7){ - S=ltotex(P|option_list=getopt()); - if(Var=="text"){ - dviout(S); - return; - } - }else{ - for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ - LL=car(L); - if(type(LL)==4){ - if(F==0){ - T=type(LL[0]); - if(T==4) F=2; /* [[[? */ - else if(T==1 || T==0) F=1; /* [[num,.. */ - } - if(F==1){ - if(length(LL)!=2 || !isint(LL[0]) || LL[0]<0 || type(LL[1])>3) - F=-1; /* [[num,rat],[num,rat],...] */ - }else if(F==2){ - for(LLT=LL; LLT!=[] && F!=-1; LLT=cdr(LLT)){ - LLL=car(LLT); /* [[[num,rat],[num,rat],...],[[..],..]],....] */ - if(length(LLL)!=2 || !isint(LLL[0]) || LLL[0]<0 || type(LLL[1])>3) - F=-1; - } - } - }else if((F==0 || F==7) && type(LL)==7){ - F=7; - }else F=-1; - } - if(F==1) S=ltotex(P|opt="spt"); - else if(F==2){ - M=mtranspose(lv2m(S)); - show(M|sp=1); /* GRS */ - return; - }else if(F==7) S=ltotex(P|opt="spts"); - else{ - for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ - LL=car(L); - if(type(LL)!=4){ - F=-1; break; - } - for(LLT=LL; LLT!=[] && F!=-1; LLT=cdr(LLT)){ - T=type(LLL=car(LLT)); - if(T<7 && T!=4) F0++; - else if(T==7){ - if(str_char(LLL,0,"\\")<0) F1++; - else F2++; - }else F=-1; - } - } - } - if(F==0 && F0>0 && (F1+F2)>0){ /* list of list of eq and str */ - if(F2>0) S=ltotex(P|opt=["cr","spts0"],str=1); - else S=ltotex(P|opt=["cr","spts"]); - }else{ - for(S="[";;){ - S+=my_tex_form(car(P)); - if((P=cdr(P))==[]){ - S+="]";break; - } - S+=","; - } - } - } - }else if(T==7){ - if(Var=="raw" || - (Var !="eq" && str_chr(P,0,"\\")<0 && str_char(P,0,"^")<0 && str_char(P,0,"_")<0 - && str_char(P,0,"&")<0)){ - dviout(P+"\n\n"); - return; - } - } - dviout(S|eq=5); -} - - -/* options : eq = 1 - 8, clear=1, keep=1, delete=1, title=s, - fctr=1, begin=s */ -def dviout(L) -{ - /* extern AMSTeX, TeXEq, DIROUT, DVIOUTA, DVIOUTB, DVIOUTL; */ - - MyEq = [ - ["\\[\n ","\\]"], - ["\\begin{align}\n","\\end{align}"], - ["\\begin{gather}\n ","\\end{gather}"], - ["\\begin{multline}\n ","\\\\[-15pt]\\end{multline}"], - ["\\begin{align}\\begin{split}\n &","\\end{split}\\end{align}"], - ["\\begin{align*}\n &","\\end{align*}"], - ["\\begin{gather*}\n ","\\end{gather*}"], - ["\\begin{equation}\n ","\\end{equation}"] - ]; - if(!chkfun("print_tex_form", "names.rr")) - return 0; - Home=getenv("HOME"); - if(type(Home)!=7) Home=""; - Dir=str_subst(DIROUT,["%HOME%","%ASIRROOT%","\\"],[Home,get_rootdir(),"/"]); - Dirout=Dir+(AMSTeX?"/out.tex":"/out0.tex"); - Risaout=(AMSTeX)?"risaout":"risaout0"; - Dirisa=Dir+"/"+Risaout+".tex"; - Viewer="dviout"; - SV=["c:/w32tex/dviout","c:/dviout"]; - Risatex=str_subst(AMSTeX?DVIOUTA:DVIOUTL, - ["%HOME%","%ASIRROOT%","%TikZ%"],[Home,get_rootdir(),rtostr(TikZ)]); - if(isMs() && !access(Risatex)){ - for(TV=SV; TV!=[]; TV=cdr(TV)){ - VV=car(TV)+"/dviout.exe"; - if(access(VV)){ - Viewer=str_subst(VV,"/","\\"); - break; - } - } - output(Risatex); - print("cd \""+str_subst(Dir,"/","\\")+"\""); - print("latex -src=cr,display,hbox,math,par "+Risaout); - print("start "+Viewer+" -1 \""+Dr+"\\tex\\"+Risaout+"\" 1000"); - output(); - } - if(access(Dirisa) == 0){ - D0="\""+(isMs()?str_subst(Dir,"/","\\")+"\"":Dir); - shell("mkdir "+D0); - output(Dirisa); - if(AMSTeX){ - print("\\documentclass[a4paper]{amsart}"); - print("\\usepackage{amsmath,amssymb,amsfonts}"); - }else - print("\\documentclass[a4paper]{article}"); - print("\\pagestyle{empty}\n\\begin{document}\n\\thispagestyle{empty}"); - print(AMSTeX?"\\input{out}\n\\end{document}":"\\input{out0}\n\\end{document}"); - output(); - } - if((K = getopt(delete)) >= 1){ /* delete */ - LC = 0; - if(type(K) == 1 && K > 10) K = 10; - if(type(K) == 4){ - K = qsort(K); - LC = 1; /* specific lines */ - } - Done = 1; - Id = open_file(Dirout); - if(Id >= 0){ - Buf = Buf0 = Buf1 = Key = ""; - PE = 0; - if(type(K) == 1) - BufE = newvect(K--); - Dout = Dirout+"0"; - remove_file(Dout); - output(Dout); - while((S = get_line(Id)) != 0){ - if(LC){ - while(K != [] && car(K) < LC) - K = cdr(K); - if(K == [] || car(K) > LC) - output(S); - } - if(Key == ""){ - if((P0 = str_str(S,"\\begin{")) == 0){ - Key = sub_str(S,7,str_str(S,"}")-1); - if(findin(Key,["align", "gather","multline", "equation","align*"]) < 0) - Key = ""; - else{ - Key = "\\end{"+Key+"}"; - if(!LC){ - if(Buf != ""){ - if(PE < K) - BufE[PE++] = Buf1+Buf; - else{ - if(K > 0){ - print(BufE[0]); - for(I = 1; I < K; I++) - BufE[I-1]=BufE[I]; - BufE[K-1] = Buf1+Buf; - }else - print(Buf1+Buf); - Done = 0; - } - Buf1 = Buf0; - Buf = Buf0 =""; - } - } - } - } - if(Key == "" && !LC) Buf0 += S; - } - if(Key != ""){ - if(!LC) Buf += S; - if(str_str(S,Key) >= 0){ - Key = ""; - if(LC) LC++; - } - } - } - output(); - close_file(Id); - } - if(Done==0){ - Id = open_file(Dout); - if(Id >= 0){ - remove_file(Dirout); - output(Dirout); - while((S = get_line(Id)) != 0) - print(S,0); - output(); - close_file(Id); - } - remove_file(Dout); - }else L=" "; - } - if(getopt(clear) == 1 || Done == 1){ /* clear */ - remove_file(Dirout); - if(L == "" || L == " "){ - output(Dirout); - print("\\centerline{Risa/Asir}"); - output(); - } - } - if(L != " "){ - Eq=1; - Eqo = getopt(eq); - Fc = getopt(fctr); - if(Fc == 1 && (type(L) == 2 || type(L) == 3)){ - L = fctrtos(L|TeX=1); - if(type(L) == 4) - L = "\\fact{"+L[0]+"}{"+L[1]+"}"; - if(type(Eqo) != 0 && type(Eqo) !=7){ - Eqo=0; - } - } - if(type(L) != 4 || getopt(mult) != 1) - L = [L]; - if(type(Eqo)!=7 && (Eqo<1 || Eqo>8)) - Eqo = (AMSTeX==1)?TeXEq:1; - Title = getopt(title); - if(type(Title) == 7){ - output(Dirout); - print(Title); - output(); - } - Sb = getopt(subst); - for( ; L != []; L = cdr(L)){ - Eq = 1; - if(type(LT=car(L)) != 7 && type(LT) != 21) - LT = my_tex_form(LT); - else if(type(getopt(eq)) < 0) - Eq = 0; - if(type(Sb) == 4) - LT = str_subst(LT,Sb[0],Sb[1]); - output(Dirout); - if(Eq == 1){ - if(type(Eqo)==7) - print(texbegin(Eqo,LT)); - else if(Eqo >= 1 && Eqo <= 8){ - mycat0([MyEq[Eqo-1][0],LT,"%"],1); - print(MyEq[Eqo-1][1]); - }else print(LT); - }else print(LT); - output(); - } - } - if(str_char(Risatex,0," ")>=0 && str_char(DVIOUTA,0," ")<0 && str_char(DVIOUTB,0," ")<0 - && str_char(DVIOUTL,0," ")<0) - Risatex="\""+Risatex+"\""; - if(getopt(keep) != 1) shell(Risatex); - return 1; -} - -def rtotex(P) -{ - S = my_tex_form(P); - return (str_len(S) == 1)?S:"{"+S+"}"; -} - -def mtotex(M) -{ - /* extern TexLim; */ - - MB=mat(["(",")","p"],["\\{","\\}","B"],["[","]","b"],["|","|","v"], - ["\\|","\\|","V"], [".",".",""]); - if(type(MT=getopt(mat))==7){ - MT=findin(MT,["p","B","b","v","V",""]); - if(MT<0) MT=0; - } - else MT=0; - MT=MB[MT]; - if((F=getopt(small))!=1 && F!=2) F=0; - Lim=getopt(lim); - if(type(Lim)==1){ - if(Lim<30 && Lim!=0) Lim = TexLim; - }else Lim=0; - FL=getopt(len); - Rw=getopt(raw); - Sp=getopt(sp); - Idx=getopt(idx); - if(type(Idx)==4) Idx=ltov(Idx); - if(type(Idx)==6 && length(Idx)==0) Idx=-1; - Var=getopt(var); - if(Lim>0) FL=1; - Null=getopt(null); - if(Null!=1 && Null!=2) Null=0; - if(type(M)==5) M=lv2m([V]); - else if(type(M)!=6) return monototex(M); - S=size(M); - if(FL==1){ - L=newmat(S[0],S[1]); LL=newvect(S[1]); - } - SS=newmat(S[0],S[1]); - for(I=0; I<S[0]; I++){ - for(J=0; J<S[1]; J++){ - if(type(P=M[I][J])<=3){ - if(P!=0 || Null == 0 || (Null==2 && I==J)){ - SS[I][J]=(type(Var)>1)?fctrtos(P|TeX=2,lim=0,var=Var):fctrtos(P|TeX=2,lim=0); - if(type(P)==1 && str_str(SS[I][J],"\\frac{-"|end=0)==0) - SS[I][J]="-\\frac{"+str_cut(SS[I][J],7,100000); - } - }else if(type(P)==6){ - ST= mtotex(P|small=1,len=1); - SS[I][J]=ST[0]; - L[I][J]=ST[1]; - }else if(type(P)==7){ - if(Rw==1) SS[I][J]=P; - else SS[I][J]="\\text{"+P+"\}"; - }else if(type(P)==4 && length(P)==2 && P[0]>0 && (Sp==1 || Sp==2)){ - if(P[0]==1){ - SS[I][J]=fctrtos(P[1]|TeX=2,lim=0); - }else{ - ST=my_tex_form(P[0]); - if(Sp==2) ST="("+ST+")"; - SS[I][J]="["+fctrtos(P[1]|TeX=2,lim=0)+"]_"; - if(str_len(ST)<2) SS[I][J]+=ST; - else SS[I][J]+="{"+ST+"}"; - } - }else - SS[I][J]=my_tex_form(P); - if(FL==1) L[I][J]=texlen(SS[I][J]); - } - } - if(Lim>0 || FL==1){ - for(LLL=J=0; J<S[1];J++){ - for(I=K=0; I<S[0];I++){ - if(K<L[I][J]) K=L[I][J]; - } - LLL+=(LL[J]=K); - } - } - if(Lim>0){ - if(F==2 && LLL>Lim-2*S[1]-2) F=1; - if(F==1) - Lim=idiv(Lim*6,5); - if(LLL<=Lim-(2-F)*S[I]-2) Lim=0; - } - Mat=(F==1)?"smallmatrix}":"matrix}"; - if(F==1) Out=str_tb("\\left"+MT[0]+"\\begin{",0); - else Out=str_tb((Lim==0)?"\\begin{"+MT[2]:"\\left"+MT[0]+"\\begin{",0); - Out = str_tb(Mat,Out); - for(I=II=LT=0; II<=S[0]; II++){ - if(Lim==0) II=S[0]; - if(II<S[0]){ - K=LL[II]+(2-F); - if(I==II){ - LT+=K; - continue; - } - if(LT+K<Lim-2) continue; - LT=K; - } - for(I0=I; I<II; I++){ - if(I==I0){ - str_tb((I==0)? - "\n ": - "\\right.\\\\\n \\allowdisplaybreaks\\\\\n &\\ \\left.\\begin{"+Mat+"\n ", Out); - if(Idx==1||Idx==0||type(Idx)==5){ - for(J=I; J<II; J++){ - if(type(Idx)!=4) - str_tb("("+rtostr(J+Idx)+")",Out); - else{ - JJ=length(Idx)-1; - if(J<JJ) JJ=J; - str_tb(my_tex_form(Idx[JJ]),Out); - } - if(J<II) str_tb(" & ",Out); - } - str_tb("\\\\\n ",Out); - } - } - else str_tb("\\\\\n ",Out); - for(J=0; J<S[1]; J++){ - if(J!=0) str_tb(" & ",Out); - if(type(SS[I][J])==7) str_tb(SS[I][J],Out); - } - } - Out=str_tb("\n\\end{", Out); - if(II==S[0]) Out=str_tb((Lim==0&&F!=1)?MT[2]+Mat:Mat+"\\right"+MT[1],Out); - else Out=str_tb(Mat+"\\right.",Out); - } - SS = str_tb(0,Out); - if(FL!=1) return SS; - if(F==1) LLL=idiv((LLL+S[1])*5+13,6); - else LLL+=2*(1+S[1]); - return [SS,LLL]; -} - -def sint(N,P) -{ - if( type(N)==1 || N==0 ) { - NT=ntype(N); - if((type(Opt=getopt(str))==1 || Opt==0) && Opt>=0 && P>=0){ - if(Opt==2 || Opt==4 || Opt==0){ - if(N==0) return (Opt>0)?"0":0; - Pw=0; - if(NT==4){ - NN=abs(real(N));N1=abs(imag(N)); - if(NN<N1) NN=N1; - }else NN=abs(N); - while(NN<1 && NN>-1){ - Pw--; - N*=10;NN*=10; - } - while(N>=10 || N<=-10){ - Pw++; - N/=10;NN/=10; - } - if(Opt==0) return sint(N*10^Pw,P-Pw-1); - S=(getopt(sqrt)==1)?sint(N,P|str=(Opt==4)?3:1,sqrt=1):sint(N,P|str=(Opt==4)?3:1); - if(Pw==0) return S; - if(NT==4) - S="("+S+")"; - if(Pw==1){ - if(Opt==2) - return S+"*10"; - else - return S+"\\times10"; - } - if(Opt==2) - return S+"*10^("+rtostr(Pw)+")"; - else - return S+"\\times10^{"+rtostr(Pw)+"}"; - } - if(NT==4){ - NN=real(N); - if(NN!=0){ - S=sint(NN,P|str=1); - if(imag(N)>0) S=S+"+"; - } - else S=""; - S=S+sint(imag(N),P|str=1)+((Opt==3)?((getopt(sqrt)==1)?"\\sqrt{-1}":"i"):"@i"); - return S; - } - if(N<0){ - N=-N; - Neg="-"; - }else Neg=""; - N=rint(N*10^P)/10^P; - NN=floor(N); - NV=(N-NN+1)*10^P; - NS=rtostr(NN); - if(P<=0) return Neg+NS; - if(NN==0 && getopt(zero)==0) NS=""; - return Neg+NS+"."+str_cut(rtostr(NV),1,P); - } - if(NT==4) - return sint(real(N),P)+sint(imag(N),P)*@i; - X = rint( N*10^P ); - return deval(X/10^P); - } - if( (type(N)==2) || (type(N)==3) ){ - NN = eval(N); - if( type(NN)==1 ) - return sint(NN,P|option_list=getopt()); - else return N; - } - if( type(N)>3 && type(N) < 7) -#ifdef USEMODULE - return mtransbys(os_md.sint,N,[P]|option_list=getopt()); -#else - return mtransbys(sint,N,[P]|option_list=getopt())); -#endif - return N; -} - -def frac2n(N) -{ - if((T=type(N))<0) return N; - E=(getopt(big)==1)?eval(@e):0.1; - if(T==1){ - if(ntype(N)==0) return (E*N)/E; - else if(ntype(N)!=4) return N; - else return (E*(1+@i)*N)/(E*(1+@i)); - } - if(T==3||T==2){ - N=red(N); - Nm=nm(N);Var=vars(Nm);V=car(Var);K=length(Var); - for(S=0,I=mydeg(Nm,V);I>=0;I--) S+=frac2n(mycoef(Nm,I,V))*V^I; - return S/dn(N); - } - if(T<4) return (E*N)/E; -#ifdef USEMODULE - return mtransbys(os_md.frac2n,N,[]|option_list=getopt()); -#else - return mtransbys(frac2n,N,[]|option_list=getopt()); -#endif -} - -def xyproc(F) -{ - if(type(Opt=getopt(opt))!=7) Opt=""; - if(type(Env=getopt(env))!=7) - Env=(!TikZ)?"xy":"tikzpicture"; - if(F==1) - return(Opt=="")?"\\begin{"+Env+"}\n":"\\begin{"+Env+"}["+Opt+"]\n"; - if(F==0) return "\\end{"+Env+"}\n"; - if(type(F)==7){ - F=xyproc(1|opt=Opt,env=Env)+F+xyproc(0|env=Env); - if(getopt(dviout)==1) dviout(F); - else return F; - } -} - -def xypos(P) -{ - if(type(P[0])==7){ - if(P[0]=="") S=""; - else S=(!TikZ)?"\""+P[0]+"\"":"("+P[0]+")"; - } - else{ - if(TikZ==0 && XYcm==1){ - X=sint(P[0]*10,XYPrec); Y=sint(P[1]*10,XYPrec); - }else{ - X=sint(P[0],XYPrec); Y=sint(P[1],XYPrec); - } - S="("+rtostr(X)+","+rtostr(Y)+")"; - } - if(!TikZ){ - if(length(P)>2 && (PP=P[2])!=""){ - S=S+" *"; - if(type(PP)==4 && length(PP)==2 && type(PP[0])==7){ - S=S+PP[0]; - PP=PP[1]; - } - if(type(PP)==7){ - L=str_len(PP); - if(str_chr(PP,0,"$")==0 && str_chr(PP,L-1,"$")==L-1){ - PP=str_cut(PP,1,L-2); - }else S+="\\txt"; - } - else PP=my_tex_form(PP); - S=S+"{"+PP+"}"; - } - if(length(P)>3){ - if(type(P[3])==7 && P[3]!="") S=S+"=\""+P[3]+"\""; - if(length(P)>4 && type(P[4])==7) S=S+P[4]; - } - }else{ - T=""; - if(length(P)>2 && (PP=P[2])!=""){ - F=1; - if(type(PP)==4){ - if(length(PP)==2 && type(PP[0])==7){ - T="["+PP[0]+"]"; - PP=PP[1]; - } - } - if(type(PP)!=7) PP="$"+my_tex_form(PP)+"$"; - S=S+"{"+PP+"}"; - }else F=0; - if(length(P)>3){ - if(type(P[3])==7 && P[3]!="") T=T+"("+P[3]+")"; - else if(P[3]==1) T=T+"(_)"; - if(length(P)>4 && type(P[4])==7) S=S+P[4]; - } - if(length(P)>2){ - if(F) S="node"+T+" at"+S; - else S="coordinate"+T+" at"+S; - } - } - return S; -} - -def xyput(P) -{ - if((type(Sc=getopt(scale))==1 && Sc!=1) || type(Sc)==4){ - if(type(Sc)==1) Sc=[Sc,Sc]; - Sx=Sc[0];Sy=Sc[1]; - if(length(P)>2) - P1=cons(Sy*P[1],cdr(cdr(P))); - else P1=[Sy*P[1]]; - P=cons((type(P[0])==7)?P[0]:(Sx*P[0]),P1); - } - if(!TikZ) return "{"+xypos(P)+"};\n"; - return "\\"+xypos(P)+";\n"; -} - -def xyline(P,Q) -{ - if(!TikZ) return "{"+xypos(P)+" \\ar@{-} "+xypos(Q)+"};\n"; - if(type(T=getopt(opt))!=7) T=""; - else T="["+T+"]"; - if(length(P)<3 && length(Q)<3) - return "\\draw"+T+xypos(P)+"--"+xypos(Q)+";\n"; - if(length(P)==2) P=[P[0],P[1],"","_0"]; - else if(length(P)==3 || (length(P)==4 && P[3]=="")) - P=[P[0],P[1],P[2],"_0"]; - else if(length(P)>4 && P[3]=="") - P=[P[0],P[1],P[2],"_0",P[4]]; - if(length(Q)==2) Q=[Q[0],Q[1],"","_1"]; - else if(length(Q)==3 || (length(Q)==4 && Q[3]=="")) - Q=[Q[0],Q[1],Q[2],"_1"]; - else if(length(Q)>4 && Q[3]=="") - Q=[Q[0],Q[1],Q[2],"_1",Q[4]]; - return "\\draw "+T+xypos(P)+" "+xypos(Q)+"("+P[3]+")--("+Q[3]+");\n"; -} - -def xylines(P) -{ - Lf=getopt(curve); - if(type(Lf)!=1) Lf=0; - SS=getopt(opt); - SF=(SS==0)?1:0; - if((Proc=getopt(proc))==1||Proc==2||Proc==3){ - OL=cons(["opt",0],delopt(getopt(),["opt","proc"])); - R=xylines(P|option_list=OL); - OP=(type(SS)<0)?[]:((type(SS)==4)?[["opt",SS[0]],["cmd",SS[1]]]:[["opt",SS]]); - return [1,OP,R]; - } - if(type(SS)!=7 && type(SS)!=4){ - if(Lf==0 && !TikZ) SS="@{-}"; - else SS=""; - } - if(type(Sc=getopt(scale))==1 || type(Sc)==4){ - if(type(Sc)==1) Sc=[Sc,Sc]; - Sx=Sc[0];Sy=Sc[1]; - if(Sx!=1 || Sy!=1){ - for(PP=[], P0=P; P0!=[]; P0=cdr(P0)){ - PT=car(P0); - if((type(PT)!=4 && type(PT)!=5) || (type(PT[0])!=1 && PT[0]!=0)) - PP=cons(PT,PP); - else{ - if(length(PT)>2 && type(PT)==4) - P1=cons(Sy*PT[1],cdr(cdr(PT))); - else P1=[Sy*PT[1]]; - PP=cons(cons(Sx*PT[0],P1),PP); - } - } - P=reverse(PP); - } - } - if(type(Cl=CL0=getopt(close))!=1) Cl=0; - if((Vb=getopt(verb))!=1&&type(Vb)!=4) Vb=0; - if(type(Lf)!=1 || Lf==0){ /* lines */ - if(TikZ||SF){ - for(L=[],F=0,PT=P;PT!=[];PT=cdr(PT)){ - if(type(car(PT))<4){ - L=cons(car(PT),L); - F=0; - }else{ - if(F++>1) L=cons(1,L); - L=cons(car(PT),L); - } - } - if(Cl==1){ - L=cons(1,L);L=cons(-1,L); - } - if(L) L=reverse(L); - if(SF) return L; - if(type(SS)!=4) S=xybezier(L|opt=SS); - else S=xybezier(L|opt=SS[0],cmd=SS[1]); - - }else{ - Out = str_tb(0,0); - for(PT=P; PT!=[]; ){ - PS1=car(PT); - PT=cdr(PT); - if(PT==[]){ - if(Cl==1) PS2=car(P); - else PS2=0; - }else PS2=car(PT); - str_tb(xyarrow(PS1,PS2|opt=SS),Out); - } - S=str_tb(0,Out); - } - }else if(Lf==2){ /* B-spline */ - if(SF) return P; - if(!TikZ){ - Out = str_tb("{\\curve{",0); - for(PT=P;PT!=[];PT=cdr(PT)){ - if(car(PT)==0){ - str_tb("}};\n{\\curve{",Out); - continue; - } - if(PT!=P) str_tb("&",Out); - str_tb(xypos([car(PT)[0],car(PT)[1]]),Out); - } - str_tb("}};\n",Out); - S=str_tb(0,Out); - }else Out=str_tb(xybezier(P|opt=SS),0); - for(I=0;I<2;I++){ - Q=car(P); - if(length(Q)>2) - str_tb(xyput(Q),Out); - P=reverse(P); - } - S=str_tb(0,Out); - }else{ /* extended Bezier */ - RTo=getopt(ratio); - if(type(Acc=getopt(Acc))!=1) Acc=0; - if(type(RTo)!=1 || RTo>1.5 || RTo<0.001) RTo=0; - if(Cl==1){ - PR=reverse(P); - PT=car(PR); - PR=cons(P[0],PR); - PR=cons(P[1],PR); - P=cons(PT,reverse(PR)); - }else if(Cl==-1) Cl=1; - for(L=P2=P3=0,PT=P;;){ - P1=P2;P2=P3;P3=P4; - P4=(PT==[])?0:car(PT); - if(PT==[] && (Cl==1 || P3==0)) break; - PT=cdr(PT); - if(P3==0) str_tb("%\n", Out); - if(P2==0 || P3==0 || (Cl==1 && P1==0)) continue; - if(L!=0){ - if(car(L)==P2) - L=cons(1,L); - else{ - L=cons(0,L); L=cons(P2,L); - } - }else L=[P2]; - X=P3[0]-P2[0];Y=P3[1]-P2[1]; - DL1=DL2=0;DL=Acc?sqrt(X^2+Y^2):dsqrt(X^2+Y^2); - if(P4!=0){ - XD1=P4[0]-P2[0];YD1=P4[1]-P2[1];DL1=Acc?sqrt(XD1^2+YD1^2):dsqrt(XD1^2+YD1^2); - } - if(P1!=0){ - XD2=P3[0]-P1[0];YD2=P3[1]-P1[1];DL2=Acc?sqrt(XD2^2+YD2^2):dsqrt(XD2^2+YD2^2); - } - if(RTo!=0) - R=RTo; - else if(DL1>0 && DL2>0){ - Cos=(XD1*XD2+YD1*YD2)/(DL1*DL2); - RT=4/(3*(Acc?sqrt((1+Cos)/2):dsqrt((1+Cos)/2))+3); - R=DL*RT/(DL1+DL2); - }else if(DL1!=0) - R=DL/(2*DL1); - else if(DL2!=0) - R=DL/(2*DL2); - if(DL2!=0) L=cons([P2[0]+R*XD2,P2[1]+R*YD2],L); - if(DL1!=0) L=cons([P3[0]-R*XD1,P3[1]-R*YD1],L); - L=cons([P3[0],P3[1]],L); - } - if(CL0==1) L=cons(-1,cdr(L)); - if(L!=0) L=reverse(L); - if(SF) return L; - if(type(SS)==4) - S=xybezier(L|opt=SS[0],cmd=SS[1],verb=Vb); - else - S=xybezier(L|opt=SS,verb=Vb); - } - if(getopt(dviout)!=1) return S; - xyproc(S|dviout=1); -} - -def saveproc(S,Out) -{ - if(type(Out)==4){ - Out=cons(S,Out); - return Out; - }else{ - str_tb(S,Out); - return Out; - } -} - -def xygrid(X,Y) -{ - for(RR=[],I=0,Z=X;I<2;I++){ - U=Z[2];L=LL=[];M=Z[3]; - if(Z[1]==1||Z[1]==-1){ - if(type(M)==4) L=M; - else{ - if(U*(-dlog(1-1/20)/dlog(10))>=M){ - L=cons([1,2,1/10],L); - LL=cons([1,2,1/2],LL); - }else if(U*(-dlog(1-1/10)/dlog(10))>=M) - L=cons([1,2,1/5],L); - else if(U*(-dlog(1-1/4)/dlog(10))>=M) - L=cons([1,2,1/2],L); - if(U*(-dlog(1-1/50)/dlog(10))>=M){ - L=cons([2,5,1/10],L); - LL=cons([2,5,1/2],LL); - }else if(U*(-dlog(1-1/25)/dlog(10))>=M) - L=cons([2,5,1/5],L); - else if(U*(-dlog(1-1/10)/dlog(10))>=M) - L=cons([2,5,1/2],L); - if(U*(-dlog(1-1/100)/dlog(10))>=M){ - L=cons([5,10,1/10],L); - LL=cons([5,10,1/2],LL); - } - else if(U*(-dlog(1-1/50)/dlog(10))>=M) - L=cons([5,10,1/5],L); - else if(U*(-dlog(1-1/20)/dlog(10))>=M) - L=cons([5,10,1/2],L); - L=cons(L,cons(LL,[[[1,10,1]]])); - } - R=scale(L|scale=U); - if(Z[1]==-1){ - for(LL=[];R!=[];R=cdr(R)){ - for(L=[],T=car(R);T!=[];T=cdr(T)) L=cons(U-car(T),L); - LL=cons(reverse(L),LL); - } - R=reverse(LL); - } - }else if(Z[1]==0){ - if(type(M)==4){ - R=scale(M|f=x,scale=U); - }else{ - V=0; - if(U/10>=M) V=1/10; - else if(U/5>=M) V=1/5; - else if(U/2>=M) V=1/2; - R=[]; - if(V>0){ - UU=U*V; - for(R=[],J=UU;J<U;J+=UU) R=cons(J,R); - } - if(V==1/10) L=[U/2]; - else L=[]; - R=cons(R,cons(L,[[0,U]])); - } - }else if(type(Z[1])==4){ - R=Z[1]; - if(length(R)==0||type(R[0])!=4) R=[[],[],R]; - }else return 0; - K=length(R); - S=newvect(K); - for(J=0;J<K;J++){ - for(S[J]=[],JJ=0;JJ<=Z[0];JJ+=U){ - for(P=R[J];P!=[];P=cdr(P)) - if(car(P)+JJ<=Z[0]) S[J]=cons(car(P)+JJ,S[J]); - } - } - for(J=0;J<K;J++) S[J]=lsort(S[J],[],1); - for(U=[],J=K-1;J>0;J--){ - U=lsort(S[J],U,0);S[J-1]=lsort(S[J-1],U,1); - } - RR=cons(vtol(S),RR); - Z=Y; - } - if((Raw=getopt(raw))==1) return RR; - SS=[]; - if(type(Sf=getopt(shift))==7){ - Sx=Sf[0];Sy=Sf[1]; - }else Sx=Sy=0; - for(I=0;I<2;I++){ - for(S0=[],L=RR[I];L!=[];L=cdr(L)){ - for(S=[],T=car(L);T!=[];T=cdr(T)){ - if(S!=[]) S=cons(0,S); - if(I==0){ - S=cons([X[0]+Sx,car(T)+Sy],S); - S=cons([Sx,car(T)+Sy],S); - }else{ - S=cons([car(T)+Sx,Y[0]+Sy],S); - S=cons([car(T)+Sx,Sy],S); - } - } - S0=cons(S,S0); - } - SS=cons(reverse(S0),SS); - } - SS=reverse(SS); - if(Raw==2) return SS; - if(length(Y)<5) T=[["",""]]; - else if(type(Y[4])==4) T=[Y[4]]; - else T=[Y[4],Y[4]]; - if(length(X[4])==4) T=cons([""],T); - else if(type(X[4])==4) T=cons(X[4],T); - else T=cons([X[4]],T); - for(Sx=Sy=[],I=0;I<2;I++){ - TT=T[I]; - for(V=SS[I];V!=[];V=cdr(V)){ - Op=car(TT); - if(length(TT)>1) TT=cdr(TT); - if(car(V)==[]) continue; - if(Op=="") S=xylines(car(V)); - else S=xylines(car(V)|opt=Op); - if(I==0) Sx=cons(S,Sx); - else Sy=cons(S,Sy); - } - } - for(S="",Sx=reverse(Sx), Sy=reverse(Sy);Sx!=[]&&Sy!=[];){ - if(Sx!=[]){ - S+=car(Sx);Sx=cdr(Sx); - } - if(Sy!=[]){ - S+=car(Sy);Sy=cdr(Sy); - } - } - return S; -} - - -def addIL(I,L) -{ - if(I==0){ - for(R=[];L!=[];L=cdr(L)) R=addIL(car(L),R); - return reverse(R); - } - if(type(In=getopt(in))==1){ - if(In==-1){ - J=JJ=I[1];I=I[0]; - for(R=[];L!=[];L=cdr(L)){ - J=lmin([car(L)[0],JJ]); - if(J>I) R=cons([I,J],R); - I=lmax([car(L)[1],I]); - } - if(I<JJ) R=cons([I,JJ],R); - return reverse(R); - }else{ - for(;L!=[];L=cdr(L)){ - if(car(L)[0]>I) return 0; - if(car(L)[1]>=I){ - if(In==3) return car(L); - if(In==1||(I!=car(L)[0]&&I!=car(L)[1])) return 1; - return 2; - } - } - return 0; - } - } - I0=car(I);I1=I[1]; - for(F=0,R=[];L!=[];L=cdr(L)){ - if(I0>car(L)[1]){ - R=cons(car(L),R); - continue; - } - if(I0<=car(L)[1]){ - I0=lmin([I0,car(L)[0]]); - if(I1<car(L)[0]){ - R=cons([I0,I1],R); - for( ;L!=[];L=cdr(L)) R=cons(car(L),R); - F=1; - break; - } - I1=lmax([I1,car(L)[1]]); - } - } - if(!F) R=cons([I0,I1],R); - return reverse(R); -} - -def xy2curve(F,N,Lx,Ly,Lz,A,B) -{ - Raw=getopt(raw); - if(type(Gap=getopt(gap))==4){ - MG=Gap[1];Gap=car(Gap); - }else MG=3; - if(type(Gap)!=1 && Gap!=0) Gap=0.7; - if(type(Dvi=getopt(dviout))<1) Dvi=0; - OL=[["dviout",Dvi]]; - if(type(Opt=getopt(opt))<1) Opt=0; - else OL=cons(["opt",Opt],OL); - if(type(Sc=getopt(scale))!=1 && type(Sc)!=4) Sc=[1,1,1]; - else if(type(Sc)!=4) Sc=[Sc,Sc,Sc]; - else if(length(Sc)!=3) Sc=[Sc[0],Sc[1],Sc[1]]; - M=diagm(3,Sc); - if(A!=0||B!=0){ - if(type(A)!=6){ /* M=mrot([-A,B,0]|deg=1)*M; */ - Pi=deval(@pi); - Ac=dcos(Pi*A/180);As=dsin(Pi*A/180); - M=mat([Ac,As,0],[-As,Ac,0],[0,0,1])*M; - Ac=dcos(Pi*B/180);As=dsin(Pi*B/180); - M=mat([Ac,0,As],[0,1,0],[-As,0,Ac])*M; - }else M=A; - V=M*newvect(3,[x,y,z]); - Fx=compdf(V[0],[x,y,z],F);Fy=compdf(V[1],[x,y,z],F);Fz=compdf(V[2],[x,y,z],F); - }else{ - for(I=0;I<3;I++){ - if(type(T=F[I])!=4) T=f2df(T); - if(type(T)==4) T=cons(car(T)*Sc[I],cdr(T)); - else T*=Sc[I]; - if(I==0) Fx=T; - else if(I==1) Fy=T; - else Fz=T; - } - } - if(Raw==5||!Gap) - return (Dvi||!Gap)? xygraph([Fy,Fz],N,Lx,Ly,Lz|option_list=OL):[Fx,Fy,Fz]; - R=xygraph([Fy,Fz],N,Lx,Ly,Lz|raw=2); - R0=cdr(car(R));R1=R[1]; - for(LT=[];R0!=[];R0=cdr(R0),R1=cdr(R1)) - if(car(R0)!=0) LT=cons([R1[0],R1[1]],LT); - LT=reverse(LT); - if(N<0){ - Be=xylines(car(R)|curve=1,proc=3,close=-1); - LT=reverse(cdr(LT)); - LT=reverse(cdr(LT)); - } - else Be=xylines(car(R)|curve=1,proc=3); - Be=cdr(cdr(Be)); - Be=lbezier(car(Be)); - if(Raw==4) return [Be,LT,Lx]; - X=ptcombz(Be,0,0); - Var=(length(Lx)==3)?car(Lx):x; - if(type(Eq=getopt(eq))!=1) Eq=0.01; - if(TikZ==1){ - Gap/=10;Eq/=10; - } - for(R=[],XT=X;XT!=[];XT=cdr(XT)){ - V=car(XT); - U=LT[V[0][0]]; - T=U[0]*V[1][0]+U[1]*(1-V[1][0]); - VV=myfdeval(Fx,[Var,T]); - U=LT[V[0][1]]; - T=U[0]*V[1][1]+U[1]*(1-V[1][1]); - VV-=myfdeval(Fx,[Var,T]); - if(abs(VV)<Eq) continue; - I=(VV<0)?0:1; - R=cons([V[0][I],V[1][I],V[0][1-I],V[1][1-I]],R); - } - R=qsort(R); - if(Raw==3) return [Be,R]; - Db=newvect(L=length(Be)); - for(I=0;I<L;I++) Db[I]=[]; - for(TR=R;TR!=[];TR=cdr(TR)){ - V1=ptbezier(Be,[I=car(TR)[0],P=car(TR)[1]])[1]; - V2=ptbezier(Be,[car(TR)[2],car(TR)[3]])[1]; - T=dsqrt(1-dvangle(V1,V2)^2); - if(T<1/MG) T=MG; - GP=Gap/T; - W=GP/dnorm(V1); - Db[I]=addIL([P-W,P+W],Db[I]); - if(P-W<0 && I>0) Db[I-1]=addIL([P-W+1,1],Db[I-1]); - if(P+W>1 && I+1<L) Db[I+1]=addIL([0,P+W-1],Db[I+1]); - } - Db=vtol(Db); - for(Bf=[];Be!=[];Be=cdr(Be),Db=cdr(Db)){ - if(car(Db)==[]) Bf=cons(car(Be),Bf); - else{ - D=addIL([0,1],car(Db)|in=-1); - for(;D!=[];D=cdr(D)) - Bf=cons(tobezier(car(Be)|inv=car(D)),Bf); - } - } - Bf=reverse(Bf); - if(Raw==2) return Bf; - OL=[]; - if(Opt){ - if(type(Opt)==4&&length(Opt)>1) OL=[["opt",Opt[0]],["cmd",Opt[1]]]; - else OL=[["opt",Opt]]; - }else OL=[]; - S=xybezier(lbezier(Bf|inv=1)|option_list=OL); - if(Raw==1||!Dvi) return S; - return xyproc(S|dviout=Dvi); -} - -def xy2graph(F0,N,Lx,Ly,Lz,A,B) -{ - /* (x,y,z) -> (z sin B + x cos A cos B + y sin A cos B, - -x sin A + y cos A, z cos B - x cos A sin B - y sin A sin B) */ - if((Proc=getopt(proc))==1||Proc==2){ - OPT0=[["proc",3]]; - }else{ - Proc=0;OPT0=[]; - } - if(type(DV=getopt(dviout))==4){ - S=["ext","shift","cl","dviout"]; - OL=delopt(getopt(),S); - OL=cons(["proc",1],OL); - R=xy2graph(F0,N,Lx,Ly,Lz,A,B|option_list=OL); - OL=delopt(getopt(),S|inv=1); - return execdraw(R,DV|optilon_list=OL); - } - if(N==0 || N>100 || N<-100) N=-16; - if(N<0){ - N=-N;N1=-1;N2=NN+1; - }else{ - N1=0;N2=NN=N; - } - - Ratio=Ratio2=1; - if(type(Sc=Sc0=getopt(scale))!=1 && type(Sc)!=4) Sc=1; - if(type(Sc)==4){ - Ratio=Sc[1]/Sc[0]; - if(length(Sc)>2) Ratio2=Sc[2]/Sc[0]; - Sc=Sc[0]; - } - if(type(Vw=getopt(view))!=1) Vw=0; - if(type(Raw=getopt(raw))!=1) Raw=0; - if(type(M1=getopt(dev))==1) M2=M1; - else if(type(M1)==4){ - M2=M1[1];M1=M1[0]; - }else M1=0; - if(type(M3=getopt(acc))!=1 || (M3<0.5 && M3>100)) M3=1; - if(M1<=0) M1=16; - if(M2<=0) M2=16; - OL=[["para",1],["scale",Sc]]; - if(Raw==1) OL=cons(["raw",1],OL); - if(type(Prec=getopt(prec))>=0) OL=cons(["prec",Prec],OL); - L=newvect(4,[[Lx[1],Ly[0]],[Lx[1],Ly[1]],[Lx[0],Ly[1]],[Lx[0],Ly[0]]]); - Lx=[deval(Lx[0]),deval(Lx[1])]; - Ly=[deval(Ly[0]),deval(Ly[1])]; - Lz=[deval(Lz[0]),deval(Lz[1])]; - A=(A0=A)%360; - F00=F0; - if(type(F0)<4){ - FC=f2df(F0); - if(findin(z,Vars=vars(FC))>=0 && findin(x,Vars)<0 && findin(y,Vars)<0) - F0=[w,[z,0,x+y*@i],[w,os_md.abs,FC]]; - } - if(type(Org=getopt(org))==4){ /* shift origin */ - Lx=[Lx[0]-Org[0],Lx[1]-Org[0]]; - Ly=[Ly[0]-Org[1],Ly[1]-Org[1]]; - Lz=[Lz[0]-Org[2],Lz[1]-Org[2]]; - F0=mysubst(F0,[[x,x+Org[0]],[y,y+Org[1]]]); - if(type(F0)==4){ - F0=cons(F0[0]-Org[2],cdr(F0)); - } - else F0-=Org[2]; - }else Org=[0,0,0]; - Cpx=getopt(cpx); - if(type(Cpx)<0){ - if(str_str(rtostr(F0),"@i")>=0) Cpx=1; - else Cpx=0; - } - if(A<0) A+=360; - if(A<90){ - Sh=1;F1=F0;Cx=x-Org[0];Cy=y-Org[1]; - }else if(A<180){ /* x -> y, y -> -x */ - Sh=2;A-=90; F1=mulsubst(F0,[[x,-y],[y,x]]); - LL=Ly;Ly=[-Lx[1],-Lx[0]];Lx=LL;Cx=y-Org[1];Cy=-x+Org[0]; - }else if(A<270){ - Sh=3;A-=180; F1=subst(F0,[[x,-x],[y,-y]]); - Lx=[-Lx[1],-Lx[0]];Ly=[-Ly[1],-Ly[0]];Cx=-x+Org[0];Cy=-y+Org[1]; - }else{ - Sh=4;A-=270;F1=mulsubst(F0,[[x,y],[y,-x]]); - LL=Lx;Lx=[-Ly[1],-Ly[0]];Ly=LL;Cx=-y+Org[1];Cy=x-Org[0]; - } - A=@pi*A/180; B=@pi*B/180; - if(A==0) A=@pi/3; - if(B==0) B=@pi/12; - NN=N*M2; - Ac=dcos(deval(A)); As=dsin(deval(A)); - if(Ac<=0.087 || As<=0.087){ - mycat(["Unsuitable angle",A0,"(6-th argument)!"]); - return -1; - } - Bc=Ratio*dcos(deval(B)); Bs=dsin(deval(B)); - if(Bc<0){ - mycat("Unsuitable angle (7-th argument)!"); - return -1; - } - /* - z = f(x,y) => X=-As*x+Ac*y, Y= Bc*f(x,y)-Bsc*x-Bss*y - Out X-coord is in [X0,X1], dvided by Dev segments - J-th segment of Y-coord : ZF[J]==1 => [Z0[0],Z1[J]] - */ - Bsc=Bs*Ac;Bss=Bs*As; - if(Ratio2!=1){ - if(Sh%2==1){ - Ac*=Ratio2;Bss*=Ratio2; - }else{ - As*=Ratio2;Bsc*=Ratio2; - } - } - CX=-As*Cx+Ac*Cy;CY=Bc*(z-Org[2])-Bsc*Cx-Bss*Cy; - if(type(Dvi=getopt(dviout))!=1 && getopt(trans)==1) return [CX*Sc,CY*Sc]; - if(type(N1=getopt(inf))==1){ - if(Proc) Dvi=N1; - else if(Dvi<=0) Dvi=-N1; - } - X0=-As*Lx[1]+Ac*Ly[0];X1=-As*Lx[0]+Ac*Ly[1]; - F1=mysubst(F1,[@pi,deval(@pi)]); - Tf=type(F1=f2df(F1|opt=0)); - if(Tf!=4) F=Bc*F1-Bsc*x-Bss*y; - else F=append([Bc*F1[0]-Bsc*x-Bss*y],cdr(F1)); - Dx=(Lx[1]-Lx[0])/NN; Dy=(Ly[1]-Ly[0])/NN; - if(type(Err=getopt(err))==1) - F=mysubst(F,[[x,x+Err*Dx/1011.23],[y,y+Err*Dy/1101.34]]); - Out=(Proc)?[]:str_tb(0,0); - Dev=N*M1; - XD=(X1-X0)/Dev; - OLV=newvect(2,[OL,OL]); - if(type(Ura=getopt(opt))==4 || type(Ura)==7){ - if(type(Ura)==7) Ura=[Ura,Ura]; - else{ - OLV[0]=cons(["opt",Ura[0]],OL); - OLV[1]=cons(["opt",Ura[1]],OL); - } - } - for(KC=0; KC<=1; KC++){ /* draw curves */ - Z0=newvect(Dev+1); Z1=newvect(Dev+1); ZF=newvect(Dev+1); - for(I=0; I<=NN; I++){ - FV=I%M2; - if(KC==0){ - X=x; Y=Ly[1]-I*Dy; LX=Lx; DD=Dx; G=mysubst(F,[y,Y]); - if(!FV){ - if(!Proc) str_tb(["%y=",rtostr(Y),"\n"],Out); - else Out=cons([-2,"y="+rtostr(Y)],Out); - } - }else{ - X=Lx[1]-I*Dx; Y=x; LX=Ly; DD=Dy; G=mysubst(F,[[x,X],[y,Y]]); - if(!FV){ - if(!Proc) str_tb(["%x=",rtostr(X),"\n"],Out); - else Out=cons([-2,"x="+rtostr(X)],Out); - } - } - XX=-As*X+Ac*Y; A1=coef(XX,1,x); A0=coef(XX,0,x); /* XX = A1*x + A0, x = (XX-A0)/A1 */ - if(!FV && Vw==1){ - if(Proc) Out=cons(xygraph([XX,G],N,LX,[X0,X1],Lz|scale=Sc,para=1,proc=3),Out); - else str_tb(xygraph([XX,G],N,LX,[X0,X1],Lz|scale=Sc,para=1),Out); - continue; - } - V=VT=LX[1]; - J0=(subst(XX,x,LX[0])-X0)/XD; J1=(subst(XX,x,LX[1])-X0)/XD; - if(J0<J1){ - J0=ceil(J0); J1=floor(J1); JD=1; /* fixed x: y: dec => (x,z):(dec,inc) */ - }else{ - J0=floor(J0); J1=ceil(J1); JD=-1; /* fixed y: x: dec => (x,z):(inc,inc) */ - } - for(FF=1,J=J1;;J-=JD){ - V1=VT; - VT=(X0+J*XD-A0)/A1;GG=mysubst(G,[x,VT]); - if(Cpx>=1) VV=myeval(GG); - else VV=(Tf==4)? mydeval(GG):deval(GG); /* J -> V */ - if(ZF[J]==0 || VV<=Z0[J] || VV>=Z1[J]){ /* visible */ - if(FF==0){ - V0=(VT+V1)/2; - if(!FV && Vw==-1 && Raw!=1){ /* draw doted line */ - K=ceil(M3*(V-V0)/(M2*DD)); - if(N1<0) K=-K; - OPT=append(OPT0,[["opt",(TikZ)?"dotted":"~*=<3pt>{.}"],["scale",Sc],["para",1]]); - Out=saveproc(xygraph([XX,G],K,[V0,V],[X0-1,X1+1],Lz| - option_list=OPT),Out); - } - V=V0; - } - if(ZF[J]==0){ - ZF[J]=1; Z0[J]=Z1[J]=VV; - }else if(VV<=Z0[J]) Z0[J]=VV; - else Z1[J]=VV; - - if(VV>=Z1[J]) FF=1; - else if(VV<=Z0[J]) FF=-1; - }else{ - if(FF!=0){ - V0=(VT+V1)/2; - K=ceil(M3*(V-V0)/(M2*DD)); - if(N1<0) K=-K; - if(!FV){ - OPT=append(OPT0,OLV[(1-FF)/2]); - Out=saveproc(xygraph([XX,G],K,[V0,V],[X0-1,X1+1],Lz|option_list=OPT),Out); - } - V=V0; - } - FF=0; - } - if(J==J0) break; - } - if(FV) continue; - V0=LX[0];K=ceil(M3*(V-V0)/(M2*DD)); - if(N1<0) K=-K; - if(FF!=0){ - if(Raw!=1){ - OPT=append(OPT0,OLV[(1-FF)/2]); - Out=saveproc(xygraph([XX,G],K,[V0,V],[X0-1,X1+1],Lz|option_list=OPT),Out); - }else if(Vw==-1 && Raw!=1){ - OPT=append(OPT0,[["opt",(TikZ)?"dotted":"~*=<3pt>{.}"]]); - Out=saveproc(xygraph([XX,G],K,[V0,V],[X0-1,X1+1],Lz|option_list=OPT),Out); - } - } - } - } - OptSc=(Sc==1)?[]:[["scale",Sc]]; - if(type(LZ=getopt(ax))==4){ /* draw box */ - FC=0; - if(length(LZ)==3) FC=LZ[2]; - P0=newvect(2,[-As*Lx[1]+Ac*Ly[1],Bc*(LZ[0]-Org[0])-Bsc*Lx[1]-Bss*Ly[1]]); - Vx=newvect(2,[As*(Lx[1]-Lx[0]),Bsc*(Lx[1]-Lx[0])]); - Vy=newvect(2,[Ac*(Ly[0]-Ly[1]),Bss*(Ly[1]-Ly[0])]); - Vz=newvect(2,[0,Bc*(LZ[1]-LZ[0])]); - OL=OL0=append(OPT0,OL); - if(TikZ && type(Ura)==4 && length(Ura)>2) OL0=cons(["opt",Ura[2]],OL); - LL=[[P0+Vz,P0+Vx+Vz],[P0,P0+Vx]]; - if(Bs>0){ - LL=cons([P0+Vy+Vz,Pz=P0+Vx+Vy+Vz],LL); - LL=cons([P0+Vx+Vz,Pz],LL); - PP=Pz-Vz; - } - else{ - LL=cons([P0+Vy,Pz=P0+Vx+Vy+Vz],LL); - LL=cons([P0+Vx,Pz],LL); - PP=Pz+Vz; - } - J=ceil((PP[0]-X0)/XD+0.5); - LL=append([[P0+Vy,P0+Vy+Vz],[P0+Vy,P0+Vy+Vz],[P0+Vx,P0+Vx+Vz],[P0,P0+Vz], - [P0+Vz,P0+Vy+Vz],[P0,P0+Vy]],LL); - for(LL=reverse(LL);LL!=[];LL=cdr(LL)) Out=saveproc(xylines(car(LL)|option_list=OL0),Out); - if(Dev>4) Dev2=ceil(Dev/2); - if(FC<0 && Raw!=1){ - if(TikZ){ - if(type(Ura)==4 && length(Ura)>2) - OL1=cons(["opt",Ura[2]+",dotted"],OL); - else OL1=cons(["opt","dotted"],OL); - }else OL1=cons(["opt","@{.}"],OL); - if(FC==-8) FC=0; - } - for(I=0;I<3;I++){ /* box with hidden part */ - if(I==1) Pz=PP-Vx; - else if(I==2) Pz=PP-Vy; - LP=Pz-PP; - for(FV=-1,K=0;K<=Dev2; K++){ - PPx=PP[0]+(K/Dev2)*LP[0]; PPy=PP[1]+(K/Dev2)*LP[1]; - J=ceil((PPx-X0)/XD); - if(K!=Dev2 && (J<0||J>Dev)) continue; - if(K!=Dev2 && (ZF[J]==0 || PPy<Z0[J] || PPy>Z1[J])){ /* visible */ - if(FV!=1){ - FV=1; - PPP=[PPx,PPy]; - } - }else{ - if(FV!=0){ - if(FV==1) Out=saveproc(xylines([PPP,[PPx,PPy]]|option_list=OL1),Out); - FV=0; - } - } - } - } - if(FC!=0 && Raw!=1){ /* show coordinate*/ - if(iand(FC,4)){ - Sub=1; - if(TikZ){ - S0="\\scriptsize";S1=""; - }else{ - S0="{}_{"; S1="}"; - } - }else Sub=0; - if(iand(FC,2)) - LLL=[[1,0,P0+Vx,(TikZ)?"right":"+!L"],[3,0,P0+Vy,(TikZ)?"left":"+!R"]]; - else LL=[]; - if(Bs>0){ - LLL=cons([0,0,P0,(TikZ)?"below":"+!U"],LLL); - LLL=cons([2,1,P0+Vx+Vy+Vz,(TikZ)?"above":"+!D"],LLL); - }else{ - LLL=cons([2,0,P0+Vx+Vy,(TikZ)?"below":"+!U"],LLL); - LLL=cons([0,1,P0+Vz,(TikZ)?"above":"+!D"],LLL); - } - for(TLL=LLL;TLL!=[];TLL=cdr(TLL)){ - TL=car(TLL);LL=L[(Sh+TL[0])%4]; - if(Cpx==0 || Cpx==3){ - S=ltotex([LL[0],LL[1],LZ[TL[1]]]|opt="coord"); - SS="("+rtostr(LL[0]) +","+rtostr(LL[1])+","+rtostr(LZ[TL[1]])+")"; - }else{ - S=ltotex([LL[0]+LL[1]*@i,LZ[TL[1]]]|opt="coord",cpx=Cpx); - SS="("+rtostr(LL[0])+"+"+rtostr(LL[1])+"i,"+ rtostr(LZ[TL[1]])+")"; - } - if(TikZ) S="$"+S+"$"; - if(Sub) S=S0+S+S1; - if(!TikZ) S="$"+S+"$"; - if(Proc) Out=cons([2,OptSc,[TL[2][0],TL[2][1]],[[TL[3],S]],SS],Out); - else str_tb(xyput([TL[2][0],TL[2][1],[TL[3],S]]|option_list=OptSc),Out); - } - } - } - if(type(Pt=getopt(pt))==4){ /* option pt=[] */ - if(type(Pt[0])<4) Pt=[[Pt]]; - if(length(Pt)>1&&type(Pt[1])!=4) Pt=[Pt]; - for(PT=Pt;PT!=[];PT=cdr(PT)){ - PP=car(PT); - if(type(PP)==4 && length(PP)==3 && type(PP[0])<2 && type(PP[2])<2) PP=[PP]; - P=car(PP); - if(type(P)==7) Q=[P,0]; - else if(P==1) Q=["_",0]; - else Q=mysubst([CX,CY],[[x,deval(P[0])],[y,deval(P[1])],[z,deval(P[2])]]); - if(length(PP)>1 && type(PP[1])==4 && length(PP[1])==3){ /* draw line */ - PP=cdr(PP);P=car(PP); - if(type(P)==7) Q1=P; - else if(P==1) Q="_"; - else Q1=mysubst([CX,CY],[[x,deval(P[0])],[y,deval(P[1])],[z,deval(P[2])]]); - if(length(PP)<2 || PP[1]==0 || iand(PP[1],1)) OL2=""; - else OL2=(TikZ)?"dotted":"@{.}"; - if(length(PP)>2 && type(PP[2])==7){ - if(OL2=="") OL2=PP[2]; - else{ - if(TikZ) OL2=OL2+","; - OL2=OL2+PP[2]; - } - } - OL1=OL; - if(OL2!="") OL1=cons(["opt",OL2],OL1); - if(length(PP)<2 || PP[1]>=0) - Out=saveproc(xylines([Q,Q1]|option_list=OL1),Out); - else{ - LP0=Q1[0]-Q[0];LP1=Q1[1]-Q[1]; - for(FV=-1,K=0;K<=Dev2; K++){ - PPx=Q[0]+(K/Dev2)*LP0; PPy=Q[1]+(K/Dev2)*LP1; - J=ceil((PPx-X0)/XD); - if(K!=Dev2 && (J<0 || J>Dev || ZF[J]==0 || PPy<Z0[J] || PPy>Z1[J])){ - /* visible */ - if(FV!=1){ - FV=1; - PPP=[PPx,PPy]; - } - }else{ - if(FV!=0){ - if(FV==1) Out=saveproc(xylines([PPP,[PPx,PPy]]|option_list=OL1),Out); - FV=0; - } - } - } - } - continue; - } - if(length(PP)==1) S="$\\bullet$"; - else if(type(PP[1])==7) S=PP[1]; - else if(type(PP[1])==4){ - if(length(PP[1])>1 && type(PP[1][1])!=7) - S=cons(car(PP),cons("$\\bullet$",cdr(cdr(PP)))); - else S=PP[1]; - }else S="$\\bullet$"; - if(length(PP)<=2){ - if(Proc) Out=cons([2,OptSc,[Q[0],Q[1]],[S]],Out); - else str_tb(xyput([Q[0],Q[1],S]|option_list=OptSc),Out); - }else if(!TikZ){ - if(Proc) Out=cons([2,OptSc,[Q[0],Q[1]],[S,"",PP[2]]],Out); - else str_tb(xyput([Q[0],Q[1],S,"",PP[2]]|option_list=OptSc),Out); - }else{ - if(Proc) Out=cons([2,OptSc,[Q[0],Q[1]],cons(S,cdr(cdr(PP)))],Out); - else str_tb(xyput(append([Q[0],Q[1],S],cdr(cdr(PP)))|option_list=OptSc),Out); - } - } - } - if(Proc){ - S=reverse(Out); - if(Proc==1||Proc==3){ - for(W=[],I=0;I<2;I++) for(J=0;J<2;J++) for(K=0;K<2;K++) - W=cons(mysubst([CX*Sc,CY*Sc],[[x,Lx[I]],[y,Ly[J]],[z,Lz[K]]]),W); - W=ptbbox(W); - S=cons([0,W[0],W[1],(TikZ)?1:1/10],S); - } - }else S=str_tb(0,Out); - if(type(Dvi)!=1||(Proc&&abs(Dvi)<2)) return S; - Lout=[]; - if(abs(Dvi)>=2){ - /* show title */ - L0=[]; - Title=getopt(title); - if(type(Title)!=7) - Title=(type(F00)==4)?("\\texttt{"+verb_tex_form(F00)+"}"):my_tex_form(F00); - if(type(Title)==7){ - T=my_tex_form(L[3][0])+"\\le x\\le "+my_tex_form(L[1][0])+",\\,"+ - my_tex_form(L[3][1])+"\\le y\\le "+my_tex_form(L[1][1])+")"; - if(Proc){ - if(Cpx>=1) L0=[[5,[["eq",1]],"|"+Title+"|\\quad(z=x+yi,\\ "+T]]; - else L0=[[5,[["eq",1]],"z="+Title+"\\ \\ ("+T]]; - }else{ - if(Cpx>=1) dviout("|"+Title+"|\\quad(z=x+yi,\\ "+T|eq=1,keep=1); - else dviout("z="+Title+"\\ \\ ("+T|eq=1,keep=1); - } - } - A=rint(deval(180*A/@pi))+90*(Sh-1); - if(A>=180) A-=180; - B=rint(deval(180*B/@pi)); - if(abs(Dvi)>=3){ - T="\\text{angle } ("+my_tex_form(A)+"^\\circ,"+my_tex_form(B)+"^\\circ)"; - if(Ratio!=1 || Ratio2!=1) T=T+"\\quad\\text{ratio }1:" - +my_tex_form(sint(Ratio2,2))+":"+my_tex_form(sint(Ratio,2)); - if(Proc) L0=cons([5,[["eq",1]],T],L0); - else dviout(T|eq=1,keep=1); - } - SS="% range "+rtostr([L[3][0],L[1][0]])+"x"+rtostr([L[3][1],L[1][1]])+ - " angle ("+ rtostr(A) +","+ rtostr(B)+") dev="; - if(M1==M2) SS=SS+rtostr(M1); - else SS=SS+rtostr([M1,M2]); - if(M3!=1) SS=SS+" acc="+rtostr(M3); - if(type(Sc0)>=0) SS=SS+" scale="+rtostr(Sc0); - if(Proc){ - S=cons([5,[],SS],S); - for(;L0!=[];L0=cdr(L0)) S=cons(car(L0),S); - return S; - } - if(Dvi>0){ - dviout(SS|keep=1); - dviout(xyproc(S)|eq=8); - }else Lout=[SS,S]; - }else{ - if(Dvi>0) dviout(xyproc(S)); - else Lout=[S]; - } - if(getopt(trans)==1) return cons([CX*Sc,CY*Sc],Lout); - if(Dvi<0) return Lout; -} - -def orthpoly(N) -{ - F=0; - if(type(P=getopt(pol))==7){ - for(L=["Le","Ge","Tc","2T","Ja","He","La","Se"];L!=[];L=cdr(L),F++) - if(str_str(P,car(L)|end=2)==0) break; - }else P=0; - if(type(D=N)==4) D=N[0]; - if(!isint(D)||D<0) return 0; - if(F==0) return seriesHG([-D,D+1],[1],(1-x)/2,D); - if(F==1) return red(seriesHG([-D,D+2*N[1]],[N[1]+1/2],(1-x)/2,D)*binom(D+2*N[1]-1,D)); - if(F==2) return seriesHG([-D,D],[1/2],(1-x)/2,D); - if(F==3){ - if(D==0) return 0; - return orthpoly([D-1,1]|pol="Ge"); - } - if(F==4) return red(seriesHG([-D,D+N[1]],[N[2]],x,D)); - if(F==5){ - for(S=I=1;I<=D;I+=2) S*=I; - if(iand(D,1)) return seriesHG([-(D-1)/2],[3/2],x^2/2,D-1)*x*S*(-1)^((D-1)/2); - else return seriesHG([-D/2],[1/2],x^2/2,D)*S*(-1)^(D/2); - } - if(F==6){ - NN=(type(N)==4)?N[1]:0; - return red(seriesHG([-D],[NN+1],x,D)*binom(D+NN,D)); - } - if(F==7){ - NN=N[1]; - for(S=1,I=1;I<=D;I++) S+=(-1)^I*binom(D,I)*binom(D+I,I)*sftpow(x,I)/sftpow(NN,I); - return S; - } - return 0; -} - -def schurpoly(L) -{ - N=length(L); - for(R=[],I=1;L!=[];L=cdr(L),I++) R=cons(car(L)+N-I,R); - L=reverse(R); - if(type(X=getopt(var))!=4){ - V=(type(X)>1)?X:"x"; - for(X=[],I=0;I<N;I++) X=cons(makev([V,N-I]),X); - } - M=newmat(N,N); - for(I=0;I<N;I++) - for(J=0;J<N;J++) M[I][J]=X[I]^L[J]; - P=det(M); - for(I=0;I<N;I++) - for(J=I+1;J<N;J++) P=sdiv(P,X[I]-X[J]); - return P; -} - -def fouriers(A,B,X) -{ - if((Y=getopt(y))==0||type(Y)>0) Y=deval(Y); - else Y=0; - if((V=getopt(const))==0||type(V)>0){ - V=myfeval(V,Y); - K=1; - }else K=0; - if(A!=[]&&type(car(A))>1){ - for(C=[],I=A[1];I>=K;I--) C=cons(myf2eval(car(A),I,Y),C); - if(K) C=cons(0,C); - A=C; - } - if(K){ - if(A!=[]) A=cdr(A); - A=cons(V,A); - } - if(B!=[]&&type(car(B))>1){ - for(C=[],I=B[1];I>0;I--) C=cons(myf2eval(car(B),I,Y),C); - B=C; - } - L=length(B)+1; - if(length(A)>=L) L=length(A)+1; - if(type(Sum=getopt(sum))>0){ - if(Sum==1) Sum=1-x; - else if(Sum==2) Sum=[(z__)/(3.1416*x),[z__,os_md.mysin,3.1416*x]]; - else Sum=f2df(Sum); - C=[]; - if(A!=[]){ - C=cons(car(A),C); - A=cdr(A); - } - for(I=1;A!=[];A=cdr(A),I++) C=cons(car(A)*myf2eval(Sum,I/L,L),C); - A=reverse(C); - for(C=[],I=1;B!=[];B=cdr(B),I++) C=cons(car(B)*myf2eval(Sum,I/L,L),C); - B=reverse(C); - } - if(getopt(cpx)==1){ - if(type(X=eval(X))>1) return todf([os_md.fouriers,[["cpx",1]]],[[A],[B],[X]]); - V=dexp(@i*X); - for(C=A,P=1,I=0;C!=[];C=cdr(C),I++){ - R+=S*car(C)*P; - P*=V; - } - V=dexp(-@i*X); - for(C=B,P=1,I=0;C!=[];C=cdr(C),I++){ - P*=V; - R+=car(C)*P; - } - return R; - } - if(type(X=eval(X))>1) return todf(os_md.fouriers,[[A],[B],[X]]); - for(C=A,I=0;C!=[];C=cdr(C),I++) - R+=car(C)*mycos(I*X); - for(C=B,I=1;C!=[];C=cdr(C),I++) - R+=car(C)*mysin(I*X); - return R; -} - - -def myexp(Z) -{ - if(type(Z=eval(Z))>1) return todf(os_md.myexp,[Z]); - if((Im=imag(Z))==0) return dexp(Z); - return dexp(real(Z))*(dcos(Im)+@i*dsin(Im)); -} - -def mycos(Z) -{ - if(type(Z=eval(Z))>1) return todf(os_md.mycos,[Z]); - if((Im=imag(Z))==0) return dcos(Z); - V=myexp(Z*@i); - return (V+1/V)/2; -} - -def mysin(Z) -{ - if(type(Z=eval(Z))>1) return todf(os_md.mysin,[Z]); - if((Im=imag(Z))==0) return dsin(Z); - V=myexp(Z*@i); - return (1/V-V)*@i/2; -} - -def mytan(Z) -{ - if(type(Z=eval(Z))>1) return todf(os_md.mytan,[Z]); - if((Im=imag(Z))==0) return dtan(Z); - V=myexp(2*Z*@i); - return @i*(1-V)/(1+V); -} - -def mylog(Z) -{ - if(type(Z=eval(Z))>1) return todf(os_md.mylog,[Z]); - if((Im=imag(Z))==0) return dlog(Z); - return dlog(dabs(Z))+@i*myarg(Z); -} - -def mypow(Z,R) -{ - if(type(Z=eval(Z))>1||type(R=eval(R))>1) return todf(os_md.mypow,[Z,R]); - if(Z==0) return 0; - if(isint(2*R)){ - if(R==0) return 1; - if(isint(R)) return Z^R; - V=dsqrt(Z); - if(R==1/2) return V; - return Z^(R-1/2)*V; - } - return myexp(R*mylog(Z)); -} - -def myarg(Z) -{ - if(type(Z=map(eval,Z))==4){ - if(length(Z)!=2) return todf(os_md.myarg,[Z]); - Re=Z[0];Im=Z[1]; - }else if(type(Z)>1){ - return todf(os_md.myarg,[Z]); - }else { - Im=imag(Z);Re=real(Z); - } - if(Re==0) return (Im<0)?-deval(@pi)/2:deval(@pi)/2; - V=datan(Im/Re); - if(Re>0) return V; - return (V>0)?(V-deval(@pi)):(V+deval(@pi)); -} - -def myatan(Z) -{ - if(type(Z=eval(Z))>1) return todf(os_md.myatan,[Z]); - if((Im=imag(Z))==0) return datan(Z); - mylog((1-Z*@i)/(1+Z*@i))*@i/2; -} - -def myasin(Z) -{ - if(type(Z=eval(Z))>1) return todf(os_md.myasin,[Z]); - return deval(@pi/2)-myacos(Z); -} - -def frac(X) -{ - if(type(X=eval(X))>1) return todf(os_md.frac,[X]); - return (ntype(X)==3)? pari(frac,X):(X-floor(X)); -} - -def myacos(Z) -{ - if(type(Z=eval(Z))>1) return todf(os_md.myacos,[Z]); - if(imag(Z)==0 && Z<=1 && Z>=-1) return dacos(Z); - return mylog(Z-dsqrt(Z^2-1))*@i; -} - -def arg(Z) -{ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.arg,[Z]); - return (type(Z)==4)?pari(arg,Z[0],Z[1]):arg(sqrt,Z); -} - -def sqrt(Z){ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.sqrt,[Z]); - R=(type(Z)==4)?Z[1]:Z; - if(ntype(R)==0){ - if(R==0) return 0; - if(R>0){ - if(pari(issquare,R)) return pari(isqrt,nm(R))/pari(isqrt,dn(R)); - }else{ - R=-R; - if(pari(issquare,R)) return pari(isqrt,nm(R))/pari(isqrt,dn(R))*@i; - } - } - return (type(Z)==4)?pari(sqrt,Z[0],Z[1]):pari(sqrt,Z); -} - -def gamma(Z) -{ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.gamma,[Z]); - return (type(Z)==4)?pari(gamma,Z[0],Z[1]):pari(gamma,Z); -} - -def lngamma(Z) -{ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.lngamma,[Z]); - return (type(Z)==4)?pari(lngamma,Z[0],Z[1]):pari(lngamma,Z); -} - -def digamma(Z) -{ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.digamma,[Z]); - return (type(Z)==4)?pari(digamma,Z[0],Z[1]):pari(digamma,Z); -} - -def dilog(Z) -{ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.dilog,[Z]); - return (type(Z)==4)?pari(dilog,Z[0],Z[1]):pari(dilog,Z); -} - -def erfc(Z) -{ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.erfc,[Z]); - return (type(Z)==4)?pari(erfc,Z[0],Z[1]):pari(erfc,Z); -} - -def zeta(Z) -{ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.zeta,[Z]); - return (type(Z)==4)?pari(zeta,Z[0],Z[1]):pari(zeta,Z); -} - -def eta(Z) -{ - if(vars(Z=map(eval,Z))!=[]) return todf(os_md.eta,[Z]); - return (type(Z)==4)?pari(eta,Z[0],Z[1]):pari(eta,Z); -} - -def jell(Z) -{ - if(vars(Z=map(eval,V))>1) return todf(os_md.jell,[Z]); - return (type(Z)==4)?pari(jell,Z[0],Z[1]):jell(jell,Z); -} - -def evals(F) -{ - if(type(F)==7){ - if(type(Del=getopt(del))!= 7) return eval_str(F); - S=strtoascii(Del);K=length(S); - if(K==0) return [eval_str(F)]; - Raw=getopt(raw); - F=strtoascii(F);L=[];T1=0; - do{ - T2=str_str(F,S|top=T1); - if(T2<0) T2=10000; - FT=str_cut(F,T1,T2-1); - L=cons((Raw==1)?FT:evals(FT),L); - T1=T2+K; - }while(T2!=10000); - return reverse(L); - } - if(type(F)==4){ - if(type(S=car(F))==7){ - S+="("; - for(I=0,FT=cdr(F); FT!=[]; I++,FT=cdr(FT)){ - if(type(ST=car(FT))!=7) ST=rtostr(ST); - if(I>0) S=S+","+ST; - else S=S+ST; - } - S=S+")"; - return eval_str(S); - }else return call(S,cdr(F)); - } - return F; -} - -def myval(F) -{ - if(type(F)!=4){ - F=f2df(sqrt2rat(F)); - if(type(F)!=4) return F; - }; - if(length(F)==1) V=car(F); - else for(V=car(F),F=cdr(F); F!=[];){ - FT=car(F); - if(type(G=FT[1])==2){ - if(length(FT)>2){ - FT2=myval(FT[2]); - if(length(FT)>3) FT3=myval(FT[3]); - }; - X=red(FT2/@pi);Vi=-red(FT2*@i/@pi);W=red(FT2/@e); - if(G==os_md.mypow && FT3==1/2){ - G=os_md.sqrt; - FT=[FT[0],G,FT[2]]; - } - if((T=findin(G, - [sin,os_md.mysin,cos,os_md.mycos,tan,os_md.mytan]))>=0 - &&(isint(6*X)||isint(4*X))){ - if(T==2||T==3){ - T=0;X=1/2-X; - } - X=X-floor(X/2)*2; - if(T==0||T==1){ - if(X>1){ - S=-1;X-=1; - }else S=1; - if(X>1/2) X=1-X; - if(X==0) R=0; - else if(X==1/6) R=1/2; - else if(X==1/4) R=2^(1/2)/2; - else if(X==1/3) R=3^(1/2)/2; - else R=1; - R*=S; - }else{ - if(X>1) X-=1; - if(X>1/2){ - S=-1;V=1-X; - }else S=1; - if(X==0) R=0; - else if(X==1/6) R=3^(1/2)/3; - else if(X==1/4) R=1; - else if(X==1/3) R=3^(1/2); - else R=2^512; - R*=S; - } - }else if((G==exp||G==os_md.myexp)&&(isint(FT2)||isint(6*Vi)||isint(4*Vi))){ - if(isint(FT2)) R=@e^FT2; - else R=myval([z+w*@i,[z,cos,Vi*@pi],[w,sin,Vi*@pi]]); - }else if((G==pow||G==os_md.mypow) && (isint(FT3)||FT2==1||FT2==0)){ - if(FT2==0) R=0; - else if(FT2==1) R=1; - else R=FT2^FT3; - }else if(G==os_md.abs&&ntype(P=eval(FT2))<4){ - R=FT2; - if(P<0) R=-R; - }else if((G==os_md.sqrt||G==dsqrt)&&type(FT2)<2&&ntype(FT2)==0) - R=sqrtrat(FT2); - else if((G==os_md.mylog||G==dlog)&&(FT2==@e||FT2==1)) - R=(FT2==1)?0:1; - else if(length(FT)==3) R=eval((*G)(myeval(FT2))); -#ifdef USEMODULE - else R=call(G,map(os_md.myeval,cdr(cdr(FT)))); -#else - else R=call(G,map(myeval,cdr(cdr(FT)))); -#endif - } - else if(G==0) R=FT[2]; -#ifdef USEMODULE - else R=eval(call(G[0],map(os_md.myeval,cdr(cdr(FT)))|option_list=G[1])); -#else - else R=eval(call(G[0],map(myeval,cdr(cdr(FT)))|option_list=G[1])); -#endif - V=mysubst(V,[FT[0],R]); - F=mysubst(cdr(F),[FT[0],R]); - } - if(type(V)<4 && !iscoef(V,os_md.iscrat)) V=eval(V); -#if 0 - return (type(V)<4)?myeval(V):mtransbys(os_md.myeval,V,[]); -#else - return V; -#endif -} - -/* -1:‹ó 0:®” 1:—L—” 2:Gauss®” 3:Gauss—L—” 4:‚»‚êˆÈŠO‚Ì•¡‘f” */ -/* def vntype(F) -{ - if((T=type(F))<2){ - if(T<0) return -1; - if((Tn=ntype(F))==0){ - return (isint(F))?0:1; - } - if(Tn==4){ - if(ntype(real(F))==0&&ntype(real(F))==0) - return (isint(F)&&isint(F))?2:3; - return 4; - } - } - if(T==2){ - V=vars(F); - if((VV=lsort(V,[@e,@pi],1))==[]){ - FT=mycoef( - }else{ - if(length(VV)==1){ - }else - } - }else if(T==3){ - - } -} -*/ - - -def myeval(F) -{ - if(type(F)!=4) V=F; - else if(length(F)==1) V=car(F); - else for(V=car(F),F=cdr(F); F!=[];){ - FT=car(F); - if(type(G=FT[1])==2){ - if(length(FT)==3) R=(*G)(myeval(FT[2])); -#ifdef USEMODULE - else R=call(G,map(os_md.myeval,cdr(cdr(FT)))); -#else - else R=call(G,map(myeval,cdr(cdr(FT)))); -#endif - } - else if(G==0) R=myeval(FT[2]); -#ifdef USEMODULE - else R=call(G[0],map(os_md.myeval,cdr(cdr(FT)))|option_list=G[1]); -#else - else R=call(G[0],map(myeval,cdr(cdr(FT)))|option_list=G[1]); -#endif - V=mysubst(V,[FT[0],R]); - F=mysubst(cdr(F),[FT[0],R]); - } - return (type(V)<4)?eval(V):mtransbys(eval,V,[]); -} - -def mydeval(F) -{ - if(type(F)!=4) V=F; - else if(length(F)==1) V=car(F); - else for(V=car(F),F=cdr(F); F!=[]; ){ - FT=car(F); - if(type(G=FT[1])==2){ - if(length(FT)==3) R=(*G)(myeval(FT[2])); -#ifdef USEMODULE - else R=call(G,map(os_md.mydeval,cdr(cdr(FT)))); -#else - else R=call(G,map(mydeval,cdr(cdr(FT)))); -#endif - } - else if(G==0) R=mydeval(FT[2]); -#ifdef USEMODULE - else R=call(G[0],map(os_md.mydeval,cdr(cdr(FT)))|option_list=G[1]); -#else - else R=call(G[0],map(mydeval,cdr(cdr(FT)))|option_list=G[1]); -#endif - V=mysubst(V,[FT[0],R]); - F=mysubst(cdr(F),[FT[0],R]); - } - return (type(V)<4)?deval(V):mtransbys(deval,V,[]); -} - -def myfeval(F,X) -{ - if(type(X)==4){ - if(isvar(X[0])&&length(X)==2) - return mydeval(mysubst(F,[X[0],X[1]])); - if(type(X[0])==4&&isvar(X[0][0])&&length(X[0])==2){ - for(Y=X;Y!=[];Y=cdr(Y)) - F=mysubst(F,[car(Y)[0],car(Y)[1]]); - return myeval(F); - } - } - return myeval(mysubst(F,[x,X])); -} - -def myf2eval(F,X,Y) -{ - return myeval(mysubst(F,[[x,X],[y,Y]])); -} - -def myf3eval(F,X,Y,Z) -{ - return myeval(mysubst(F,[[x,X],[y,Y],[z,Z]])); -} - -def myfdeval(F,X) -{ - if(type(X)==4){ - if(isvar(X[0])&&length(X)==2) - return mydeval(mysubst(F,[X[0],X[1]])); - if(type(X[0])==4&&isvar(X[0][0])&&length(X[0])==2){ - for(Y=X;Y!=[];Y=cdr(Y)) - F=mysubst(F,[car(Y)[0],car(Y)[1]]); - return mydeval(F); - } - } - return mydeval(mysubst(F,[x,X])); -} - -def myf2deval(F,X,Y) -{ - return mydeval(mysubst(F,[[x,X],[y,Y]])); -} - -def myf3deval(F,X,Y,Z) -{ - return mydeval(mysubst(F,[[x,X],[y,Y],[z,Z]])); -} - -def df2big(F) -{ - AG=[[os_md.mysin,sin],[os_md.mycos,cos],[os_md.mytan,tan],[os_md.myasin,asin], - [os_md.acos,acos],[os_md,atan,atan],[os_md.myexp,exp],[os_md.mylog,log],[os_md.mypow,pow]]; - if(getopt(inv)!=1) return mysubst(F,AG); - else return mysubst(F,AG|inv=1); - -} - -def f2df(F) -{ - if(type(Opt=getopt(opt))!=1) Opt=0; - if(iand(Opt,1)){ - if(Opt>0) F=map(eval,F); - else F=map(deval,F); - } - Cpx=getopt(cpx); - if(type(F)==4 && iand(Opt,2)==0) return F; - K=getopt(level); - if(type(K)!=1) K=0; - AG=[sin,cos,tan,asin,acos,atan,exp,sinh,cosh,tanh,log,pow]; - AGd=[os_md.mysin,os_md.mycos,os_md.mytan,os_md.myasin,os_md.myacos, - os_md.myatan,os_md.myexp,os_md.myexp,os_md.myexp,os_md.myexp, - os_md.mylog,os_md.sqrt,os_md.myexp]; - for(R=[],I=0,Arg=vars(F);Arg!=[];Arg=cdr(Arg)){ - Fn=functor(car(Arg)); - if(vtype(Fn)!=3) continue; - V=args(car(Arg)); - for(PAG=AG,PAGd=AGd;PAG!=[];PAG=cdr(PAG),PAGd=cdr(PAGd)){ - if(Fn==car(PAG)){ - if(K==0) L="z__"; - else L="z"+rtostr(K)+"__"; - if(I==0) VC=makev([L]); - else VC=makev([L,I]); - I++; - VC0=VC; - if(Fn==sinh || Fn==cosh || Fn==tanh){ - VC=makev([L,I++]); - if(Fn==sinh) - R=cons([VC0,0,(VC^2-1)/(2*VC)],R); - else if(Fn==cosh) - R=cons([VC0,0,(VC^2+1)/(2*VC)],R); - else - R=cons([VC0,0,(VC^2-1)/(VC^2+1)],R); - } - if(Fn==pow && (V[1]!=1/2||Cpx==1)){ -#if 0 - R0=f2df(V[1]*((type(V[0])==1)?dlog(V[0]):log(V[0]))|level=K+1); - PAGd=cdr(PAGd); -#else - R=cons([VC,os_md.mypow,V[0],V[1]],R); - F=mysubst(F,[car(Arg),VC0]); - Arg=cons(0,vars(F)); - break; -#endif - }else R0=f2df(V[0]|level=K+1); - R=cons([VC,car(PAGd),R0],R); - F=mysubst(F,[car(Arg),VC0]); - Arg=cons(0,vars(F)); - break; - } - } - } - if(R==[]) return F; - if(Cpx==1){ - for(PAG=P,PAGd=AGd;PAG!=[];PAG=cdr(PAG),PAGd=cdr(PAGd)) - R=mysubst(R,[car(PADd),car(PAG)]); - } - return cons(F,reverse(R)); -} - -def todf(F,V) -{ - if(type(V)!=4) V=[V]; - for(R=[];V!=[];V=cdr(V)){ - R=cons(f2df(car(V)),R); - } - V=reverse(R); - Z=makenewv([F,V]); - return [Z,cons(Z,cons(F,V))]; -} - -def compdf(F,V,G) -{ - FL=["abs","floor","rint","zeta","gamma","arg","real","imag","conj"]; - FS=[os_md.abs,floor,rint,os_md.zeta,os_md.gamma,os_md.myarg,real,imag,conj]; - if(type(F)==7){ - if(str_str(F,"|")==0){ - F="abs("+str_cut(F,1,str_len(F)-2)+")"; - }else if(str_str(F,"[")==0){ - F="floor("+str_cut(F,1,str_len(F)-2)+")"; - } - I=str_str(F,"("); - Var=x; - if(I>0){ - J=str_pair(F,I+1,"(",")"); - if(J<0) return 0; - Var=eval_str(str_cut(F,I+1,J-1)); - Var=f2df(Var); - F0=str_cut(F,0,I-1); - } - if((I=findin(F0,FL))<0&&(I=findin(F,FL))<0) F=f2df(eval_str(F)); - else F=[z__,[z__,FS[I],Var]]; - } - if(type(F)!=4) F=f2df(F); - if(type(G)!=4) G=f2df(G); - if(V==G) return F; /* subst(F(V),V,G) */ - VF=vars(F);VG=vars(G); - if(type(V)==4){ - for(VT=[],VV=V;VV!=[];VV=cdr(VV)){ - if(findin(car(VV),VF)>=0){ - X=makenewv(append(VF,VG)); - VF=cons(X,VF); - F=mysubst(F,[car(VV),X]); - VT=cons(X,VT); - }else VT=cons(car(VV),VT); - } - for(V=reverse(VT);V!=[];V=cdr(V),G=cdr(G)) F=compdf(F,car(V),car(G)); - return F; - } - for(E=I=0;I<30;I++){ - for(J=0;J<30;J++){ - X=makev(["z__",I,J]); - if(findin(X,VF)<0 && findin(X,VG)<0){ - E=1;break; - } - } - if(E) break; - } - if(!E) return 0; - if(type(G)<4) return mysubst(F,[V,G]); - if(type(F)<4) F=[F]; /* return compdf([X,[X,0,F]],V,G); */ - F=mysubst(F,[V,X]); - if(isvar(G[0])){ - G=mysubst(G,[G[0],X]); - if(length(G)==2&&type(G[1])==4&&G[1][0]==X) G=G[1]; - G=cons(G,cdr(F)); - } - else G=cons([X,0,G],cdr(F)); - return cons(car(F),G); -} - -def fzero(F,LX) -{ - if(length(LX)==3){ - V=LX[0];LX=cdr(LX); - }else V=x; - LX1=eval(LX[0]);LX2=eval(LX[1]); - if(getopt(zero)==1){ - if(getopt(cont)==1) CT=1; - else CT=0; - if(getopt(trans)!=1 && type(F)<4) F=f2df(F); - F=mysubst(F,[[@pi,deval(@pi)],[@e,deval(@e)]]); - if(type(Dev=getopt(dev))!=1 || Dev<2) Dev=16; - V1=myeval(mysubst(F,[V,X1=LX1])); - V2=myeval(mysubst(F,[V,X2=LX2])); - if(V1>0){ - V0=V1;V1=V2;V2=V0; - X0=X1;X1=X2;X2=X0; - } - if(V1<0 && V2>0){ - D=(V2-V1)*1024; - for(I=0; I<Dev; I++){ -/* mycat([D,X1,V1,X2,V2]) ; */ - if(iand(I,1)) X0=(X1+X2)/2; - else X0=(V2*X1-V1*X2)/(V2-V1); - V0=myeval(mysubst(F,[V,X0])); - if(V0==0||V0==V1||V0==V2) return [X0,V0]; - if(V0<0){ - if(!CT && V0+D<0) return []; - V1=V0;X1=X0; - }else{ - if(!CT && V0>D) return []; - V2=V0;X2=X0; - } - } - X0=(V2*X1-V1*X2)/(V2-V1); - return [X0,myeval(mysubst(F,[V,X0]))]; - } - if(V0==0) return [X0,V0]; - if(V1==0) return [X1,V1]; - return []; - } - if(type(F)<4) F=f2df(F); - F=mysubst(F,[[@pi,deval(@pi)],[@e,deval(@e)]]); - L=[]; - if(type(F)<4){ - if(type(F)==3) F=nm(red(F)); - if((Deg=deg(F,V))<=2){ - if(Deg==2){ - D=(C1=coef(F,1,V))^2-4*(C2=coef(F,2,V))*coef(F,0,V); - if(D>=0){ - R=dsqrt(D); - if((S=(-C1+R)/(2*C2))>=LX1&&S<=LX2) L=[[S,mysubst(F,[V,S])]]; - if(D!=0 && (S=(-C1-R)/(2*C2))>=LX1&&S<=LX2) L=cons([S,mysubst(F,[V,S])],L); - } - L=qsort(L); - }else if(Deg==1&&(S=-coef(F,0,V)/coef(F,1,V))>=LX1&&S<=LX2) - L=[[S,mysubst(F,[V,S])]]; - return L; - } - for(L=[];S!=[];S=cdr(S)) - if(car(S)>=LX1&&car(S)<=LX2) L=cons([car(S),mysubst(F,[V,car(S)])],L); - return qsort(L); - } - if(type(Div=getopt(mesh))!=1 || Div<=0) - Div = 2^(10); - W=(LX2-LX1)/Div; - for(I=V2=0;I<=Div;I++){ - X1=X2;X2=LX1+I*W;V1=V2; - if((V2=myeval(mysubst(F,[V,X2])))==0) - L=cons([X2,V2],L); - if(V1*V2<0){ - L0=fzero(F,[V,X1,X2]|zero=1,trans=1); - if(L0!=[]) L=cons(L0,L); - } - } - return reverse(L); -} - -def fmmx(F,LX) -{ - if(length(LX)==3){ - V=LX[0];LX=cdr(LX); - }else V=x; - LX1=eval(LX[0]);LX2=eval(LX[1]); - FT=F; - if(getopt(trans)!=1 && type(F)<4) FT=f2df(FT); - FT=mysubst(FT,[[@pi,eval(@pi)],[@e,eval(@e)]]); - if(type(G=getopt(dif))>=1){ - if(G==1) G=os_md.mydiff(F,V); - L=fzero(G,[V,LX1,LX2]|option_list=getopt()); - R=[[LX1,myeval(mysubst(FT,[V,LX1]))]]; - for(I=0;L!=[];L=cdr(L),I++){ - X=car(L)[0]; - if(X==LX1) continue; - R=cons([X,myeval(mysubst(FT,[V,X]))],R); - } - if(X!=LX2) R=cons([LX2,myeval(mysubst(FT,[V,LX2]))],R); - if(getopt(mmx)!=1) return reverse(R); - for(Mi=Ma=car(R);R!=[];R=cdr(R)){ - if(car(R)[1]>Ma[1]) Ma=car(R); - else if(car(R)[1]<Mi[1]) Mi=car(R); - } - return [Mi,Ma]; - } - if(type(Div=getopt(mesh))!=1 || Div<=0) - Div = 2^(10); - if(type(Dev=getopt(dev))!=1 || Dev<2) Dev=16; - W=(LX2-LX1)/Div; - for(I=V2=V3=0;I<=Div;I++){ - X1=X2;X2=X3;X3=LX1+I*W;V1=V2;V2=V3; - V3=myeval(mysubst(FT,[V,X3])); - if(I==0) L=[[X3,V3]]; - if(I<2) continue; - if((V1-V2)*(V2-V3)<0){ - X02=X2;V02=V2;X03=X3;V03=V3; - for(J=0; J<Dev && X1!=X3; J++){ - X12=(X1+X2)/2;V12=myeval(mysubst(FT,[V,X12])); - if((V1-V12)*(V12-V2)<=0){ - X3=X2;V3=V2;X2=X12;V2=V12;continue; - } - X23=(X2+X3)/2;V23=myeval(mysubst(FT,[V,X23])); - if((V12-V2)*(V2-V23)<=0){ - X1=X12;V1=V12;X3=X23;V3=V23;continue; - } - if((V2-V23)*(V23-V3)<=0){ - X1=X2;V1=V2;X2=X23;V2=V23;continue; - } - } - L=cons([X2,V2],L); - X2=X02;V2=V02;X3=X03;V3=V03; - } - } - L=cons([LX2,myeval(mysubst(FT,[V,LX2]))],L); - if(getopt(mmx)!=1) return L; - for(Mi=Ma=car(L);L!=[];L=cdr(L)){ - if(car(L)[1]>Ma[1]) Ma=car(L); - else if(car(L)[1]<Mi[1]) Mi=car(L); - } - return [Mi,Ma]; -} - -def flim(F,L) -{ - FD=f2df(F); - Lim0=4;Lim=12;FS=1; - if(type(Pc=getopt(prec))==1){ - if((Pc>1&&Pc<31)||Pc>-5) Lim+=Pc; - } - if(type(Pc=getopt(init))==1 && Pc>0) FS*=Pc; - if(type(L)==7) L=[L]; - else if(type(L)<2){ - K=flim(F,["+",L]|option_list=getopt()); - if(K=="") return K; - K1=flim(F,["-",L]|option_list=getopt()); - if(K1=="") return K1; - if(type(K)==7||type(K1)==7){ - if(K!=K1) return ""; - return K; - } - if(abs(K)<10^(-5)){ - if(abs(K1)<10^(-5)) return (K1+K)/2; - else return ""; - } - if(abs((K1-K)/K)<10^(-4)) return (K1+K)/2; - return ""; - } - if(type(L)!=4||type(L[0])!=7) return ""; - if(L[0]=="-"||L[0]=="-infty"){ - FS=-FS; - }else if(L[0]!="+"&&L[0]!="infty") return ""; - FI=(length(L)==1)?1:0; - for(Inf=0,I=Lim0;I<Lim;I++){ - D1=FS*8^I;D2=8*D1; - if(FI==0){ - D1=1/D1;D2=1/D2; - } - if(D1>D2){ - D=D1;D1=D2;D1=D; - X1=D1;X2=D2; - } - if(FI==0){ - D1+=L[1];D2+=L[1]; - } - K=fmmx(FD,[D1,D2]|mmx=1,mesh=16,dev=4); - if(I>Lim0){ - if(DF<K[1][1]-K[0][1]&&DF>10^(-8)&&DF<10^7){ - if(I>Lim0+1){ - if(Inf==0) return ""; - }else Inf=1; - }else if(Inf==1) return ""; - } - DF=K[1][1]-K[0][1]; - } - if(Inf==1){ - if(K[0][1]>10^8) return "+"; - else if(K[1][1]<-10^8) return "-"; - return ""; - } - V=(myfeval(FD,D1)+1.0)-1.0; - if(V!=0 && abs(V)<10^(-9)) return 0; - return V; -} - -def fcont(F,LX) -{ - if(length(LX)==3){ - V=LX[0];LX=cdr(LX); - }else V=x; - LX1=eval(LX[0]);LX2=eval(LX[1]); - if(getopt(trans)!=1 && type(F)<4) FT=f2df(F); - if(type(Div=getopt(mesh))!=1 || Div<=0) - Div = 2^(10); - if(type(Dev=getopt(dev))!=1 || Dev<2) Dev=16; - W=(LX2-LX1)/Div; - if((Df=getopt(dif))!=1){ - Df=0; - }else{ - if(Dev==16) Dev=6; - WD=W/2^(Dev+1); - } - F=FT; - C=2; - for(I=V2=V3=0;I<=Div;I++){ - X1=X2;X2=X3;X3=LX1+I*W;V1=V2;V2=V3; - V3=myeval(mysubst(F,[V,X3])); - if(Df){ - if(I==Div) break; - V3=(myeval(mysubst(F,[V,X3+WD]))-V3)/WD; - } - if(I==0) L=[[X3,V3]]; - if(I<2) continue; - if(C*dabs(2*V2-V1-V3) > dabs(V1-V3)){ - X01=X1;V01=V1;X02=X2;V02=V2;X03=X3;V03=V3; - for(J=0; X01!=X03; J++){ - if(dabs(V01-V02)>dabs(V02-V03)){ - X03=X02;V03=V02; - }else{ - X01=X02;V01=V02; - } - if(J==Dev) break; - X02=(X01+X02)/2; - V02=myeval(mysubst(F,[V,X02])); - if(Df) V02=(myeval(mysubst(F,[V,WD]))-V02)/WD; - if(C*dabs(2*V02-V01-V03) < dabs(V01-V03)) break; - } - if(J==Dev||X01==X03) L=cons([X01,X03,V03-V01],L); - } - } - return reverse(L); -} - -def xygraph(F,N,LT,LX,LY) -{ - if((Proc=getopt(proc))!=1&&Proc!=2&&Proc!=3) Proc=0; - if(type(DV=getopt(dviout))==4){ - OL=delopt(getopt(),["dviout","shift","ext","cl"]); - OL=cons(["proc",1],OL); - R=xygraph(F,N,LT,LX,LY|option_list=OL); - OL=delopt(getopt(),["shift","ext","cl"]|inv=1); - return execdraw(R,DV|optilon_list=OL); - } - if(N==0) N=32; - if(N<0){ - N=-N; - N1=-1; N2=N+1; - }else{ - N1=0; N2=N; - } - if(length(LT)==3 && isvar(LT[0])==1){ - TT=LT[0]; LT=cdr(LT); - F=mysubst(F,[TT,x]); - } - if(LX==0) LX=LT; - if((Acc=getopt(Acc))!=1) Acc=0; - if(Acc){ - LX=[eval(LX[0]),eval(LX[1])]; - LY=[eval(LY[0]),eval(LY[1])]; - LT=[eval(LT[0]),eval(LT[1])]; - }else{ - LX=[deval(LX[0]),deval(LX[1])]; - LY=[deval(LY[0]),deval(LY[1])]; - LT=[deval(LT[0]),deval(LT[1])]; - } - TD=(LT[1]-LT[0])/N; - if(type(Mul=getopt(scale))!=1){ - if(type(Mul)==4){ - MulX=Mul[0]; MulY=Mul[1]; - }else MulX=MulY=1; - }else MulX=MulY=Mul; - if(type(Org=getopt(org))==4){ - Orgx=Org[0];Orgy=Org[1]; - }else Orgx=Orgy=0; - if(type(F)!=4 || (getopt(para)!=1 && length(F)>1 && type(F[0])<4 && type(F[1])==4)) { - if(getopt(rev)!=1){ - F1=x; /* LX[0]+(LX[1]-LX[0])*(x-LT[0])/(TD*N); */ - F2=F; - }else{ - F1=F; - F2=x; /* LY[0]+(LY[1]-LY[0])*(x-LT[0])/(TD*N); */ - } - }else{ - F1=F[0]; F2=F[1]; - } - if(F1==0 || F2==0) LT=[]; - if(length(LT)==2){ - if(Acc){ - for(LTT=[],I=N2;I>=N1;I--) - LTT=cons(eval(LT[0]+I*(LT[1]-LT[0])/N),LTT); - }else{ - for(LTT=[],I=N2;I>=N1;I--) - LTT=cons(deval(LT[0]+I*(LT[1]-LT[0])/N),LTT); - } - LT=LTT; - } - Cpx=getopt(cpx); - if(Cpx!=1 && (str_str(rtostr(F1),"@i")>=0 || str_str(rtostr(F2),"@i")>=0)) - Cpx=1; - if(type(Cpx)<0) Cpx=0; - if(!Acc){ - if(type(F1)<4) F1=f2df(F1); - if(type(F2)<4) F2=f2df(F2); - } - if(type(Err=getopt(err))==1){ - F1=mysubst(F1,[x,x+Err*TD/1001.23]); - F2=mysubst(F2,[x,x+Err*TD/1001.23]); - } - if(type(F1)==4 || type(F2)==4){ - Dn=1; - }else Dn=dn(F1)*dn(F2); - for(V=[],PT=LT;PT!=[]; PT=cdr(PT)){ - T=car(PT); - if(myfeval(Dn,T)==0){ - V=cons(0,V); continue; - } - if(Cpx>0||Acc){ - X=myfeval(F1,T);Y=myfeval(F2,T); - }else{ - X=myfdeval(F1,T);Y=myfdeval(F2,T); - } - if((N1==0||(PT!=LT&&length(PT)!=1)) && (X<LX[0]||X>LX[1]||Y<LY[0]||Y>LY[1])) - V=cons(0,V); - else - V=cons([MulX*(X-Orgx),MulY*(Y-Orgy)],V); - } - V=reverse(V); - Gap0=Gap=Arg=0; - if(type(Prec=getopt(prec))<0) - Level=0; - else if(Prec==0) Level=4; - else if(type(Prec)==1){ - Level=Prec; - if(Level<0){ - Level=-Level; - Gap0=1; - } - }else if(type(Prec)==4){ - Level=Prec[0]; - if(length(Prec)>1) Arg=Prec[1]; - if(length(Prec)>2) Gap0=Prec[2]; - } - if(Level>0){ - if(Level>16) Level=16; - if(Arg<=0) Arg=30; - else if(Arg>120) Arg=120; - Arg=Acc?eval(@pi*Arg/180):deval(@pi*Arg/180); - SL=dcos(Arg); - } - if(Gap0>0){ - if(Gap0<2) Gap0=16; - else if(Gap0>512) Gap0=512; - Gap=((MulX*(LX[1]-LX[0]))^2+(MulY*(LY[1]-LY[0]))^2)/(Gap0^2); - } - for(I=0;I<Level;I++){ - for(F=K=G=0,NV=NLT=[],PLT=LT,PV=V;PLT!=[];K++,PLT=cdr(PLT),PV=cdr(PV)){ - TG=0;D0=D1;CLT0=CLT;CV0=CV;CV=car(PV);CLT=car(PLT); - if(length(PV)>1){ - if((CV1=car(cdr(PV)))!=0 && CV!=0) - D1=[CV[0]-CV1[0],CV[1]-CV1[1]]; - else D1=0; - }else K=-1; /* ? */ - if(K>0 &&(((D1==0||D0==0)&&(CV0!=0||CV!=0||CV1!=0)) || dvangle(D0,D1)<SL || - (Gap>0 && type(D0)==4 && (TG=(D0[0]^2+D0[1]^2-Gap)>0)))){ - G++;T1=(CLT0+CLT)/2; - if(F==0 && (CV0!=0 || CV!=0)){ - if(myfdeval(Dn,T1)==0){ - NV=cons(0,NV); NLT=cons(T1,NLT); - } - if(Cpx>0||Acc){ - X=myfeval(F1,T1);Y=myfeval(F2,T1); - }else{ - X=myfdeval(F1,T1);Y=myfdeval(F2,T1); - } - if(K==1 && N1<0){ - NV=[];NLT=[]; - } - if((K>1||N1==0)&&(X<LX[0]||X>LX[1]||Y<LY[0]||Y>LY[1])){ - NV=cons(0,NV);NLT=cons(T1,NLT);F=0; - }else{ - NV=cons([MulX*(X-Orgx),MulY*(Y-Orgy)],NV);NLT=cons(T1,NLT); - } - } - NV=cons(CV,NV);NLT=cons(CLT,NLT); - if(!TG&&(CV0!=0||CV1!=0)){ - T2=(car(cdr(PLT))+CLT)/2; - if(myfdeval(Dn,T2)==0){ - NV=cons(0,NV); NLT=cons(CLT,NLT); - } - if(Cpx>0||Acc){ - X=myfeval(F1,T2);Y=myfeval(F2,T2); - }else{ - X=myfdeval(F1,T2);Y=myfdeval(F2,T2); - } - if((N1==0||length(PV)!=2)&&(X<LX[0]||X>LX[1]||Y<LY[0]||Y>LY[1])){ - NV=cons(0,NV);NLT=cons(T1,NLT); - }else{ - NV=cons([MulX*(X-Orgx),MulY*(Y-Orgy)],NV);NLT=cons(T2,NLT); - } - } - if(length(PV)==2 && N1==-1) break; - F=1; - }else{ - F=0;NV=cons(CV,NV);NLT=cons(CLT,NLT); - } - } - V=reverse(NV);LT=reverse(NLT); - if(G==0) break; - } - if(Gap>0){ - for(NV=[],PV=V;PV!=[];PV=cdr(PV)){ - NV=cons(P0=car(PV),NV); - if(length(PV)>1 && P0!=0 && PV[1]!=0 - && (P0[0]-PV[1][0])^2+(P0[1]-PV[1][1])^2>Gap) NV=cons(0,NV); - } - V=reverse(NV); - } - if((Raw=getopt(raw))==1) return V; - if(Raw==2) return [V,LT]; - OL=[["curve",1]];OLP=[]; - if(type(C=getopt(ratio))==1){ - OL=cons(["ratio",C],OL);OLP=cons(["ratio",C],OLP); - } - if(Acc==1) OL=cons(["Acc",1],OL); - if(N1<0) OL=cons(["close",-1],OL); - if(type(Opt=getopt(opt))!=7 && type(Opt)!=4){ - if(Opt==0) return xylines(V|option_list=cons(["opt",0],OL)); - } - OL=cons(["opt",(Proc)?0:Opt],OL); - if(type(Opt)>=0) OLP=cons(["opt",Opt],OLP); - if(type(Vb=getopt(verb))==1||type(Vb)==4){ - OL=cons(["verb",Vb],OL);OLP=cons(["verb",Vb],OL); - } - if(Proc){ - S=(Proc==1)? - [[0,[MulX*(LX[0]-Orgx),MulX*(LX[1]-Orgx)],[MulY*(LY[0]-Orgy),MulY*(LY[1]-Orgy)], - (TikZ)?1:1/10]]:[]; - S=cons([1,OLP,xylines(V|option_list=OL)],S); - if(Proc==3) return car(S); - }else S=xylines(V|option_list=OL); - if(type(Pt=getopt(pt))==4){ - if(type(Pt[0])!=4) Pt=[Pt]; - if(length(Pt)>1 && type(Pt[1])!=4) Pt=[Pt]; - for(PT=Pt;PT!=[];PT=cdr(PT)){ - PP=car(PT); - if(type(PP[0])!=4) PP=[PP]; - P=car(PP);PP=cdr(PP); - Qx=MulX*(P[0]-Orgx);Qy=MulY*(P[1]-Orgy); - if(length(PP)>0 && type(PP[0])==4){ /* draw line */ - P=car(PP); - Q1x=MulX*(P[0]-Orgx);Q1y=MulY*(P[1]-Orgy); - if(length(PP)<1 || car(PP)==0 || iand(car(PP),1)) - OL=["opt",(TikZ)?"-":"@{-}"]; - else OL=["opt",(TikZ)?".":"@{.}"]; - if(Proc) S=cons([1,OL,[[Qx,Qy],[Q1x,Q1y]]],S); - else S=S+xylines([[Qx,Qy],[Q1x,Q1y]]|optilon_list=OL); - continue; - } - if(length(PP)==0 || type(car(PP))!=7) SS="$\\bullet$"; - else SS=car(PP); - if(length(PP)<=1){ - if(Proc) S=cons([2,[],[Qx,Qy],[SS]],S); - else S=S+xyput([Qx,Qy,SS]); - }else{ - if(Proc) S=cons([2,[],[Qx,Qy],[[SS],"",PP[1]]],S); - S=S+xyput([Qx,Qy,SS,"",PP[1]]); - } - } - } - if(type(Ax=getopt(ax))==4){ /* draw axis */ - Adx0=Ady0=0; Adx1=Ady1=0.1; - if(!TikZ){ - if(!XYcm) Adx1=Ady1=1; - LOp="@{-}"; LxOp="+!U"; LyOp="+!R"; - }else{ - LOp="-"; LxOp="below"; LyOp="left"; - } - LOp0=LOp1=LOp; - LxOO=(Ax[1]==LY[0])?LxOp:(TikZ)?"below left":"+!UR"; - if(type(AxOp=getopt(axopt))>0){ - if(type(AxOp)==1){ - if(AxOp>0) Adx1=Ady1=AxOp; - else if(AxOp<0){ - Adx1=Ady1=0; Adx0=Ady0=AxOp; - } - }else if(type(AxOp)==4){ - if(type(T=car(AxOp))==4 && length(AxOp)>1){ - if(type(T)==7){ - LxOp=T; LyOp=AxOp[1]; - }else if(type(T)==4){ - Ay0=T[0]; Ay1=T[1]; Ax0=AxOp[1][0]; Ax1=AxOp[1][1]; - if(length(T)>2) LxOp=T[2]; - if(length(AxOp[1])>2) LyOp=AxOp[1][2]; - } - } - if(length(AxOp)>2 && type(AxOp[2])==7) LxOO=AxOp[2]; - if(length(AxOp)>3 && type(AxOp[3])==7) LOp0=AxOp[3]; - if(length(AxOp)>4 && type(AxOp[4])==7) LOp1=AxOp[4]; - } - if(type(AxOp)==7) LOp0=AxOp; - } - if(Ax[0]>=LX[0] && Ax[0]<=LX[1]){ /* draw marks on x-axis */ - if(Proc) S=cons([3,(type(LOp0)>=0)?[["opt",LOp0]]:[], - [MulX*(Ax[0]-Orgx),MulY*(LY[0]-Orgy)],[MulX*(Ax[0]-Orgx),MulY*(LY[1]-Orgy)]],S); - else S=S+xyarrow([MulX*(Ax[0]-Orgx),MulY*(LY[0]-Orgy)], - [MulX*(Ax[0]-Orgx),MulY*(LY[1]-Orgy)]|opt=LOp0); - if(length(Ax)>2){ - D=Ax[2]; - if(type(D)==1 && D>0){ - I0=ceil((LX[0]-Ax[0])/D); I1=floor((LX[1]-Ax[0])/D); - for(DD=[],I=I0; I<=I1; I++){ - if(length(Ax)<5) DD=cons(I*D,DD); - else if(Ax[4]==0) DD=cons([I*D,I*D+Ax[0]],DD); - else if(Ax[4]==1) DD=cons([I*D,I*D],DD); - else if(Ax[4]==2) DD=cons([I*D,I],DD); - } - D=DD; - } - if(type(D)==4){ - for(;D!=[]; D=cdr(D)){ - T=car(D); - if(type(T)==4) T=car(T); - X=MulX*(T+Ax[0]-Orgx); Y=MulY*(Ax[1]-Orgy); - if(T!=0){ - if(Proc) S=cons([3,(type(LOp1)>=0)?[["opt",LOp1]]:[],[X,Y+Ady0],[X,Y+Ady1]],S); - else S=S+xyarrow([X,Y+Ady0],[X,Y+Ady1]|opt=LOp1); - } - if(type(car(D))==4){ - Arg=[(T==0)?LxOO:LxOp,D[0][1]]; - if(Proc) S=cons([2,[],[X,Y+Ady0],[Arg]],S); - else S=S+xyput([X,Y+Ady0,Arg]); - } - } - } - } - } - if(Ax[1]>=LY[0] && Ax[1]<=LY[1]){ /* draw marks on y-axis */ - if(Proc) S=cons([3,[["opt",LOp0]], - [MulX*(LX[0]-Orgx),MulY*(Ax[1]-Orgy)], - [MulX*(LX[1]-Orgx),MulY*(Ax[1]-Orgy)]],S); - else S=S+xyarrow([MulX*(LX[0]-Orgx),MulY*(Ax[1]-Orgy)], - [MulX*(LX[1]-Orgx),MulY*(Ax[1]-Orgy)]|opt=LOp0); - if(length(Ax)>3){ - D=Ax[3]; - if(type(D)==1 && D>0){ - I0=ceil((LY[0]-Ax[1])/D); I1=floor((LY[1]-Ax[0])/D); - for(DD=[],I=I0; I<=I1; I++){ - if(length(Ax)<5) DD=cons(I*D,DD); - else if(I!=0){ - if(Ax[4]==0) DD=cons([I*D,I*D+Ax[1]],DD); - if(Ax[4]==1) DD=cons([I*D,I*D],DD); - if(Ax[4]==2) DD=cons([I*D,I],DD); - } - } - D=DD; - } - if(type(D)==4){ - for(;type(D)==4&&D!=[]; D=cdr(D)){ - T=car(D); - if(type(T)==4) T=car(T); - X=MulX*(Ax[0]-Orgx); Y=MulY*(T+Ax[1]-Orgy); - if(T!=0){ - if(Proc) S=cons([3,(type(LOp0)>=0)?[["opt",LOp1]]:[], - [X+Adx0,Y],[X+Adx1,Y]],S); - else S=S+xyarrow([X+Adx0,Y],[X+Adx1,Y]|opt=LOp1); - } - if(type(car(D))==4){ - if(Proc) S=cons([2,[],[X,Y+Ady0],[[LyOp,D[0][1]]]],S); - else S=S+xyput([X,Y+Ady0,[LyOp,D[0][1]]]); - } - } - } - } - } - } - if(Proc) return reverse(S); - if(getopt(dviout)!=1) return S; - xyproc(S|dviout=1); -} - -def xyarrow(P,Q) -{ - Cmd = ["fill","filldaw","shade","shadedraw","clip ","pattern","path ","node","coordinate"]; - if(type(P)<4) return "%\n"; - SS=getopt(opt); - if(!TikZ){ - if(type(Q)<4) return ""; - S="{"+xypos(P)+" \\ar"; - if(type(SS)==7) S=S+SS; - return S+" "+xypos(Q)+"};\n"; - } - if(type(SS)==4 && length(SS)>1){ - if(length(SS)>2) SU=SS[2]; - ST=SS[1]; - SS=SS[0]; - } - if(type(SS)!=7) SS="->"; - if(type(ST)!=7) ST=" -- "; - if(type(SU)!=7) SU=""; - if(type(S=getopt(cmd))==7) S="\\"+S; - else S="\\draw"; - if(type(Q)!=4){ - if(Q>0 && Q<=length(Cmd)) S="\\"+Cmd[Q-1]+""; - if(SS!="-") S=S+"["+SS+"]"; - if(SU!="") SU="["+SU+"]"; - return S+xypos(P)+ST+SU+";\n"; - } - if(SS!="-"&&SS!="") S=S+"["+SS+"]"; - if(length(P)<3 && length(Q)<3) - return S+xypos(P)+ST+xypos(Q)+SU+";\n"; - if(length(P)==2) P=[P[0],P[1],"","_0"]; - else if(length(P)==3 || (length(P)==4 && P[3]=="")) - P=[P[0],P[1],P[2],"_0"]; - else if(P[3]=="") - P=[P[0],P[1],P[2],"_0",P[4]]; - if(length(Q)==2) Q=[Q[0],Q[1],"","_1"]; - else if(length(Q)==3 || (length(Q)==4 && Q[3]=="")) - Q=[Q[0],Q[1],Q[2],"_1"]; - else if(Q[3]=="") - Q=[Q[0],Q[1],Q[2],"_1",Q[4]]; - return S+xypos(P)+" "+xypos(Q)+"("+P[3]+")"+ST+"("+Q[3]+")"+SU+";\n"; -} - -def xyarrows(P,Q,R) -{ - PQ=newvect(4); - PQ[0]=(type(P[0])!=4)?f2df(P[0]):P[0]; - PQ[1]=(type(P[1])!=4)?f2df(P[1]):P[1]; - PQ[2]=(type(Q[0])!=4)?f2df(Q[0]):Q[0]; - PQ[3]=(type(Q[1])!=4)?f2df(Q[1]):Q[1]; - if(type(R[0])!=4) R=[R]; - TR=R[0];NX=TR[2];X=X0=TR[0];DX=(TR[1]-TR[0])/NX; - if(length(R)==2){ - TR=R[1];NY=TR[2];Y=TR[0];DY=(TR[1]-TR[0])/NY; - }else{ - NY=1;Y=DY=0; - } - if(type(L=getopt(abs))!=1) L=0; - if(type(Sc=getopt(scale))!=1) Sc=0; - OL=[]; - if(type(Opt=getopt(opt))==7) OL=cons(["opt",Opt],OL); - Tb=str_tb(0,0); - for(J=0;J<NY;Y+=DY,J++){ - for(I=0,X=X0;I<NX;I++,X+=DX){ - PX=myf2eval(PQ[0],X,Y);PY=myf2eval(PQ[1],X,Y); - VX=myf2eval(PQ[2],X,Y);VY=myf2eval(PQ[3],X,Y); - if(L>0){ - C=dnorm([VX,VY]); - if(C!=0){ - VX*=L/C;VY*=L/C; - } - } - if(Sc){ - VX*=Sc;VY*=Sc; - } - if(VX||VY) str_tb(xyarrow([PX,PY],[PX+VX,PY+VY]|optilon_list=OL),Tb); - } - } - return str_tb(0,Tb); -} - -def polroots(L,V) -{ - INIT=1; - if(type(CF=getopt(comp))!=1) CF=0; - OL=getopt(); - if(CF>32){ - CF-=64; - INIT=0; - }else OL=cons(["comp",CF+64],delopt(OL,"comp")); - if(type(V)==4&&length(V)==1){ - L=L[0];V=V[0]; - } - Lim=Lim2=[]; - if(type(L)<4){ - if(type(Lim=getopt(lim))==4){ - if(type(Lim[0])!=4){ - if(!isvar(Lim[0])) Lim=cons(V,[Lim]); - Lim=[Lim]; - } - if(!isvar(Lim[0][0])) Lim=[cons(V,Lim)]; - Lim=delopt(Lim,V|inv=1); - if(Lim!=[]){ - Lim=Lim[0]; - if(length(Lim)==3) Lim2=Lim[2]; - Lim=Lim[1]; - } - }else{ - Lim=Lim2=[]; - } - if((CF==-2||CF==-1||CF==2)&&iscoef(L,os_md.israt)){ /* Rat+Comp, Rat+Real or Rat */ - S=(CF==-1)?getroot(L,V|cpx=1):getroot(L,V); - for(RR=[],F=x;S!=[];S=cdr(S)){ - if(findin(V,vars(C=car(S)))<0){ /* Rational solution */ - if(type(C)<2){ - if(Lim!=[]&&(real(C)<Lim[0]||real(C)>Lim[1])) continue; - if(Lim2!=[]&&(imag(C)<Lim2[0]||imag(C)>Lim2[1])) continue; - } - if(F!=C) RR=cons(F=C,RR); - }else if(CF<0){ /* Irrational solution */ - if((R=pari(roots,mysubst(C,[V,x])))!=0){ - for(R=vtol(R);R!=[];R=cdr(R)) - if((C=car(R))!=F && ntype(C)<CF+6){ - if(Lim!=[]&&(real(C)<Lim[0]||real(C)>Lim[1])) continue; - if(Lim2!=[]&&(imag(C)<Lim2[0]||imag(C)>Lim2[1])) continue; - RR=cons(F=C,RR); - } - } - } - } - return qsort(RR); - } - R=pari(roots,subst(L,V,x)); - if(R==0){ - R=[0]; - if(CF==1){ - for(R=[0],I=mydeg(L,V);I>1; I--) - R=cons(0,R); - } - return R; - } - if(CF==1){ /* Complex */ - if(Lim==[]&&Lim2==[]) return vtol(R); - for(L=[],I=length(R)-1;I>=0;I--){ - C=R[I]; - if(Lim!=[]&&(real(C)<Lim[0]||real(C)>Lim[1])) continue; - if(Lim2!=[]&&(imag(C)<Lim2[0]||imag(C)>Lim2[1])) continue; - L=cons(C,L); - } - return L; - } - for(L=[],F=x,I=length(R)-1;I>=0;I--){ /* Real */ - if(ntype(R[I])<4 && F!=R[I]){ - if(Lim!=[] && (R[I]<Lim[0]||R[I]>Lim[1])) continue; - L=cons(F=R[I],L); - } - } - return qsort(L); - } - if(SS==0&&INIT==1){ - SS=polroots(L,V|option_list=OL); - if(SS!=0) return SS; - for(C=0;SS==0&&C<5;C++){ - I=(C==0)?1:(iand(random(),0xff)-0x80); - for(LL=[],K=length(L)-1;K>=0;K--){ - for(Q=0,J=length(L)-1;J>=0;J--) - Q+=L[J]*(I+K)^J; - LL=cons(Q,LL); - } - SS=polroots(LL,V|option_list=OL); - if(SS!=0) return SS; - } - return SS; - } - C=2^(-32); - if(type(getopt(err))==1) C=err; - if((N=length(V))!=length(L)) return []; - if(N==1) return polroots(L[0],V[0]|option_list=OL); - for(L1=[],I=1;I<N;I++){ - Res=res(V[0],L[I-1],L[I]); - if(type(Res)<2) return Res; - L1=cons(res(V[0],L[I-1],L[I]),L1); - } - R=polroots(L1,V1=cdr(V)|option_list=OL); - if(type(R)<2) return R; - for(SS=[];R!=[];R=cdr(R)){ - RS=(N==2)?[car(R)]:car(R); - for(I=0,L0=L[0];I<N-1;I++) L0=mysubst(L0,[V1[I],RS[I]]); - if(L0==0) return 0; - S0=polroots(L0,V[0]|option_list=OL); - if(type(S0)<2) return S0; - for(S=S0;S!=[];S=cdr(S)){ - S0=cons(car(S),RS); - for(LT=cdr(L);LT!=[];LT=cdr(LT)){ - for(I=0,TV=car(LT);I<N;I++) TV=mysubst(TV,[V[I],S0[I]]); - if(abs(TV)>C) break; - } - if(LT==[]) SS=cons(S0,SS); - } - } - return reverse(SS); -} - -def ptcommon(X,Y) -{ - if(length(X)!=2 || length(Y)!=2) return 0; - if(type(X[1])==4){ /* X is a line */ - if((In=getopt(in))==-1||In==-2||In==-3){ - X0=(X[0][0]+X[1][0])/2;X1=(X[0][1]+X[1][1])/2; - X=[[X0,X1],[X0+X[1][1]-X[0][1],X1-X[1][0]+X[0][0]]]; - if(In==-1&&type(Y[1])==4) return ptcommon(Y,X|in=-2); - /* for the second line */ - if(In==-3) In=1; - else In=0; - }else if(In==2||In==3){ - X=(X[1][0]-X[0][0])+(X[1][1]-X[0][1])*@i; - if(X==0) return 0; - Y=(Y[1][0]-Y[0][0])+(Y[1][1]-Y[0][1])*@i; - X=myarg(Y/X); - return (In==2)?X:(X*180/deval(@pi)); - }else if(In!=1) In=0; - if(type(Y[0])<=3){ - if(In==1){ - return [(Y[1]*X[0][0]+Y[0]*X[1][0])/(Y[0]+Y[1]), - (Y[1]*X[0][1]+Y[0]*X[1][1])/(Y[0]+Y[1])]; - } - XX=X[1][0]-X[0][0];YY=X[1][1]-X[0][1]; - Arg=(length(Y)<2)?0:Y[1]; - Arg=deval(Arg); - if(Arg!=0){ - S=dcos(Arg)*XX-dsin(Arg)*YY; - YY=dsin(Arg)*XX+dcos(Arg)*YY; - XX=S; - } - S=dnorm([XX,YY]); - if(S!=0){ - XX*=Y[0]/S;YY*=Y[0]/S; - } - return [X[1][0]+XX,X[1][1]+YY]; - } - S=[X[0][0]+(X[1][0]-X[0][0])*x_,X[0][1]+(X[1][1]-X[0][1])*x_]; - if(type(Y[1])==4){ /* Y is a line */ - T=[Y[0][0]+(Y[1][0]-Y[0][0])*y_-S[0], - Y[0][1]+(Y[1][1]-Y[0][1])*y_-S[1]]; - R=lsol(T,[x_,y_]); - if(type(R[0])==4&&type(R[1])==4&&R[0][0]==x_&&R[1][0]==y_){ - if(!In || (R[0][1]>=0&&R[0][1]<=1&&R[1][1]>=0&&R[1][1]<=1) ) - return subst(S,x_,R[0][1],y_,R[1][1]); - } - if((type(R[0])>0&&type(R[0])<4)||(type(R[1])>0&&type(R[1])<4)) return 0; - if(!In) return 1; - I=(X[0][0]==X[1][0]&&Y[0][0]==Y[1][0]&&X[0][0]==Y[0][0])?1:0; - if(X[0][I]<=X[1][I]){ - X0=X[0][I];X1=X[1][I]; - }else{ - X1=X[0][I];X0=X[1][I]; - } - return ((Y[0][I]<X0 && Y[1][I]<X0)||(Y[0][I]>X1&&Y[1][I]>X1))?0:1; - }else if(Y[1]==0){ /* orth */ - T=[Y[0][0]+(X[1][1]-X[0][1])*y_-S[0], - Y[0][1]-(X[1][0]-X[0][0])*y_-S[1]]; - R=lsol(T,[x_,y_]); - if(type(R[0])==4&&type(R[1])==4&&R[0][0]==x_&&R[1][0]==y_){ - if(!In||(R[0][1]>=0&&R[0][1]<=1)) - return subst(S,x_,R[0][1],y_,R[1][1]); - } - return (X[0]==X[1])?0:1; - }else if(type(Y[1])==1 && Y[1]>0){ /* circle */ - T=(S[0]-Y[0][0])^2+(S[1]-Y[0][1])^2-Y[1]^2; - D=mycoef(T,1,x_)^2-4*mycoef(T,0,x_)*mycoef(T,2,x_); - if(D==0){ - V=mycoef(T,1,x_)/(2*mycoef(T,2,x_)); - if(!in||(V>=0&&V<=1)) return [subst(S,x_,V)]; - } - else if((type(D)==1&&D>0)){ - D=dsqrt(D); - V=-(mycoef(T,1,x_)+D)/(2*mycoef(T,2,x_)); - if(!In||(V>=0&&V<=1)) L=[subst(S,x_,V)]; - else L=[]; - V=(D-mycoef(T,1,x_))/(2*mycoef(T,2,x_)); - if(!In||(V>=0&&V<=1)) L=cons(subst(S,x_,V),L); - if(length(L)>0) return L; - } - } - return 0; - } - if(type(Y[1])==4 || X[1]==0) return ptcommon(Y,X); - /* X is a circle */ - if(Y[1]==0){ /* tangent line */ - if(Y[0][0]==X[0][0]+X[1] || Y[0][0]==X[0][0]-X[1]) L=[[Y[0][0],X[0][1]]]; - else L=[]; - P=(Y[0][0]+x_-X[0][0])^2+(Y[0][1]+x_*y_-X[0][1])^2-X[1]^2; - Q=mycoef(P,1,x_)^2-4*mycoef(P,2,x_)*mycoef(P,0,x_); - for(R=polroots(Q,y_);R!=[];R=cdr(R)){ - X0=-subst(mycoef(P,1,x_)/(2*mycoef(P,2,x_)),y_,car(R)); - L=cons([Y[0][0]+X0,Y[0][1]+car(R)*X0],L); - } - }else{ /* Y is a circle */ - P=(x_-X[0][0])^2+(y_-X[0][1])^2-X[1]^2; - Q=(x_-Y[0][0])^2+(y_-Y[0][1])^2-Y[1]^2; - V=(X[0][0]!=Y[0][0])?[x_,y_]:[y_,x_]; - R=subst(P,V[0],T=lsol(P-Q,V[0])); - if(type(T[0])<4) return (T[0]==0)?1:0; - S=polroots(R,V[1]); - for(L=[];S!=[];S=cdr(S)){ - R=subst(T,V[1],car(S)); - if(V[0]==x_) L=cons([R,car(S)],L); - else L=cons([S,R],L); - } - } - if(length(L)!=0) return L; - return 0; -} - -def tobezier(L) -{ - if((Div=getopt(div))==1||Div==2){ - if(length(L)!=4) return [tobezier(L|inv=[0,1/2]),tobezier(L|inv=[1/2,1])]; - if(type(L)==4) L=ltov(L); - if(type(L[0])==4) - L=[ltov(L[0]),ltov(L[1]),ltov(L[2]),ltov(L[3])]; - S=[(L[0]+3*L[1]+3*L[2]+L[3])/8]; - T=[L[3]]; - S=cons((L[0]+2*L[1]+L[2])/4,S); - T=cons((L[2]+L[3])/2,T); - S=cons((L[0]+L[1])/2,S); - T=cons((L[1]+2*L[2]+L[3])/4,T); - S=cons(L[0],S); - T=cons((L[0]+3*L[1]+3*L[2]+L[3])/8,T); - return [S,T]; - } - if(Div>2&&Div<257){ - L=tobezier(L); - for(R=[],I=Div-1;I>=0;I--) - R=cons(tobezier(L|inv=[I/Div,(I+1)/Div]),R); - return R; - } - if((V=getopt(inv))==1 || type(V)>3){ - if(type(L[0])>3 && type(V)>3) L=tobezier(L); - if(type(V)>3 && length(V)>2) V2=V[2]; - if(type(V2)!=2) V2=t; - if(type(V)>3) L=subst(L,V2,(V[1]-V[0])*V2+V[0]); - N=mydeg(L,V2); - for(R=[],I=0;I<=N;I++){ - RT=mycoef(L,I,V2); - R=cons(RT/binom(N,I),R); - L-=RT*V2^I*(1-V2)^(N-I); - } - return reverse(R); - }; - N=length(L)-1; - V=newvect(2); - for(I=0;I<=N;I++,L=cdr(L)){ - if(type(X=car(L))==4) X=ltov(X); - V+=X*binom(N,I)*t^I*(1-t)^(N-I); - } - return V; -} - -def cutf(F,X,VV) -{ - if(type(car(V=VV))==2){ - Y=[car(V),X]; - V=cdr(V); - }else Y=X; - if(type(X)>1){ - Y=(type(Y)==4)?Y[0]:x; - V1=makenewv(F); - if(X==Y||Y==x){ - V2=makenewv([F,V1]); - F=mysubst(F,[Y,V2]); - V=cons(V2,V); - } - return [V1,[V1,os_md.cutf,[F],X,[V]]]; - } - if(car(V)!=[] && X<car(V)[0]) return myfeval(car(V)[1],Y); - for(V=cdr(V); ;V=R){ - if((R=cdr(V))==[]){ - if(car(V)!=[] && car(V)[0]<X) return myfeval(car(V)[1],Y); - return myfeval(F,Y); - } - if(car(V)==[]||X>car(V)[0]) continue; - if(X==car(V)[0]) return car(V)[1]; - return myfeval(F,Y); - } -} - -def fsum(F,L) -{ - if(getopt(df)==1){ - F=f2df(F); - }else Sub=getopt(subst); - if(type(L[0])==2){ - X=L[0]; - L=cdr(L); - }else X=0; - V=(length(L)>2)?L[2]:1; - for(R=0,I=L[0];;I+=V){ - if(V==0||(I-L[1])*V>0) return R; - R+=(Sub==1)?subst(F,X?X:x,I):os_md.myfeval(F,X?[X,I]:I); - } -} - -def periodicf(F,L,X) -{ - if(type(L)==4) L=[eval(L[0]),eval(L[1])]; - else L=eval(L); - if(isvar(X)){ - Y=makenewv([X,F]); - Z=makenewv([X,Y,F]); - return [Z,[Z,os_md.periodicf,[mysubst(F,[x,Y])],(type(L)==4)?[L]:L,[[Y,X]]]]; - } - if(type(X)==4){ - V=X[0]; - X=X[1]; - }else V=x; - if(type(F)==5){ - X=eval(X); - return myfeval(F[floor(X/L)%length(F)],[V,X-floor(X/L)*L]); - } - if(type(L)==4){ - X-=floor((X-L[0])/(L[1]-L[0]))*(L[1]-L[0]); - return myfeval(F,[V,X]); - } -} - -def cmpf(X) -{ - if(type(X)>3){ - if(type(L)==7) return [S_Fc,Dx,S_Ic,S_Ec,S_EC,S_Lc]; - S_Lc=0; - if(type(S_Fc=X[0])!=4) S_Fc=f2df(S_Fc); - S_Ic=X[1]; - if(length(S_Ic)>2){ - S_Fc=mysubst(S_Fc,[S_Ic[0],x]); - S_Ic=cdr(S_Ic); - } - S_Dc=(type(S_Ic[0])==7)?1:0; - if(type(S_Ic[1])==7) S_Dc=ior(S_Dc,2); - if(type(S_Ec=getopt(exp))!=1) S_Ec=0; - if(S_Ec<=0){ - S_EC=-S_Ec; - if(S_EC==0) S_EC=1; - if(S_Dc==3) S_EC*=2; - else S_EC/=4; - if(type(F=X[0])==3&&vars(F)==[x]&&(D=deg(nm(F),x))==deg(dn(F),x)-2){ - S_Lc=S_EC*coef(nm(F),D,x)/coef(dn(F),D+2,x); - } - }else{ - S_EC=S_Ec; - if(S_Dc==3) S_EC*=12; - else S_EC/=6; - } - if(type(S_Fc)==3) S_Fc=red(S_Fc); - S_EC=1/S_EC; - return [z_,[z_,os_md.cmpf,x]]; - } - if(X<=0 && iand(S_Dc,1)) return S_Lc; - if(X>=1 && iand(S_Dc,2)) return S_Lc; - if(S_Dc==3){ - if(S_Ec>0){ - Y0=dexp(1/X)*S_EC; - Y1=dexp(1/(1-X))*S_EC; - return myfeval(S_Fc,Y1-Y0)*(Y0/X^2+Y1/(1-X)^2); - } - return myfeval(S_Fc,S_EC/(1-X)-S_EC/X)*(S_EC/(1-X)^2+S_EC/X^2); - } - if(S_Dc==1){ - if(S_Ec>0){ - Y=dexp(1-1/X); - R=myfeval(S_Fc,S_EC*(Y-1)+I[1])*Y; - } - else R=myfeval(S_Fc,I[1]+(1-1/X)*S_EC); - return R*S_EC/X^2; - } - if(S_Dc==2){ - if(S_Ec>0){ - Y=dexp(X/(1-X)); - R=myfeval(S_Fc,S_EC*(Y-1)+S_Ic[0])*Y; - }else R=myfeval(S_Fc,S_EC*X/(1-X)+S_Ic[0]); - return R*S_EC/(1-X)^2; - } - X=S_Ic[0]+(S_Ic[1]-S_Ic[0])*X; - return myfeval(S_Fc,X)/(S_Ic[1]-Ic[0]); -} - -def fresidue(P,Q) -{ - if(iscoef(Q,os_md.israt)) S=fctr(Q); - else S=[[Q,1]]; - for(R=[];S!=[];S=cdr(S)){ - T=car(S); - if((D=mydeg(T[0],z))==0) continue; - L=[]; - if(iscoef(T[0],os_md.iscrat)) L=getroot(T[0],z|cpx=2); - if(findin(z,vars(L))>=0) L=[]; - if(L==[]) L=polroots(T[0],z|comp=-1); - for(;L!=[];L=cdr(L)){ - QQ=Q; - for(I=T[1]; I>1;I--) QQ=mydiff(QQ,z); - for(U=0,W=I=T[1];I>0;I--,W++){ - QQ=diff(QQ,z); - U+=subst(QQ,z,L[0])*(z-L[0])^(W-T[1])/fac(W); - } - UD=mydiff(U,z); - for(I=T[1],K=1,PP=P; I>1;I--,K++) - PP=diff(PP,z)*U-K*PP*UD; - QQ=subst(PP,z,L[0])/subst(U,z,L[0])^K; -/* if(D==2) QQ=sqrt2rat(QQ); */ - R=cons([L[0],sqrt2rat(QQ)],R); - } - } - if(type(L=getopt(cond))==4){ - for(S=[];R!=[];R=cdr(R)){ - Z=car(R); - for(LL=L;LL!=[];LL=cdr(LL)){ - X=real(car(Z));Y=imag(car(Z)); - if(myf3eval(car(LL),X,Y,car(Z))<=0) break; - } - if(LL==[]) S=cons(Z,S); - } - R=reverse(S); - } - if((Sum=getopt(sum))==1||Sum==2){ - for(S=0;R!=[];R=cdr(R)) S+=car(R)[1]; - if(Sum==2) S*=2*@pi*@i; - return sqrt2rat(S); - } - return R; -} - -def fint(F,D,V) -{ - if(((L=length(V))==2 || (L==3&&isvar(V[0])<3)) - && (type(V[L-1])==7||(type(V[L-1])<3&&type(eval(V[L-1]))<2))) - /* real integral */ - return areabezier([F,D,V]|option_list=getopt()); - /* complex integral */ - if(L>1&&type(V[1])==4&&type(V[1][1])<4){ - if(type(V[0])==4&&type(V[0][0])<2){ - for(R=[],VT=car(V),VV=cdr(V);VV!=[];VV=cdr(VV),VT=VU){ - if((VU=car(VV))==-1) VU=car(V); - R=cons([ptcommon([VT,VU],[t,1-t]|in=1),[0,1]],R); - } - V=reverse(R); - } - else if(L==2) V=[V]; - } - Opt=cons(["cpx",1],getopt()); - for(R=0;V!=[];V=cdr(V)){ - VT=car(V); - X=car(VT)[0];XD=red(diff(X,t)); - Y=car(VT)[1];YD=red(diff(Y,t)); - F=mysubst(F,[[x,X],[y,Y],[z,X+@i*Y]]); - if(type(F)==4) - FF=cons(F[0]*(XD+@i*YD),cdr(F)); - else FF=red(F*(XD+@i*YD)); - R+=areabezier([FF,D,cons(t,VT[1])]|option_list=Opt); - } - return R; -} - -def areabezier(V) -{ - if(getopt(cpx)==1){ - Opt=delopt(getopt(),"cpx"); - F=V[0]; - if(!isvar(Var=V[2][0])) Var=x; - if(type(F)==3 && vars(F)==[Var] && imag(dn(F))!=0){ - F=(nm(F)*conj(dn(F)))/(dn(F)*conj(dn(F))); - V0=red(real(nm(F))/dn(F)); - R=areabezier([V0,V[1],V[2]]|option_list=Opt); - V0=red(imag(nm(F))/dn(F)); - return R+@i*areabezier([V0,V[1],V[2]]|option_list=Opt); - } - if(getopt(Acc)!=1) F=f2df(F); - V0=compdf([o,[o,real,o_]],o_,F); - R=areabezier([V0,V[1],V[2]]|option_list=Opt); - V0=compdf([o,[o,imag,o_]],o_,F); - return R+@i*areabezier([V0,V[1],V[2]]|option_list=Opt); - } - if(type(V[0])!=4 || vars(V[0][0])!=0){ - Mx=[-2.0^(512),2.0^(512)]; - I=length(V[2]); - if(type(V[2][I-1])==7||type(V[2][I-2])==7){ /* infinite interval */ - if(type(Ec=getopt(exp))==1) R=cmpf([V[0],V[2]]|exp=Ec); - else R=cmpf([V[0],V[2]]); - V=[R,V[1],[0,1]]; - } - if(type((Int=getopt(int)))==1 && type(V[0])<4 && (V1=V[1])>=0){ - if(Int==2&&iand(V1,1)) V1++; - if(!V1) V1=32; - Opt=cons(["raw",1],getopt()); - W=xygraph(V[0],V[1],V[2],Mx,Mx|option_list=Opt); - SS=W[0][1]; - for(S0=S1=0,I=0,L=W;L!=[] && I<=V1;I++, L=cdr(L)){ - if(iand(I,1)) S1+=car(L)[1]; - else S0+=car(L)[1]; - if (I==V1) SS+=car(L)[1]; - } - VV=deval(V[2][1]-V[2][0]); - if(Int==2) - return (2*S0+4*S1-SS)*VV/(3*V1); - else - return (2*S0+2*S1-SS)*VV/(2*V1); - } - Opt=cons(["opt",0],getopt()); - V=xygraph(V[0],V[1],V[2],Mx,Mx|option_list=Opt); - } - if(type(V[0][0])!=4) V=os_md.lbezier(V); - for(S=0; V!=[]; V=cdr(V)){ - B=tobezier(car(V)); - P=intpoly(B[1]*diff(B[0],t),t); - S+=mysubst(P,[t,1]); - } - return S; -} - -def velbezier(V,L) -{ - if(L==0) L=[t,0,1]; - else L=[(length(L)==3)?L[2]:t,L[0],L[1]]; - for(R=[],II=length(V)-1;II>=0;II--){ - S=fmmx(diff(V[II],L[0]|dif=1),L|dif=1); - for(U=0;S!=[];S=cdr(S)) if((T=abs(car(S)[1]))>U) U=T; - R=cons(U,R); - } - return R; -} - -def ptbezier(V,L) -{ - if(type(V[0])==4&&type(V[0][0])!=4) V=lbezier(V); - K=length(V); - if(type(L)<2){ - if(L<0) return K; - if(L>=K-1) L=[K-1,1]; - else{ - L0=floor(L); - if(L0>=K-1) L0=K-1; - L=[L0,L-L0]; - } - } - if(L[0]>=0) B=V[L[0]]; - else B=V[K+L[0]]; - B=tobezier(B); - BB=[diff(B[0],t),diff(B[1],t)]; - return [subst(B,t,L[1]),subst(BB,t,L[1])]; -} - -def ptcombezier(P,Q,T) -{ - if(type(T)<2){ - if(T<2) T=20; /* default */ - return ptcombezier(P,Q,[0,0,1,T]); - } - V=T[2]/2;; - PB=tobezier(P|div=1); - PP=[ptbbox(PB[0]),ptbbox(PB[1])]; - QB=tobezier(Q|div=1); - QQ=[ptbbox(QB[0]),ptbbox(QB[1])]; - for(L=[],I=0;I<2;I++){ - for(J=0;J<2;J++){ - if(!iscombox(PP[I],QQ[J])) continue; - if(T[3]<=1) return - [[T[0]+(I+0.5)*V,T[1]+(J+0.5)*V, - [(PP[I][0][0]+PP[I][0][1])/2,(PP[I][1][0]+PP[I][1][1])/2]]]; - else{ -#if 0 - U=PB[I][0];V=PB[I][length(PB[I])-1]; - if(abs(A=(U[0]-V[0]))>abs(B=(U[1]-V[I]))) - M=mat([1,0],[-B/A,1]); - else if(U!=V) - M=mat([1,-A/B],[0,1]); - else continue; - if(!iscombox(ptbox(ptaffine(M,PB[I])),ptbox(ptaffine(M,QB[J])))) continue; -#endif - - LN=ptcombezier(PB[I],QB[J],[T[0]+I*V,T[1]+J*V,V,T[3]-1]); -#if 0 - L=append(LN,L); -#else - if(LN!=[]){ - if(L==[]) L=LN; - else for(VV=3*V/2^T[3];LN!=[];LN=cdr(LN)){ - for(LT=L;LT!=[];LT=cdr(LT)){ - if(abs(car(LN)[0]-car(LT)[0])<VV&&abs(car(LN)[1]-car(LT)[1])<VV) break; - } - } - } - if(length(L)>32){ /* Too many points */ - I=J=2; - } -#endif - } - } - } - return L; -} - - -def ptcombz(P,Q,T) -{ - if(P==Q) Q=0; - if(type(P[0][0])!=4) P=P0=lbezier(P); - if(Q==0){ - Q=P;F=1; - } - else if(type(Q[0][0])!=4) Q=lbezier(Q); - for(R=[],I=0,Q0=Q;P!=[];P=cdr(P),I++){ - for(J=0,Q=Q0;Q!=[];Q=cdr(Q),J++){ - if(F==1&&I<J+2) break; - if((RT=ptcombezier(car(P),car(Q),T))!=[]){ - RT=cons([I,J],RT); - R=cons(RT,R); - } - } - } - if((Red=getopt(red))==1||Red==2){ - if(type(M=getopt(prec))!=1) M=12; - for(F=0,T=P0;T!=[];T=cdr(T)){ - for(S=car(T);S!=[];S=cdr(S)){ - if(type(ST=car(S))==4 && type(ST[0])<2){ - if(F++==0){ - X0=X1=ST[0];Y0=Y1=ST[1]; - }else{ - if(ST[0]<X0) X0=ST[0]; - if(ST[0]>X1) X1=ST[0]; - if(ST[1]<Y0) Y0=ST[1]; - if(ST[1]>Y1) Y1=ST[1]; - } - } - } - } - V0=(X1-X0)/2^M;V1=(Y1-Y2)/2^M; - for(RR=[],RT=R;RT!=[];RT=cdr(RT)) - for(S=cdr(car(RT));S!=[];S=cdr(S)) RR=cons(car(S)[2],RR); - RR=ltov(RR);L=length(RR); - for(I=0;I<L;I++) - for(K=1,J=I+1;K!=0&&J<L;J++) - if(abs(RR[I][0]-RR[J][0])<V0 && abs(RR[I][1]-RR[J][1])<V1) RR[I]=K=0; - R0=[]; - I=L-1; - if(Red==2){ - for(;I>=0;I--) if(RR[I]!=0) R0=cons(RR[I],R0); - }else{ - for(RT=R;RT!=[];RT=cdr(RT)){ - R00=[car(RT)[0]]; - for(S=cdr(car(RT));S!=[];S=cdr(S),I--) - if(RR[L-I-1]!=0) R00=cons(car(S),R00); - if(length(R00)>1) R0=cons(reverse(R00),R0); - } - } - return R0; - } - return reverse(R); -} - -def draw_bezier(ID,IDX,B) -{ - if(getopt(init)==1){ - S_FDot=0; - return; - } - if(type(Col=getopt(col))!=1&&Col!=0) Col=0; - Dot=0; - if(type(Opt=getopt(opt))==7){ - if(!Col){ - Col=drawopt(Opt,0); - if(Col==-1) Col=0; - } - T=drawopt(Opt,3); - if(iand(T,2)){ - M=iand(T,1)?1/8:1/4; - for(C=Col,Col=I=0;I<20;I+=8) - Col+=ishift(0xff-(floor((0xff-iand(0xff,ishift(C,I)))*M)),-I); - } - if(iand(T,4)) Dot=2; /* 2 or 3 or 4 or 6 */ - else if(iand(T,8)) Dot=4; - } - if(type(B)==4 && (type(B[0])==4||type(B[0])==5) && type(B[0][0])<2) B=lbezier(B); - else if(type(B)==5) B=[vtol(B)]; - for(;B!=[];B=cdr(B)){ - if(vars(F=car(B))==[]){ -#if 1 - if(length(F)<3&&!Dot){ /* line or point */ - if(length(F)>0){ - G=[rint(F[0][0]),rint(F[0][1])]; - if(length(F)==1) draw_obj(ID,IDX,G,Col); - else{ - G=[G[0],G[1],rint(F[1][0]),rint(F[1][1])]; - draw_obj(ID,IDX,G,Col); - } - } - continue; - } -#endif - if(length(F)<2) continue; - F=tobezier(F); - } - N=velbezier(F,0); - N=(N[0]>N[1])?N[0]:N[1]; - if(!N) N=1; - for(I=0;I<=N;I++,S_FDot++){ - if(Dot!=iand(S_FDot,Dot)) continue; - G=subst(F,t,I/N); - G=[rint(G[0]),rint(G[1])]; - if(G!=G0){ - draw_obj(ID,IDX,G,Col); - G0=G; - } - } - } - if(S_FDot-->=2^32) S_FDot=0; - return 0; -} - -def lbezier(L) -{ - if((In=getopt(inv))==1||In==2||In==3){ - for(F=0,R=[];L!=[];L=cdr(L)){ - LT=car(L); - if(F==car(LT)) R=cons(1,R); - else{ - if(R!=[]&&F!=0) R=cons(0,R); - R=cons(G=car(LT),R); - if(In==3) In==2; - } - for(LT=cdr(LT);LT!=[];LT=cdr(LT)) - R=cons(car(LT),R); - if((F=car(R))==G&&In==1){ - R=cons(-1,cdr(R)); - F=0; - } - } - if(In==3 && car(R)==G) R=cons(-1,cdr(R)); - return reverse(R); - } - for(F=0,RT=R=[];L!=[];L=cdr(L)){ - if(type(T=car(L))==4||type(T)==5){ - if(F==0){ - FT=T;F=1; - } - RT=cons(T,RT); - }else if(T==0){ - if(RT==[]) R=cons(reverse(RT),R); - RT=[];F=0; - }else if(T==1){ - if(RT!=[]){ - R=cons(reverse(RT),R); - RT=[car(RT)]; - }else{ - RT=[];F=0; - } - }else if(T==-1){ - RT=cons(FT,RT); - R=cons(reverse(RT),R); - RT=[];F=0; - } - } - if(RT!=[]) R=cons(reverse(RT),R); - return reverse(R); -} - - -def xybezier(L) -{ - if(L==0 || (LS=length(L))==0) return ""; - Out=str_tb(0,0); - if(type(VF=getopt(verb))==4){ - if(type(car(VF))>3){ - VFS=VF;VF=1; - }else{ - VFS=cdr(VF);VF=car(VF); - } - }else VFS=["$\\bullet$","$\\times$"]; - if(VF!=1 && VF!=2) VF=0; - if(!TikZ){ - if(VF) Ob=str_tb(0,0); - T="\n**\\crv{"; - if(type(Opt=getopt(opt))==7 && Opt!="") T=T+Opt; - L00=Q=L[I0=0];S=S1=""; - for(F=0,I=1;I<=LS;I++){ - P=Q;Q=(I==LS)?0:L[I]; - if(type(Q)==4){ - if(F==0){ - S1="";L0=P;F=1; - continue; - }else if(F==1) - F=2; - else if(F==2){ - S1=S1+"&"; - } - S1=S1+xypos(P); - if(VF&&length(VFS)>1) str_tb(xyput([P[0],P[1],VFS[1]]),Ob); - }else{ - if(Q==0){ - if(F>0){ - str_tb("{"+xypos(L0)+";"+xypos(P)+T+S1+"}};\n",Out); - if(VF){ - str_tb(xyput([L[0][0],L[0][1],VFS[0]]),Ob); - if(VF==1) str_tb(xyput([P[0],P[1],VFS[0]]),Ob); - } - F=0; - } - }else if(Q==1){ - str_tb("{"+xypos(L0)+";"+xypos(P)+T+S1+"}};\n",Out); - if(VF){ - str_tb(xyput([L[0][0],L[0][1],VFS[0]]),Ob); - if(VF==1) str_tb(xyput([P[0],P[1],VFS[0]]),Ob); - } - F=1; - }else if(Q==-1){ - if(F==2) - S1=S1+"&"; - str_tb("{"+xypos(L0)+";"+xypos(L00)+T+S1+xypos(P)+"}};\n",Out); - if(VF) str_tb(xyput([L[0][0],L[0][1],VFS[0]]),Ob); - F=0; - } - if(F==1){ - if(I<LS-1 && type(L[I+1])<2){ - if(L[I+1]==-1){ - str_tb("{"+xypos(P)+";"+xypos(L00)+T+"}};\n",Out); - } - if(VF) str_tb(xyput([P[0][0],P[0][1],VFS[0]]),Ob); - F=0; - } - } - while(++I<LS && type(L[I])<2); - if(I>=LS) break; - if(F==1){ - Q=P;I--;F=0; - }else L00=Q=L[I]; - } - } - }else{ - if(type(T=getopt(cmd))==7){ - if(T!="") T="\\"+T; - }else T="\\draw"; - if((Rel=getopt(relative))==1) VF=0; - if(VF) Ob=str_tb(0,0); - if(type(Opt=getopt(opt))==7 && Opt!="") T=T+"["+Opt+"]"; - Out=str_tb(T,0); - Q=L[0]; - for(F=M=0,I=1;I<=LS;I++){ - P=Q; Q=(I==LS)?0:L[I]; - if(++M>XYLim){ - str_tb("\n",Out);M=1; - } - if(type(Q)==4 || type(Q)==5 || type(Q)==7){ - if(F==0){ - str_tb(" ",Out); - F=1; - }else if(F==1){ - str_tb(" .. controls ",Out); - F=2; - }else if(F==2){ - str_tb(" and ",Out); - F=2; - } - PP=xypos(P); - if(Rel==1 && F==2) PP="+"+PP; - str_tb(PP,Out); - if(VF&&((F<2)||length(VFS)>1)) - str_tb(xyput([P[0],P[1],(F<2)?VFS[0]:VFS[1]]),Ob); - }else{ -/* if(I<LS-1) VF=0; */ - if(Q==0||Q==1){ - PP=xypos(P); - if(Rel==1) PP="+"+PP; - str_tb(((F==0)?" ":((F==1)?" -- ":" .. "))+PP,Out); - if(VF) str_tb(xyput([P[0],P[1],VFS[0]]),Ob); - F=Q; - }else if(Q==-1){ - PP=xypos(P); - if(Rel==1) PP="+"+PP; - if(F==1) - str_tb("..controls "+PP+" .. cycle",Out); - else if(F==2) - str_tb(" and "+PP+" .. cycle",Out); - if(VF&&length(VFS)>1) str_tb(xyput([P[0],P[1],VFS[1]]),Ob); - F=0; - } - if(F==1){ - if(I<LS-1){ - if(L[I+1]==-1){ - str_tb(" -- cycle",Out); - I=I+1; - F=0; - } - else if(type(L[I+1])<2) F=0; - } - } - while(++I<LS && type(L[I])<2); - if(I>=LS) break; - Q=L[I]; - } - } - str_tb(";\n",Out); - } - if(VF) str_tb(str_tb(0,Ob),Out); - return str_tb(0,Out); -} - -def xybox(L) -{ - K=length(L); - P=L[0];Q=L[1]; - if(K==2) - LL=[ P, [P[0],Q[1]], Q, [Q[0],P[1]] ]; - else{ - R=L[2]; - LL=[ P, R, Q, [P[0]+Q[0]-R[0],P[1]+Q[1]-R[1]] ]; - } - Opt=getopt(); - SS=getopt(opt); - FL=getopt(color); - if(TikZ&&type(SS)<1&&K==2){ - if(type(FL)==4){ - F=FL[0]; - if(length(FL)>1) CMD=FL[1]; - }else if(type(FL)==7) F=FL; - else F=""; - F=cons(F,["rectangle"]); - if(CMD) return xyarrow(P,Q|opt=F,cmd=CMD); - else return xyarrow(P,Q|opt=F); - } - if(type(SS)!=7&&!TikZ) Opt=cons(["opt","@{-}"],Opt); - Opt=cons(["close",1],Opt); - return xylines(LL|option_list=Opt); -} - -def xyang(S,P,Q,R) -{ - Opt=getopt(); - if(type(Prec=getopt(prec))!=1) Prec=0; - if(type(Q)>2){ - if(R==1||R==-1){ /* ’¼Šp */ - P1=ptcommon([Q,P],[-S,0]); - S*=R; - P2=ptcommon([P,P1],[S,@pi/2]); - P3=ptcommon([P1,P2],[S,@pi/2]); - return xylines([P1,P2,P3]|option_list=Opt); - }else if((AR=abs(R))==0||AR==2||AR==3||AR==4){ /* –îˆó */ - Ang=myarg([Q[0]-P[0],Q[1]-P[1]]); - if(R<0) Ang+=3.14159; - ANG=[0.7854,0.5236,1.0472]; - X=(AR==0)?1.5708:ANG[AR-2]; - U=[P[0]+S*dcos(Ang+X),P[1]+S*dsin(Ang+X)]; - V=[P[0]+S*dcos(Ang-X),P[1]+S*dsin(Ang-X)]; /* –îæ */ - V=(X==0)?[U,V]:[U,P,V]; - if(getopt(ar)==1) V=append([Q,P,0],V); /* S–_ */ - return xylines(V|option_list=Opt); - }else if(AR>4&&AR<9){ - Ang=myarg([Q[0]-P[0],Q[1]-P[1]]); - ANG=[0.7854,0.5236,0.3927,0.2618]; - X=ANG[AR-5]; - U=[P[0]+S*dcos(Ang+X),P[1]+S*dsin(Ang+X)]; - V=[P[0]+S*dcos(Ang-X),P[1]+S*dsin(Ang-X)]; - W=ptcommon([P,U],[P,Q]|in=-2); - W1=[(U[0]+P[0]+W[0])/3,(U[1]+P[1]+W[1])/3]; - W2=[(V[0]+P[0]+W[0])/3,(V[1]+P[1]+W[1])/3]; - L=[U,W1,P,1,W2,V]; - if(getopt(ar)==1) L=append([Q,P,0],L); - if(type(Sc=getopt(scale))>0){ - if(type(Sc)==1) Sc=[Sc,Sc]; - L=ptaffine(diagm(2,Sc),L); - } - Opt=getopt(opt); - if(type(Opt)>0) OL=[["opt",Opt]]; - else OL=[]; - if(getopt(proc)==1) return append([2,OL],L); - S=xybezier(L|optilon_list=OL); - if(getopt(dviout)!=1) return S; - dviout(S); - return 1; - } - } - if(type(Q)<3){ - X=deval(Q); Y=deval(R); - }else{ - X=myarg([Q[0]-P[0],Q[1]-P[1]]); - Y=myarg([R[0]-P[0],R[1]-P[1]]); - } - if(Prec>2) N=8; - else if(Prec==2) N=6; - else if(Prec==1) N=4; - else N=3; - U=deval(@pi)*2/N; - if(X==Y||Y-X>6.28318){ - for(L=[],I=N-1;I>=0;I--) L=cons([P[0]+S*dcos(I*U),P[1]+S*dsin(I*U)],L); - return xylines(L|option_list=append([["curve",1],["close",1]],Opt)); - } - for(M=1;(Y-X)/M>U;M++); - for(L=[],I=M+1;I>-2;I--){ - Ang=X+(Y-X)*I/M; - L=cons([P[0]+S*dcos(Ang),P[1]+S*dsin(Ang)],L); - } - if(getopt(ar)!=1) return xylines(L|option_list=append([["curve",1],["close",-1]],Opt)); - OL=delopt(Opt,["dviout","opt","proc"]); - S=xylines(L|option_list=append([["curve",1],["close",-1],["opt",0]],OL)); - T=xylines([P,L[1]]|option_list=cons(["opt",0],OL)); - S=ptaffine("close",[S,T]); /* connect curves */ - if(getopt(opt)==0) return S; - OL=(type(SS=getopt(opt))>1)?[["opt",SS]]:[]; - if(type(T=getopt(proc))==1 && T>=1 && T<=3) return [1,OL,S]; - if(OL==[]) S=xybezier(S); - else S=(type(SS)==7)? xybezier(S|opt=SS):xybezier(S|opt=SS[0],cmd=SS[1]); - if(getopt(dviout)==1) return xyproc(S|dviout=1); - return S; -} - -def xyoval(P,L,R) -{ - if(type(Arg=getopt(arg))!=4 && type(Arg=getopt(deg))==4){ - if(length(Arg)>2) - Arg=[@pi*Arg[0]/180,@pi*Arg[1]/180,@pi*Arg[2]/180]; - else - Arg=[@pi*Arg[0]/180,@pi*Arg[1]/180]; - } - if(type(Arg)==4){ - Arg0=deval(Arg[0]); Arg1=deval(Arg[1]); - if(length(Arg)>2) Arg2=deval(Arg[2]); - if(Arg1<Arg0 || Arg0<-7) return 0; - } - if(type(Prec=getopt(prec))!=0) Prec=0; - if((Ar=getopt(ar))!=1) Ar=0; - L=xyang(L,[0,0],Arg0,Arg1|prec=Prec,opt=0,ar=Ar); - Sc=getopt(scale); - if(type(Sc=getopt(scale))<1) Sc=[1,1]; - else if(type(Sc)==1) Sc=[Sc,Sc]; - M=mat([1,0],[0,R]); - L=ptaffine(M,L|shift=P); - M=mat([Sc[0],0],[0,Sc[1]]); - L=ptaffine(M,L|arg=Arg2); - if((Opt=getopt(opt))==0) return L; - Opt=(type(Opt)>1)? [["opt2",Opt]]:[]; - if(getopt(proc)==1) return [1,Opt,L]; - S=xybezier(L|option_list=getopt()); - if(getopt(dviout)==1){ - xyproc(S|dviout=1); - return 1; - } - return S; -} - -def xycirc(P,R) -{ - ST=getopt(opt); - if(type(ST)<0) ST=""; - if(type(Arg=getopt(arg))!=4 && type(Arg=getopt(deg))==4){ - Arg=[@pi*Arg[0]/180,@pi*Arg[1]/180]; - } -/* Is it OK? - if(TikZ==0 && XYcm==1){ - R*=10; P=[P[0]*10,P[1]*10]; - } -*/ - if(type(Arg)==4){ - Arg0=deval(Arg[0]); Arg1=deval(Arg[1]); - if(Arg1<=Arg0 || Arg0<-7 || Arg1-Arg0>7) return 0; - if(type(ST)==7) - S=xygraph([R*cos(x)+P[0],R*sin(x)+P[1]],-4,[Arg0,Arg1],[P[0]-R-1,P[0]+R+1], - [P[1]-R-1,P[1]+R+1]|opt=ST); - else - S=xygraph([R*cos(x)+P[0],R*sin(x)+P[1]],-4,[Arg0,Arg1],[P[0]-R-1,P[0]+R+1], - [P[1]-R-1,P[1]+R+1]); - if(getopt(close)==1){ - S=S+xyline([0,0], - [deval(subst(R*cos(x)+P[0],x,Arg0)),deval(subst(R*sin(x)+P[0],x,Arg0))]); - S=S+xyline([0,0], - [deval(subst(R*cos(x)+P[0],x,Arg1)),deval(subst(R*sin(x)+P[0],x,Arg1))]); - } - return S; - } - if(TikZ){ - SP=""; - if(length(P)>2) SP=P[2]; - if(type(SP)!=7) SP="$"+my_tex_form(SP)+"$"; - if(R==0){ - if(ST!="") ST=ST+","; - return "\\node ["+ST+"circle,draw]"+xypos([P[0],P[1]])+ "{"+SP+"};\n"; - } - if(type(R)!=7) R=rtostr(deval(R)); - if(ST!="") ST="["+ST+"]"; - S="\\draw "+ST+xypos([P[0],P[1]])+" circle [radius="+R+"]"; - if(SP!="") S=S+" node at"+xypos([P[0],P[1]])+" {"+SP+"}"; - return S+";\n"; - } - S="{"+xypos([P[0],P[1]]); - if(length(P)>2){ - SP=P[2]; - if(type(P)!=7) SP=my_tex_form(SP); - S=S+" *+{"+SP+"}"; - } - S =S+" *\\cir"; - if(R!=0){ - R=deval(R); - S=S+"<"+rtostr(R)+((XYcm)?"cm>":"mm>"); - } - S = S+"{"; - if(type(ST)==7) S=S+ST; - return S+"}};\n"; -} - -def ptaffine(M,L) -{ - if(type(L)!=4&&type(L)!=5){ - erno(0);return L; - } - if(type(M)==7){ /* connect lists */ - if(M=="reverse"){ - for(LO=LR=[],F=0,LT=L; LT!=[]; LT=cdr(LT)){ - if(type(P=car(LT))==4 || type(P)==7){ - LR=cons(P,LR); - continue; - }else{ - if(P==-1){ - LL=reverse(LR); - LO=append(reverse(cons(-1,cdr(LL))),LO); - LO=cons(car(LL),LO); - LR=[]; - }else if(P==1){ - LR=cons(car(LR),cons(1,cdr(LR))); - }else if(P==0 || length(LT)==1){ - if(LO!=[] && car(LO)!=0 && (type(car(LO))==4 || car(LO)==1)) - LO=cons(0,LO); - LO=append(LR,LO); - if(length(LT)>1&&length(LO)>0&&car(LO)!=0) LO=cons(0,LO); - LR=[]; - } - } - } - return append(LR,LO); - } - if(type(L[0][0])!=4) L=[L]; - LO=[]; - if(M=="connect" || M=="close" || M=="loop"){ - Top=car(car(L)); - for(K=1,LL=L; LL!=[]; LL=cdr(LL)){ - for(F=0,LT=car(LL); LT!=[]; LT=cdr(LT),F++){ - if((LTT=car(LT))==0) LTT=1; - if(F==0 && LO!=[]){ - LO0=car(LO); - if(car(LO)!=1&&length(LO)>1) LO=cons(1,LO); - if(LTT==LO0) continue; - else LO=cons(1,cons(LTT, LO)); - }else LO=cons(LTT, LO); - } - } - if(M!="connect"){ - if(Top==car(LO) || car(LO)==1 || M=="loop") - LO=cons(-1,cdr(LO)); - else - LO=cons(-1,cons(1,LO)); - } - return reverse(LO); - } - if(M=="union"){ - for(LL=reverse(L); LL!=[]; LL=cdr(LL)){ - if(LO!=[]) LO=cons(0,LO); - LO=append(car(LL),LO); - } - L=LO; - } - return L; - } - if(type(Arg=getopt(deg))==1) - Arg=@pi*Arg/180; - else Arg=getopt(arg); - if(type(Arg)==2) Arg=deval(Arg); - if(type(Arg)==1) - M=M*mat([dcos(Arg),-dsin(Arg)],[dsin(Arg),dcos(Arg)]); - if(type(Sft=getopt(org))==4){ - Sft=ltov(Sft); - Sft-=M*Sft; - }else Sft=ltov([0,0]); - if(type(V=getopt(shift))==4) - Sft+=ltov(V); - if(getopt(proc)==1){ - if(Sft!=0&<ov(Sft)!=[0,0]) Sft=[["shift",vtol(Sft)]]; - else Sft=[]; - for(LO=[],LT=L;LT!=[];LT=cdr(LT)){ - if(type(car(T=car(LT)))<2){ - if((P=car(T))==0){ /* exedraw 0 */ - V=[[T[1][0],T[2][0]],[T[1][0],T[2][1]],[T[1][1],T[2][0]],[T[1][1],T[2][1]]]; - V=ptbbox(ptaffine(M,V|option_list=Sft)); - L1=cdr(cdr(cdr(T))); - LO=cons(append([0,V[0],V[1]],L1),LO); - continue; - }else if(P==1){ /* exedraw 1 */ - L1=[]; - for(TT=cdr(cdr(T));TT!=[];TT=cdr(TT)){ - D=car(TT); - if(type(D[0][0])==4){ - for(L2=[],DT=D;DT!=[];DT=cdr(DT)) - L2=cons(ptaffine(M,car(DT)|option_list=Sft),L2); - L1=cons(reverse(L2),L1); - }else L1=cons(ptaffine(M,D|option_list=Sft),L1); - } - LO=cons(append([1,T[1]],reverse(L1)),LO); - continue; - }else if(P>=2 && P<=5){ - L1=ptaffine(M,cdr(cdr(T))|optilon_list=Sft); - LO=cons(append([P,T[1]],L1),LO); - continue; - } - } - LO=cons(T,LO); - } - return reverse(LO); - } - F=0; - if(type(L)==4){ - for(LT=L; LT!=[]; LT=cdr(LT)){ - if((T=type(car(LT)))==4||T==5){ - F=1; break; - } - } - } - if(F==0) return (Sft==0)?ptaffine(M,[L])[0]:ptaffine(M,[L]|shift=vtol(Sft))[0]; - for(LO=[],LT=L; LT!=[]; LT=cdr(LT)){ - if(((T=type(P=car(LT)))!=4 && T!=5)||type(P[0])>3) LO=cons(P,LO); - else{ - if(T==4) P=ltov(P); - V=M*P; - if(Sft!=0) V+=Sft; - if(T==4) V=vtol(V); - LO=cons(V,LO); - } - } - return reverse(LO); -} - -def ptlattice(M,N,X,Y) -{ - if(type(S=getopt(scale))!=1) S=1; - if(type(Cond=getopt(cond))!=4) Cond=[]; - Line=getopt(line); - if(Line==1 || Line==2) F=newmat(M,N); - else Line=0; - if(type(Org=getopt(org))==4) Org=ltov(Org); - else Org=newvect(length(X)); - X=ltov(X); Y=ltov(Y); - for(L=[],I=M-1;I>=0;I--){ - for(P0=P1=0,J=N-1;J>=0;J--){ - P=Org+I*X+J*Y; - for(C=Cond; C!=[]; C=cdr(C)) - if(subst(car(C),x,P[0],y,P[1])<0) break; - if(C!=[]) continue; - if(Line) F[I][J]=1; - else L=cons(vtol(S*P),L); - } - } - if(Line==0) return L; - for(I=M-1;I>=0;I--){ - for(T0=0,T1=J=N-1;J>=0;J--){ - if((K=F[I][J])!=0){ - if(T0==0) T0=J; - else T1=J; - } - if(K==0 || T1==0){ - if(T1<T0){ - L=cons(vtol(S*(Org+I*X+T0*Y)), L); - L=cons(vtol(S*(Org+I*X+T1*Y)), L); - L=cons(0,L); - } - T0=0; T1=N-1; - } - } - } - for(J=N-1;J>=0;J--){ - for(T0=0,T1=I=M-1;I>=0;I--){ - if((K=F[I][J])!=0){ - if(T0==0) T0=I; - else T1=I; - } - if(K==0 || T1==0){ - if(T1<T0){ - L=cons(vtol(S*(Org+T0*X+J*Y)), L); - L=cons(vtol(S*(Org+T1*X+J*Y)), L); - L=cons(0,L); - } - T0=0; T1=M-1; - } - } - } - return cdr(L); -} - -def ptpolygon(N,R) -{ - if(type(S=getopt(scale))!=1) S=1; - if(type(Org=getopt(org))!=4) Org=[0,0]; - Pi=deval(@pi); - if(type(Arg=getopt(deg))==1) - Arg=Pi*Arg/180; - else Arg=getopt(arg); - if(type(Arg)==2) Arg=deval(Arg); - if(type(Arg)!=1) Arg=0; - Arg -= Pi*(1/2+1/N); - D=Pi*2/N; - for(L=[],I=N-1; I>=0; I--) - L=cons([S*(Org[0]+R*dcos(Arg+I*D)),S*(Org[1]+R*dsin(Arg+I*D))],L); - return L; -} - -def ptwindow(L,X,Y) -{ - if(type(S=getopt(scale))==1){ - X=[S*X[0],S*X[1]]; Y=[S*Y[0],S*Y[1]]; - } - for(R=[],LT=L;LT!=[];LT=cdr(LT)){ - P=car(LT); - if(P[0]<X[0] || P[0]>X[1] || P[1]<Y[0] || P[1]>Y[1]) - R=cons(0,R); - else R=cons(P,R); - } - return reverse(R); -} - -def lninbox(L,W) -{ - if(L[0]==L[1]) return 0; - R=newvect(2);C=newvect(2); - for(J=0;J<2;J++){ - C[J]=L[1][J]-L[0][J]; - if(C[J]!=0){ - R[J]=[(W[J][0]-L[0][J])/C[J],(W[J][1]-L[0][J])/C[J]]; - if(R[J][0]>R[J][1]) R[J]=[R[J][1],R[J][0]]; - } - } - if(R[0]==0) R[0]=R[1]; - if(R[1]==0) R[1]=R[0]; - S0=(R[0][0]<R[1][0])?R[1][0]:R[0][0]; - S1=(R[0][1]<R[1][1])?R[0][1]:R[1][1]; - if(getopt(in)==1){ - if(S0<0) S0=0; - if(S1>1) S1=1; - } - if(S0>S1) return 0; - return [[L[0][0]+C[0]*S0,L[0][1]+C[1]*S0],[L[0][0]+C[0]*S1,L[0][1]+C[1]*S1]]; -} - -def ptbbox(L) -{ - J=length(L[0]); - if((Box=getopt(box))==1){ - for(R=[],I=0;I<J;I++){ - P=car(LT=L)[I][0];Q=car(LT)[I][1]; - for(;LT!=[];LT=cdr(LT)){ - if((type(T=car(LT))==4 || type(T)==5) && length(T)==J){ - if(T[I][0]<P) P=T[I][0]; - if(T[I][1]>Q) Q=T[I][1]; - } - } - R=cons([P,Q],R); - } - }else if(type(Box)==4) return ptbbox([ptbbox(L),Box]|box=1); - else{ - for(R=[],I=0;I<J;I++){ - P=Q=car(LT=L)[I];LT=cdr(LT); - for(;LT!=[];LT=cdr(LT)){ - if((type(T=car(LT))==4||type(T)==5) && type(T[0])<2 && length(T)==J){ - if((V=T[I])<P) P=V; - else if(V>Q) Q=V; - } - } - R=cons([P,Q],R); - } - } - return reverse(R); -} - -def iscombox(S,T) -{ - for(;S!=[];S=cdr(S),T=cdr(T)) - if(car(S)[0]>car(T)[1] || car(S)[1]<car(T)[0]) return 0; - return 1; -} - -def ptcopy(L,V) -{ - if(type(V[0])!=4) V=[V]; - for(F=0,LL=[]; V!=[]; V=cdr(V)){ - if(F) LL=append(LL,[0]); - F++; - LL=append(LL,ptaffine(1,L|shift=car(V))); - } -} - -def average(L) -{ - L=os_md.m2l(L|flat=1); - M0=M1=car(L); - for(I=SS=0, LT=L; LT!=[]; LT=cdr(LT), I++){ - S+=(V=car(LT)); - SS+=V^2; - if(V<M0) M0=V; - else if(V>M1) M1=V; - } - SS=dsqrt(SS/I-S^2/I^2); - S=[deval(S/I),SS,I,M0,M1]; - if(isint(N=getopt(sint))) S=sint(S,N); - return S; -} - -def m2ll(M) -{ - for(R=[],I=size(M)[0]-1; I>=0; I--) - R=cons(vtol(M[I]),R); - return R; -} - -def madjust(M,W) -{ - if(type(Null=getopt(null))<0) Null=0; - if(type(M)==4 && type(M[0])==4){ - M=lv2m(M|null=Null); - return m2ll(madjust(M,W|null=Null)); - } - S=size(M); - if(W<0){ - W=-W; - T0=ceil(S[0]/W); - T1=S[1]*W; - N=newmat(T0,T1); - for(I=0; I<T0; I++){ - for(K=0; K<W; K++){ - II=K*T0+I; - for(J=0; J<S[1]; J++) - N[I][S[1]*K+J]=(II<S[0])?M[II][J]:Null; - } - } - }else{ - T1=W; - T0=S[0]*(D=ceil(S[1]/T1)); - N=newmat(T0,T1); - for(K=0; K<D; K++){ - for(J=0; J<W;J++){ - JJ=W*K+J; - for(I=0; I<S[0]; I++) - N[S[0]*K+I][J]=(JJ<S[1])?M[I][JJ]:Null; - } - } - } - return N; -} - -def texcr(N) -{ - if(!isint(N) || N<0 || N>127) return N; - S=(iand(N,8))? "\\allowdisplaybreaks":""; - if(iand(N,2)) S=S+"\\\\"; - if(iand(N,16)) S=S+"\\pause"; - if(iand(N,1)) S=S+"\n"; - if(iand(N,4)) S=S+"& "; - else if(!iand(N,1)) S=S+" "; - if(iand(N,64)) S=S+"="; - if(iand(N,32)) S=","+S; - return S; -} - -def ltotex(L) -{ - /* extern TeXLim; */ - - if(type(L)==5) - L = vtol(L); - if(type(L) != 4) - return my_tex_form(L); - Opt=getopt(opt); - Pre=getopt(pre); - if(type(Var=getopt(var))<1) Var=0; - Cr2="\n"; - if(type(Cr=getopt(cr))==4){ - Cr2=Cr[1];Cr=Cr[0]; - } - if(isint(Cr)) Cr=texcr(Cr); - if(type(Cr)!=7) Cr="\\\\\n & "; /* Cr=7 */ - if(type(Opt)==7) Opt=[Opt]; - if(type(Opt)!=4) - Op = -1; - else{ - Op=findin(Opt[0],["spt","GRS","Pfaff","Fuchs","vect","cr","text","spts","spts0", - "dform","tab", "graph","coord"]); - Opt=cdr(Opt); - } - if(Op==0){ /* spt */ - Out = str_tb("\\left\\{\n ",0); - for(CC=0; L!=[]; L=cdr(L), CC++){ - if(CC>0) str_tb(",\\, ",Out); - TP=car(L); - if(Op!=0) - str_tb(my_tex_form(TP),Out); - else if(TP[0]==1) - str_tb(my_tex_form(TP[1]),Out); - else - str_tb(["[", my_tex_form(TP[1]), "]_", rtotex(TP[0])],Out); - } - str_tb("%\n\\right\\}\n",Out); - }else if(Op==1){ /* GRS */ - Out = string_to_tb("\\begin{Bmatrix}\n"); - if(type(Pre)==7) str_tb(Pre,Out); - MC=length(M=ltov(L)); - for(ML=0, I=length(M); --I>=0; ){ - if(length(M[I]) > ML) ML=length(M[I]); - } - for(I=0; I<ML; I++){ - for(CC=J=0; J<MC; J++, CC++){ - if(length(M[J]) <= I){ - if(CC > 0) str_tb(" & ",Out); - }else if(M[J][I][0] <= 1){ - if(M[J][I][0] == 0) str_tb(" & ",Out); - else - str_tb([(!CC)?" ":" & ", my_tex_form(M[J][I][1])], Out); - }else - str_tb([((!CC)?" [":" & ["), my_tex_form(M[J][I][1]), "]_", - rtotex(M[J][I][0])], Out); - } - str_tb((I<ML-1)?"\\\\\n":"\n", Out); - } - str_tb("\\end{Bmatrix}",Out); - }else if(Op==2){ /* Pfaff */ - V=monototex(Opt[0]); - Out = string_to_tb("d"+V+"= \\Biggl("); - Opt=cdr(Opt); - II=length(Opt); - for(I=0; I<II; I++){ - str_tb([(I>0)?" + ":" ",mtotex(L[I]),"\\frac{d",monototex(Opt[I]),"}{", - my_tex_form(Opt[I]),(I==II-1)?"}\n":"}\n\\\\&\n"],Out); - } - str_tb(["\\Biggr)",V,"\n"],Out); - }else if(Op==3){ /* Fuchs */ - Out = string_to_tb("\\frac{d"); - V=my_tex_form(Opt[0]); - str_tb([V,"}{d",my_tex_form(Opt[1]),"}="] ,Out); - Opt=cdr(Opt); Opt=cdr(Opt); - II=length(Opt); - for(I=0; I<II; I++){ - str_tb([(I>0)?" +":"\\Biggl(", " \\frac{", - my_tex_form(L[I]),"}{", my_tex_form(Opt[I]),"}\n"],Out); - } - str_tb(["\\Biggr)",V,"\n"],Out); - }else if(Op==4){ /* vect */ - Out=str_tb(mtotex(matc(L)|lim=0,var=Var),0); - }else if(Op==5 || Op==6){ /* cr or text */ - Out = str_tb(0,0); - if(type(Lim=getopt(lim))!=1) Lim=0; - else if(Lim<30&&Lim>0) Lim=TeXLim; - Str=getopt(str); - if(length(Opt)==1 && (car(Opt)=="spts" || car(Opt)=="spts0") && type(Str)!=1) - Str=2; - for(K=I=0; L!=[]; I++, L=cdr(L)){ - LT=car(L); - if((!Lim||Op==6)&&I>0) str_tb((Op==5)?Cr:"\n",Out); - if(Op==6){ - if(type(LT)==7){ - str_tb([LT," "],Out); - I=-1; - continue; - } - str_tb("$",Out); - } - KK=0; - if(Str>0 && type(LT)==4 && Opt!=[]) - S=ltotex(LT|opt=car(Opt),lim=0,str=Str,cr=Cr2,var=Var); - else if(type(LT)==6){ - if(Lim>0){ - S=mtotex(LT|var=Var,lim=0,len=1); - KK=S[1]; - S=S[0]; - }else S=mtotex(LT|var=Var,lim=0); - }else if(type(LT)==3 || type(LT)==2) - S=fctrtos(LT|TeX=2,lim=0,var=Var); - else S=my_tex_form(LT); - if(Op!=6&&I>0&&Lim){ - if(Lim<0){ - if(I%(-Lim)==0) - str_tb((Op==5)?Cr:"\n",Out); - }else if((K+=(KK=(KK)?KK:texlen(S)))>Lim){ - str_tb((Op==5)?Cr:"\n",Out); - K=KK; - } - } - str_tb(S,Out); - if(Op==6) str_tb("$",Out); - } - }else if(Op==7||Op==8){ /* spts, spts0 */ - if(type(Lim=getopt(lim))!=1 || (Lim<30 && Lim!=0)) - Lim=TeXLim; - Str=getopt(str); - Out = str_tb(0,0); - for(K=0; L!=[]; L=cdr(L)){ - LT=car(L); - KK=0; - if(type(LT)==7 && Str==1) S=LT; - else if(type(LT)==3 || type(LT)==2) - S=fctrtos(LT|TeX=2,lim=0,var=Var); - else if(type(LT)==6){ - if(Lim){ - S=mtotex(LT|var=Var,lim=0,len=1); - KK=S[1]; - S=S[0]; - }else S=mtotex(LT|var=Var,lim=0); - }else - S=my_tex_form(LT); - if(Lim!=0){ - if(!KK) KK=texlen(S); - if(K>0 && K+KK>Lim){ - str_tb(Cr,Out); - K=0; - } - } - if(K>0){ - str_tb((Op==7)?"\\ ":" ",Out); - if(type(LT)>3 && type(LT)<7) str_tb("%\n",Out); - } - str_tb(S,Out); - K+=KK; - if(OP==7) K++; - } - }else if(Op==9){ /* dform */ - Out=str_tb(0,0); - for(I=0;L!=[];L=cdr(L),I++){ - for(J=0,LT=car(L); LT!=[]; LT=cdr(LT),J++){ - if(J==0){ - if((V=car(LT))==0) continue; - if(I>0){ - if(type(V)==1){ - if(V<0){ - str_tb("-",Out); - V=-V; - } - else str_tb("+",Out); - if(V==1 && length(LT)>1) continue; - str_tb(monototex(V),Out); - continue; - } - else str_tb("+",Out); - } - }else if(J>0) str_tb((J>1)?"\\wedge d":"\\,d",Out); - V=monototex(car(LT)); - if(V<"-" || V>=".") str_tb(V,Out); - else str_tb(["(",V,")"],Out); - } - } - }else if(Op==10 && type(L)==4 && type(car(L))==4){ /* tab */ - if(type(Null=getopt(null))<0) Null=""; - if(getopt(vert)==1){ - M=lv2m(L|null=Null); - L=m2ll(mtranspose(M)); - } - if(type(W=getopt(width))==1) - L=madjust(L,W|null=Null); - LV=ltov(L); - S=length(LV); -#if 1 - if(type(T=getopt(left))==4){ - T=str_times(T,S); - for(L=[],I=0;I<S;I++){ - L=cons(cons(car(T),LV[I]),L); - T=cdr(T); - } - LV=reverse(L); - } - if(type(T=getopt(right))==4){ - T=str_times(T,S); - for(L=[],I=0;I<S;I++){ - L=cons(append(LV[I],[car(T)]),L); - T=cdr(T); - } - LV=reverse(L); - } - for(I=CS=0; I<S; I++) - if(length(LV[I])>CS) CS=length(LV[I]); - if(type(T=getopt(top))==4){ - LV=cons(str_times(T,CS),vtol(LV)); - S++; - } - if(type(T=getopt(last))==4){ - LV=append(vtol(LV),[str_times(T,CS)]); - S++; - } -#else - for(I=CS=0; I<S; I++) - if(length(LV[I])>CS) CS=length(LV[I]); -#endif - if(type(Title=getopt(title))!=7) Title=""; - if(type(Vline=getopt(vline))!=4) Vline=[0,CS]; - else Vline=subst(Vline,z,CS); - for(VV=[],VT=Vline;VT!=[];VT=cdr(VT)){ - if(type(T=car(VT))==4 && T[1]>0){ - for(I=T[0];I<=CS;I+=T[1]) VV=cons(I,VV); - }else VV=cons(T,VV); - } - Vline=qsort(VV); - Out=str_tb("\\begin{tabular}{",0); - if(type(Al=getopt(align))==7 && str_len(Al)>1){ - str_tb(Al,Out); - }else{ - if(type(Al)!=7 || str_len(Al)<1) Al="r"; - for(I=0;I<=CS;I++){ - if(I!=0) str_tb(Al,Out); - while(Vline!=[] && car(Vline)==I){ - str_tb("|",Out); - Vline=cdr(Vline); - } - } - } - str_tb("}",Out); - if(Title!="") - str_tb("\n\\multicolumn{"+rtostr(CS)+"}{c}{"+Title+"}\\\\",Out); - if(type(Hline=getopt(hline))!=4) Hline=[0,S]; - else Hline=subst(Hline,z,S); - for(VV=[],VT=Hline;VT!=[];VT=cdr(VT)){ - if(type(T=car(VT))==4 && T[1]>0){ - for(I=T[0];I<=S;I+=T[1]) VV=cons(I,VV); - }else VV=cons(T,VV); - } - Hline=qsort(VV); - while(Hline!=[] && car(Hline)==0){ - str_tb(" \\hline\n",Out); - Hline=cdr(Hline); - } -/* - if(type(getopt(left))==4) CS++; - if(type(getopt(right))==4) CS++; - if(type(T=getopt(top))==4){ - LV=cons(str_times(T,CS),vtol(LV)); - S++; - } - if(type(T=getopt(last))==4){ - LV=append(vtol(LV),[str_times(T,CS)]); - S++; - } - if(type(T=getopt(left))==4){ - T=str_times(T,S); - for(L=[],I=0;I<S;I++){ - L=cons(cons(car(T),LV[I]),L); - T=cdr(T); - } - LV=reverse(L); - } - if(type(T=getopt(right))==4){ - T=str_times(T,S); - for(L=[],I=0;I<S;I++){ - L=cons(append(LV[I],[car(T)]),L); - T=cdr(T); - } - LV=reverse(L); - } -*/ - for(I=0; I<S; I++){ - for(C=0,LT=LV[I];C<CS; C++){ - if(LT!=[]){ - P=car(LT); - if(type(P)!=7) P="$"+my_tex_form(P)+"$"; - if(P!="") str_tb(P,Out); - LT=cdr(LT); - } - if(C<CS-1) str_tb("& ",Out); - } - str_tb("\\\\",Out); - while(Hline!=[] && car(Hline)==I+1){ - str_tb(" \\hline",Out); - Hline=cdr(Hline); - } - str_tb("\n",Out); - } - str_tb("\\end{tabular}\n",Out); - }else if(Op==11){ /* graph */ - if(type(Strip=getopt(strip))!=1) Strip=0; - if(type(MX=getopt(max))!=1) MX=0; - if(type(ML=getopt(mult))!=1) ML=0; - if((REL=getopt(relative))!=1) REL=0; - CL=getopt(color); - OL=delopt(getopt(),["color","strip","mult"]); - if(ML==1&&type(CL)==4){ - LL=L[1];L=L[0];K=length(L);S=T=""; - if(!MX){ - MX=vector(length(L[0])); - for(LT=L;LT!=[];LT=cdr(LT)){ - for(I=0,LTT=car(LT);LTT!=[];I++,LTT=cdr(LTT)){ - if(REL==1) MX[I]+=car(LTT); - else if(MX[I]<car(LTT)) MX[I]=car(LTT); - } - } - MX=lmax(MX); - OL=cons(["max",MX],OL); - } - if(REL==1) MX=newvect(length(L[0])); - for(I=0;I<K;I++){ - for(R=[],J=length(L[I]);--J>=0;){ - if(REL==1){ - R=cons([MX[J],V=MX[J]+L[I][J]],R); - MX[J]=V; - }else R=cons([(!I)?0:L[I-1][J],L[I][J]],R); - } - OP=cons(["color",CL[I]],OL); - S+=ltotex([R,LL]|option_list=cons(["value",0],cons(["strip",(!I)?1:2],OP))); - T+=ltotex([R,LL]|option_list=cons(["strip",3],OP)); - } - return(!Strip)?xyproc(S+T):(S+T); - }else if(!TikZ) CL=0; - if(type(Line=getopt(line))!=1){ - if(type(Line)==4){ - if(type(Line[0])==1 && (type(Line[1])==7 || type(Line[1])==1)){ - Opt=Line[1]; Line=Line[0]; - }else if(ML==1){ - OL=delopt(OL,"line"); - LL=L[1];L=L[0];K=length(L);S=""; - if(!MX){ - MX=newvect(length(L[0])); - for(LT=L;LT!=[];LT=cdr(LT)){ - for(I=0,LTT=car(LT);LTT!=[];I++,LTT=cdr(LTT)){ - if(REL==1) MX[I]+=car(LTT); - else if(MX[I]<car(LTT)) MX[I]=car(LTT); - } - } - MX=lmax(MX); - OL=cons(["max",MX],OL); - } - for(I=0;I<K;I++) - S+=ltotex([L[I],LL]|option_list - =cons(["line",Line[I]],cons(["strip",(!I)?1:2],OL))); - return(!Strip)?xyproc(S):S; - } - }else Line=0; - }else Opt="@{-}"; - Width=8; Hight=3; WRet=1/2; HMerg=(getopt(horiz)==1)?0.3:0.2; - if(!TikZ){ - Width*=10; Hight*=10; HMerg*=10; - } - VMerg=HMerg; - if(type(Shift=getopt(shift))!=1) - Shift=0; - if(type(V=getopt(size))==4){ - Width=V[0];Hight=V[1]; - if(length(V)>2) WRet=V[2]; - if(length(V)>3) VMerg=VMerg=V[3]; - if(length(V)>4) HMerg=V[4]; - } - Val=getopt(value); - if(!isint(Val)) Val=-1; - if(type(Line=getopt(line))!=1){ - if(type(Line)==4 && type(Line[0])==1 && (type(Line[1])==7 || type(Line[1])==1)){ - Opt=Line[1]; Line=Line[0]; - }else Line=0; - }else Opt="@{-}"; - if(type(car(L))==4){ - LL=L[1]; L=L[0]; - }else LL=[]; - if(Line==-1){ - for(Sum=0, LT=L; LT!=[]; LT=cdr(LT)){ - if((S=car(LT))<=0) return 0; - Sum+=S; - } - for(R=[],LT=L;LT!=[];LT=cdr(LT)) R=cons(car(LT)/Sum,R); - R=reverse(R); - Opt0=Opt*2/3; - Out=str_tb((Strip>0)?0:xyproc(1),0); - if(type(CL)!=4) str_tb(xylines(ptpolygon(6,Opt)|close=1,curve=1),Out); - for(S=0,RT=R,LT=LL;RT!=[];RT=cdr(RT)){ - SS=S+RT[0]; - if(type(CL)==4){ - str_tb(xyang(Opt,[0,0],(0.25-SS)*6.2832,(0.25-S)*6.2832|ar=1,opt=car(CL)),Out); - if(length(CL)>0) CL=cdr(CL); - }else str_tb(xyline([0,0],[Opt*dsin(S*6.2832),Opt*dcos(S*6.2832)]),Out); - T=(S+SS)/2; - S=SS; - if(LT!=[]){ - str_tb(xyput([Opt0*dsin(T*6.2832),Opt0*dcos(T*6.2832),car(LT)]),Out); - LT=cdr(LT); - } - } - if(!Strip) str_tb(xyproc(0),Out); - return str_tb(0,Out); - } - if(MX==0){ - for(MX=0,LT=L; LT!=[]; LT=cdr(LT)) - if(car(LT)>MX) MX=car(LT); - } - MX-=Shift; - S=length(L); - WStep=Width/S; - WWStep=WStep*WRet; - HStep=(Hight<0)?-Hight:Hight/MX; - if(LL!=[]&&length(LL)==S-1) WS2=WStep/2; - else WS2=0; - Out=str_tb((Strip>0)?0:xyproc(1),0); - Hori=getopt(horiz); - if(Strip<2){ - if(Hori==1) str_tb(xyline([0,0],[0,Width-WStep+WWStep]),Out); - else str_tb(xyline([0,0],[Width-WStep+WWStep,0]),Out); - } - for(I=0,LT=L;LT!=[]; LT=cdr(LT),I++){ - XP=WStep*I; XPM=XP+WWStep/2; - if(type(LTT=car(LT))==4){ - YP0=(car(LTT)-Shift)*HStep;YP=(LTT[1]-Shift)*HStep; - VL=LTT[1]; - if(REL) VL-=LTT[0]; - }else{ - YP0=0;YP=(LTT-Shift)*HStep;VL=LTT; - } - if(Hori==1){ - if(Line!=0){ - if(I>0) - str_tb(xyarrow([XPM,YP],[XPM-WStep,YPP]|opt=Opt),Out); - if(Val!=0) - str_tb(xyput([YP+HMerg, XPM,car(LT)]),Out); - if(Line==2) - str_tb(xyput([YP,XPM,"$\\bullet$"]),Out); - YPP=YP; - }else if(YP!=0 || Val==1){ - if(Strip!=3){ - if(CL) str_tb(xybox([[YP,XP+WWStep], [YP0,XP]]|color=CL),Out); - else str_tb(xybox([[YP,XP+WWStep],[YP0,XP]]),Out); - } - if(Val!=0) str_tb(xyput([(YP<0||REL==1)?(YP-HMerg):(YP+HMerg),XPM,VL]),Out); - } - if(LL!=[]&&I<length(LL)&&Strip<2) str_tb(xyput([-VMerg,XPM+WS2,LL[I]]),Out); - }else{ - if(Line!=0){ - if(I>0) - str_tb(xyarrow([XPM-WStep,YPP],[XPM,YP]|opt=Opt),Out); - if(Val!=0) - str_tb(xyput([XPM,YP+HMerg,car(LT)]),Out); - if(Line==2) - str_tb(xyput([XPM,YP,"$\\bullet$"]),Out); - YPP=YP; - }else if(YP!=0 || Val==1){ - if(Strip!=3){ - if(CL) str_tb(xybox([[XP,YP0],[XP+WWStep,YP]]|color=CL),Out); - else str_tb(xybox([[XP,YP0],[XP+WWStep,YP]]),Out); - } - if(Val!=0) str_tb(xyput([XPM,(YP<0||REL==1)?(YP-HMerg):(YP+HMerg),VL]),Out); - } - if(LL!=[]&&I<length(LL)&&Strip<2) str_tb(xyput([XPM+WS2,-VMerg,LL[I]]),Out); - } - } - if(!Strip)str_tb(xyproc(0),Out); - }else if(Op==12){ /* coord */ - Out=str_tb("(",0); - for(LT=L;;){ - X=car(LT); - if(type(X)>3 || imag(X)==0) str_tb(my_tex_form(X),Out); - else{ - XR=real(X);XI=imag(X); - S=monototex(imag(X)); - if(S=="1") S=""; - else if(S=="- 1") S="-"; - if(getopt(cpx)==2) S=S+"\\sqrt{-1}"; - else S=S+"i"; - if(XR!=0){ - if(str_char(S,0,"-")==0) S=monototex(XR)+S; - else S=monototex(XR)+"+"+S; - } - str_tb(S,Out); - } - if((LT=cdr(LT))==[]) break; - else str_tb(",",Out); - } - str_tb(")",Out); - } - else return my_tex_form(L); - S = str_tb(0,Out); - return (getopt(small)==1)?smallmattex(S):S; -} - - -def str_tb(L,TB) -{ - if(type(TB) == 0) TB = ""; - if(L == 0) - return (type(TB) == 7)?string_to_tb(TB):tb_to_string(TB); - if(type(L) == 7) - L = [L]; - else if(type(L) != 4){ - erno(0); - return 0; - } - if(type(TB) <= 7) - TB = string_to_tb((type(TB)==7)?TB:""); - for(; L != []; L = cdr(L)) - write_to_tb(car(L), TB); - return TB; -} - -/* -def redgrs(M,T) -{ - L = [zzz]; - for(I=S=0,Eq=[],MT=M; MT!=[]; I++, MT=cdr(MT)){ - for(J=LS=0, N=car(MT); N!=[]; N=cdr(N)){ - X = makev([z,I,z,J]); - L=cons(X,L); - LS += X; - S += car(N)[1]*X; - } - Eq = cons(LS-zzz,Eq); - } - Eq = cons(S-T,Eq); - Sol= lnsol(Eq,L); - for(LS=[],S=Sol; S!=[]; S=cdr(S)){ - T=car(S); - if(type(S)!=4) return 0; - LS=cons(car(S)[0],LS); - } -} -*/ - -/* T=0 : all reduction - =1 : construction procedure - =2 : connection coefficient - =3 : operator - =4 : series expansion - =5 : expression by TeX - =6 : Fuchs relation - =7 : All - =8 : basic - =9 : "" - =10: irreducible - =11: recurrence */ -def getbygrs(M, TT) -{ - /* extern TeXEq; */ - - if(type(M)==7) M=s2sp(M); - if(type(M) != 4 || TT =="help"){ - mycat( -["getbygrs(m,t) or getbygrs(m,[t,s_1,s_2,...]|perm=?,var=?,pt=?,mat=?)\n", -" m: generalized Riemann scheme or spectral type\n", -" t: reduction, construct, connection, series, operator, TeX, Fuchs, irreducible, basic, recurrence,\n", -" All\n", -" s: TeX dviout simplify short general operator irreducible top0 x1 x2 sft\n", -"Ex: getbygrs(\"111,21,111\", [\"All\",\"dviout\",\"operator\",\"top0\"])\n"]); - return 0; - } - if(type(TT) == 4){ - T = TT[0]; - T1 = cdr(TT); - }else{ - T = TT; - T1 = []; - } - if(type(T) == 7) - T = findin(T,["reduction","construct","connection", "operator", "series", - "TeX", "Fuchs", "All", "basic", "", "irreducible", "recurrence"]); - TeX = findin("TeX", T1); - Simp = findin("simplify", T1); - Short = findin("short", T1); - Dviout= findin("dviout", T1); - General=findin("general", T1); - Op =findin("operator", T1); - Irr =findin("irreducible", T1); - Top0 =findin("top0",T1); - X1 =findin("x1",T1); - X2 =findin("x2",T1); - Sft =findin("sft",T1); - Title = getopt(title); - Mat = getopt(mat); - if(Mat!=1 || T<0 ||(T!=0&&T!=1&&T!=5&&T!=6&&T!=8&&T!=10&&T!=9)) Mat = 0; - if(findin("keep",T1) >= 0) - Keep = Dviout = 1; - else Keep = 0; - if(Dviout >= 0 || T == 5) TeX = 1; - for(J = 0, MM = M; J == 0 && MM != []; MM = cdr(MM)){ - for(MI = car(MM); MI != []; MI = cdr(MI)){ - if(type(car(MI)) != 1 || car(MI) <= 0){ - J = 1; break; - } - } - } - - /* spectral type -> GRS */ - if(J == 0){ - for(R = [], S = J = 0, MM = M; MM != []; MM = cdr(MM), J++){ - MT = qsort(car(MM)); - R = cons(reverse(MT), R); - if(J == 1){ - S = length(MT)-1; - if(MT[S] > MT[0]) S = 0; - } - } - M = reverse(R); - R = getopt(var); - if(type(R)<1){ - for(R = [], I = J-1; I >= 0; I--) - R = cons(asciitostr([97+I]), R); - } - Sft=(Sft>=0)?1:0; - if(General < 0) - Sft=-Sft-1; - M = sp2grs(M,R,Sft|mat=Mat); - } - for(M0=[],MM=M;MM!=[];MM=cdr(MM)){ /* change "?" -> z_z */ - for(M1=[],Mm=car(MM);Mm!=[];Mm=cdr(Mm)){ - Mt=car(Mm); - if(type(Mt)==4 && Mt[1]=="?"){ - M1=cons([Mt[0],z_z],M1); - continue; - }else if(type(Mt)==7 && Mt=="?"){ - M1=cons(z_z,M1); - continue; - } - M1=cons(Mt,M1); - } - M0=cons(reverse(M1),M0); - } - M = fspt(reverse(M0),5); /* short -> long */ - if(findin(z_z,vars(M))>=0) - M=subst(M,z_z,lsol(chkspt(M|mat=Mat)[3],z_z)); /* Fuchs relation */ - NP = length(M); - Perm = getopt(perm); - if(type(Perm) == 4) - M = mperm(M,Perm,0); - if(T == 9){ /* "" */ - if(Short >= 0) - M = chkspt(M|opt=4,mat=Mat); - return M; - } - R = [0,M]; - ALL = [R]; - - while(type(R = redgrs(R[1]|mat=Mat)) == 4) - ALL = cons(R, ALL); - if(R < 0) - return 0; - - /* TeX */ - if(TeX >= 0 && !chkfun("print_tex_form", "names.rr")) - return 0; - if(Dviout >= 0 && type(Title) == 7) - dviout(Title|keep=1); - if(T == 7 && Dviout >= 0){ - S=["keep","simplify"]; - if(Top0 >= 0) - S = cons("top0",S); - getbygrs(M,cons(5,S)|title="\\noindent Riemann Scheme",mat=Mat); - Same = 0; - if(R > 0){ - MM = getbygrs(M,8|mat=Mat); /* basic GRS */ - MS = chkspt(MM|opt=0,mat=Mat); /* spectral type */ - if(M != MM) - getbygrs(MM,cons(5,S)|title="Basic Riemann Scheme",mat=Mat); - else{ - dviout("This is a basic Riemann Scheme.\n\n\\noindent"|keep=1); - Same = 1; - } - dviout(MS|keep=1); - } - if(chkspt(ALL[0][1]|mat=Mat)[3] != 0) - getbygrs(M,cons(6,S)|title="Fuchs condition",mat=Mat); - if(Same == 0){ - M1 = M[1]; - if(M1[length(M1)-1][0]==1 && Mat!=1){ - M1=M[2]; - if(M1[length(M1)-1][0] == 1){ - getbygrs(M,cons(2,S)|title="Connection formula"); - if(M1[length(M[0][0])-1][0] == 1 && R==0) - getbygrs(M,cons(11,S)|title="Recurrence relation shifting the last exponents at $\\infty$, 0, 1"); - } - getbygrs(M,cons(1,S)|title="Integral representation"); - getbygrs(M,cons(4,S)|title="Series expansion"); - } - if(Irr < 0){ - TI="Irreduciblity $\\Leftrightarrow$ any value of the following linear forms $\\notin\\mathbb Z$"; - if(R > 0) - TI += " + fundamental irreducibility"; - getbygrs(M,cons(10,S)|title=TI,mat=Mat); - dviout("which coorespond to the decompositions"|keep=1); - sproot(chkspt(M|opt=0),"pairs"|dviout=1,keep=1); - } - } - if(Op >= 0 && Mat!=1) getbygrs(M,cons(3,S)|title="Operator"); - dviout(" "); - return 1; - } - if(T == 0 && TeX >= 0){ - T = 1; TeX = 16; - } -/* Fuchs */ - Fuc = chkspt(ALL[0][1]|Mat=mat)[3]; - if(Fuc == 0) Simp = -1; - if(type(Fuc) == 1){ - print("Violate Fuchs condition"); - return 0; - } - if(T == 6){ - if(Dviout >= 0) dviout(Fuc|eq=0,keep=Keep); - return (TeX >= 0)?my_tex_form(Fuc):Fuc; - } - Fuc = [Fuc]; -/* Generelized Riemann scheme */ - if(T == 5){ - M = ltov(M); - for(ML=0, I=0; I<NP; I++){ - L = length(M[I]); - if(L > ML) ML = L; - } - Out = string_to_tb("P\\begin{Bmatrix}\nx="); - if(Top0 < 0) - write_to_tb("\\infty & ",Out); - Pt = getopt(pt); - if(type(Pt) == 4){ - for(J = 3; J < NP; J++){ - str_tb(["& ",rtotex(car(Pt))],Out); - Pt = cdr(Pt); - } - } - else if(X2>=0) - str_tb("0 & x_2",Out); - else - str_tb((X1>=0)?"x_1 & x_2":"0 & 1",Out); - for(J = 3; J < NP; J++) - str_tb(["& x_",rtotex(J)],Out); - if(Top0 >= 0) - write_to_tb("& \\infty",Out); - write_to_tb("\\\\\n",Out); - for(I = 0; I < ML; I++){ - for(CC = 0, J = (Top0 >= 0)?1:0; ; J++, CC++){ - if(J == NP){ - if(Top0 < 0) break; - J = 0; - } - if(length(M[J]) <= I){ - if(CC > 0) write_to_tb(" & ",Out); - }else if(M[J][I][0] <= 1){ - if(M[J][I][0] == 0) str_tb(" & ",Out); - else - str_tb([(!CC)?" ":" & ", my_tex_form(M[J][I][1])], Out); - }else{ - str_tb([((!CC)?"[":" & ["), my_tex_form(M[J][I][1]), - (Mat==1)?"]_{":"]_{("],Out); - str_tb([my_tex_form(M[J][I][0]),(Mat==1)?"}":")}"],Out); - } - if(Top0 >= 0 && J == 0) - break; - } - if(I == 0) - str_tb("&\\!\\!;x",Out); - str_tb("\\\\\n",Out); - } - str_tb("\\end{Bmatrix}",Out); - Out = str_tb(0,Out); - if(Dviout >= 0) - dviout(Out|eq=0,keep=Keep); - return Out; - } - -/* Reduction */ - if(T == 0){ - if(Simp >= 0) - ALL = simplify(ALL,Fuc,4); - return reverse(ALL); - } - LA = length(ALL) - 1; - NP = length(ALL[0][1]); - -/* irreducible */ - if(T == 10){ - for(IR=[], I = 0; I < LA; I++){ - AI = ALL[I]; AIT = AI[1]; - K = AI[0][0]; - P = -AIT[0][K][1]; - P -= cterm(P); - IR = cons(P, IR); - for(J = 0; J < NP; J++){ - K = AI[0][J]; - for(L = length(AIT[J]) - 1; L >= 0 ; L--){ - if(L == K || AIT[J][L][0] <= AIT[J][K][0]) - continue; - P = AIT[J][L][1] - AIT[J][K][1]; - Q = cterm(P); - if(dn(Q)==1) - P -= Q; - IR = cons(P,IR); - } - } - } - P=Fuc[0]; - Q=cterm(P); - if(type(Q)==1 && dn(Q)==1){ - for(F=0,V=vars(P);V!=[];V=cdr(V)){ - R=mycoef(P,1,car(V)); - if(type(R)!=1 || Q%R!=0){ - F=1; break; - } - } - if(F==0){ - P-=Q; - Simp=0; - } - } - if(Simp >= 0){ - IR=simplify(IR,[P],4); - for(R=[]; IR!=[]; IR=cdr(IR)){ - P=car(IR); - Q=cterm(P); - if(dn(Q)==1) P-=Q; - R=cons(P,R); - } - IR=R; - } - for(R=[]; IR!=[]; IR=cdr(IR)){ - P=car(IR); - if(str_len(rtostr(P)) > str_len(rtostr(-P))) - P = -P; - R = cons(P,R); - } - R = ltov(R); -#ifdef USEMODULE - R = qsort(R,os_md.cmpsimple); -#else - R = qsort(R,cmpsimple); -#endif - R = vtol(R); - if(TeX >= 0){ - Out = string_to_tb(""); - for(I=L=K=0; R!=[]; R=cdr(R),I++){ - K1 = K; - RS = my_tex_form(car(R)); - K = nmono(car(R)); - L += K; - if(I){ - if(K1 == K && L < 30) - str_tb("\\quad ",Out); - else{ - L = K; - str_tb((TeXEq==5)?["\\\\%\n &"]:["\\\\%\n "],Out); - } - } - str_tb(RS,Out); - } - R = Out; - if(Dviout>=0){ - dviout(R|eq=0,keep=Keep); - return 1; - } - } - return R; - } - - AL = []; SS = 0; - for(I = 0; I <= LA; I++){ - AI = ALL[I]; AIT = AI[1]; /* AIT: GRS */ - if(I > 0){ - for(S = J = 0; J < NP; J++){ - GE = AIT[J][AI0[J]][1]; - S += GE; - if(J == 0) - SS = []; - else - SS = cons(GE,SS); - } - SS = cons(1-Mat-S, reverse(SS)); - } - AI0 = AI[0]; - AL = cons([SS, cutgrs(AIT)], AL); - } - AL = reverse(AL); - AD = newvect(NP); - ALT = AL[0][1]; - for(J = 1; J < NP; J++){ - /* AD[J] = ALT[J][0][1]; [J][?][1] <- [J][?][0]: max */ - for(MMX=0, K = KM = length(ALT[J])-1; K >= 0; K--){ - if(MMX <= ALT[J][K][0]){ - if(J == 1 && MMX == ALT[J][K][0]) - continue; - KM = K; - MMX = ALT[J][K][0]; - } - } - AD[J] = ALT[J][KM][1]; - } - AL = cdr(AL); - AL = cons([vtol(AD), ALT], AL); - AL = cons([0, mcgrs(ALT, [vtol(-AD)]|mat=Mat)], AL); - if(Simp >= 0 && T != 3) - AL = simplify(AL,Fuc,4); -/* Basic */ - if(T == 8){ - ALT = AL[0][1]; - if(TeX >= 0){ - if(Dviout >= 0){ - return getbygrs(ALT,["TeX","dviout","keep"]); - } - return getbygrs(ALT,"TeX"); - } - if(Short >= 0) - ALT = chkspt(ALT|opt=4); - return ALT; - } - -/* Construct */ - if(T == 1){ - if(TeX >= 0){ - L = length(AL); - I = Done = 0; Out0=Out1=""; NM = DN = []; - if(TeX != 16){ - AL11=AL[L-1][1][1]; - AT = AL11[length(AL11)-1]; - if(type(AT) == 4){ - PW = (AT[0] > 1)?"":AT[1]; - }else PW = AT; - } - Out = string_to_tb(""); - while(--L >= 0){ - if(TeX == 16){ - if(Done) - write_to_tb(":\\ ", Out); - write_to_tb(getbygrs(AL[L][1],(Top0>=0)?["TeX", "top0"]:"TeX"|mat=Mat), Out); - Done = 1; - if(L != 0) write_to_tb((TeXEq==5)? - "\\\\%\n&\\leftarrow ":"\\\\%\n\\leftarrow ", Out); - } - ALT = AL[L][0]; - if(TeX != 16){ - V1 = (I==0)?"x":V2; - V2 = /* (I==0 && L<=2)?"s": */ - "s_"+rtotex(I); - }else V1=V2="x"; - JJ = (type(ALT) == 4)?length(ALT):0; - if(I > 0 && L > 0) - write_to_tb("\n ", Out); - for(Outt = "", J = 1; J < JJ; J++){ - if(ALT[J] == 0) continue; - if(J == 1) Outt += V1; - else if(J == 2) Outt += "(1-"+V1+")"; - else Outt += "(x_"+rtotex(J)+"-"+V1+")"; - Outt += "^"+ rtotex(ALT[J]); - } - if(TeX != 16) write_to_tb(Outt, Out); - else if(Outt != "") - str_tb(["\\mathrm{Ad}\\Bigl(",Outt,"\\Bigr)"], Out); - if(JJ == 0){ - if(I != 0) - Out1 = "ds_"+rtotex(I-1)+Out1; - continue; - } - if(ALT[0] == 0) continue; - Out0 += "\\int_p^{"+V1+"}"; - if(TeX == 16) - str_tb(["mc_",rtotex(ALT[0])], Out); - else{ - str_tb(["(",V1,"-",V2,")^",rtotex(-1+ALT[0])], Out); - AL11=AL[L-1][1][1]; - AT = AL11[length(AL11)-1]; - if(type(AT) == 4) AT = AT[1]; - DN = cons(ALT[0]+AT+1,DN); - NM = cons(AT+1,cons(ALT[0],NM)); - } - if(L != 2) Out1 += "d"+V2; - I++; - } - if(R){ - if(I == 0) Ov = "x"; - else Ov = "s_"+rtotex(I-1); - Out1 = "u_B("+Ov+")"+Out1; - } - if(TeX != 16){ - Out0 = string_to_tb(Out0); - str_tb([Out, Out1], Out0); - Out = Out0; - NM = simplify(NM, Fuc, 4); - DN = simplify(DN, Fuc, 4); - DNT = lsort(NM,DN,"reduce"); - NMT = DNT[0]; DNT = DNT[1]; - if(NMT != [] && PW != ""){ - write_to_tb((TeXEq==5)?"\\\\\n &\\sim\\frac{\n" - :"\\\\\n \\sim\\frac{\n", Out); - for(PT = NMT; PT != []; PT = cdr(PT)) - str_tb([" \\Gamma(",my_tex_form(car(PT)), ")\n"], Out); - write_to_tb(" }{\n", Out); - for(PT = DNT; PT != []; PT = cdr(PT)) - write_to_tb(" \\Gamma("+my_tex_form(car(PT))+")\n", Out); - write_to_tb(" }", Out); - if(R > 0) write_to_tb("C_0", Out); - write_to_tb("x^"+rtotex(PW) +"\\ \\ (p=0,\\ x\\to0)", Out); - } - }else - Out = str_tb(0, Out); - if(Dviout >= 0){ - dviout(Out|eq=0,keep=Keep); - return 1; - } - return O; - } - if(Short >= 0){ - for(ALL = [] ; AL != []; AL = cdr(AL)){ - AT = car(AL); - ALL = cons([AT[0], chkspt(AT[1]|opt=4)], ALL); - } - AL = reverse(ALL); - } - return AL; /* AL[0][1] : reduced GRS, R==0 -> rigid */ - } - - if(T == 2 || T == 4 || T == 11){ - for(I = (T==2)?2:1; I >= (T==11)?0:1; I--){ - ALT = M[I]; - if(ALT[length(ALT)-1][0] != 1){ - mycat(["multiplicity for",I,":",ALT[length(ALT)-1][1], - "should be 1"]); - return; - } - } - } - LA++; - NM = DN = []; - -/* Three term relation */ - if(T == 11){ - if(R > 0){ - print("This is not rigid\n"); - return 0; - } - for(I = 0; I <= LA; I++){ - if(I > 0){ - AI = AL[I][0]; /* operation */ - if(AI[0] != 0){ - DN = cons(simplify(AI1+1,Fuc,4),DN); - NM = cons(simplify(AI1+AI[0]+1,Fuc,4),NM); - } - } - ALT = AL[I][1][1]; AI1 = ALT[length(ALT)-1][1]; - } - DNT = lsort(NM,DN,"reduce"); - if(TeX < 0) return DNT; - NMT = DNT[0]; DNT = DNT[1]; - Out = str_tb("u_{0,0,0}-u_{+1,0,-1}=\\frac{",""); - for(PT = NMT; PT != []; PT = cdr(PT)) - str_tb(["(",my_tex_form(car(PT)),")"], Out); - str_tb(["}\n{"],Out); - for(PT = DNT; PT != []; PT = cdr(PT)) - str_tb(["(",my_tex_form(car(PT)),")"], Out); - write_to_tb("}u_{0,+1,-1}",Out); - if(Dviout >= 0){ - dviout(Out|eq=0,keep=Keep); - return 1; - } - return Out; - } - - AD=newvect(NP); - for(I = 0; I <= LA; I++){ - if(I > 0){ - AI = AL[I][0]; /* operation */ - if(T == 2 && AI[0] != 0){ - DN = cons(simplify(-AI2,Fuc,4), cons(simplify(AI1+1,Fuc,4),DN)); - NM = cons(simplify(-AI2-AI[0],Fuc,4), cons(simplify(AI1+AI[0]+1,Fuc,4), - NM)); - } - for(J = 1; J < NP; J++) - AD[J] += simplify(AI[J],Fuc,4); - } - if(T == 2){ - ALT = AL[I][1][1]; AI1 = ALT[length(ALT)-1][1]; - ALT = AL[I][1][2]; AI2 = ALT[length(ALT)-1][1]; - if(I == 0){ - C3 = AI1; C4 = AI2; - } - } - } - -/* Connection */ - if(T == 2){ - DNT = lsort(NM,DN,"reduce"); - NMT = DNT[0]; DNT = DNT[1]; - if(TeX < 0) return [NMT,DNT,AD]; - C0 = M[1][length(M[1])-1][1]; - C1 = M[2][length(M[2])-1][1]; - M = AL[0][1]; - C3 = M[1][length(M[1])-1][1]; - C4 = M[2][length(M[2])-1][1]; - Out = str_tb(["c(0\\!:\\!", my_tex_form(C0), - " \\rightsquigarrow 1\\!:\\!", my_tex_form(C1),")"], ""); - if(R > 0 && AMSTeX == 1 && (TeXEq == 4 || TeXEq == 5)){ - write_to_tb("\\\\\n", Out); - if(TeXEq == 5) write_to_tb(" &", Out); - } - write_to_tb("=\\frac{\n",Out); - for(PT = NMT; PT != []; PT = cdr(PT)) - write_to_tb(" \\Gamma("+my_tex_form(car(PT))+")\n", Out); - write_to_tb(" }{\n",Out); - for(PT = DNT; PT != []; PT = cdr(PT)) - write_to_tb(" \\Gamma("+my_tex_form(car(PT))+")\n",Out); - write_to_tb(" }", Out); - for(J = 3; J < length(AD); J++){ - if(AD[J] == 0) continue; - str_tb(["\n (1-x_", rtotex(J), "^{-1})^", rtotex(AD[J])], Out); - } - if(R != 0) - str_tb(["\n c_B(0\\!:\\!", my_tex_form(C3), - " \\rightsquigarrow 1\\!:\\!", my_tex_form(C4), ")"], Out); - Out = tb_to_string(Out); - if(Dviout >= 0){ - dviout(Out|eq=0,keep=Keep); - return 1; - } - return Out; - } - -/* Series */ - if(T == 4){ - AL11 = AL[0][1][1]; - V = AL11[length(AL11)-1][1]; - S00 = -V; S01 = (R==0)?[]:[[0,0]]; - S1 = S2 = []; - for(Ix = 1, ALL = cdr(AL); ALL != []; ){ - ALT = ALL[0][0]; - if(ALT[0] != 0){ /* mc */ - for(Sum = [], ST = S01; ST != []; ST = cdr(ST)) - Sum = cons(car(ST)[0], Sum); - S1 = cons(cons(S00+1,Sum), S1); - S2 = cons(cons(S00+1+ALT[0],Sum),S2); - S00 += ALT[0]; - } - ALL = cdr(ALL); - for(I = 1; I < length(ALT); I++){ /* addition */ - if(I == 1){ - S00 += ALT[1]; - if(ALL == []) - S00 = [S00]; - }else{ - if(ALT[I] == 0) - continue; - if(ALL != []){ - S1 = cons([-ALT[I],Ix],S1); - S2 = cons([1,Ix],S2); - S01= cons([Ix,I],S01); - Ix++; - }else - S00 = cons([ALT[I],I],S00); - } - } - } - S00 = reverse(S00); - S01 = qsort(S01); S1 = qsort(S1); S2 = qsort(S2); - if(Simp >= 0){ - S00 = simplify(S00,Fuc,4); - S01 = simplify(S01,Fuc,4); - S1 = simplify(S1,Fuc,4); - S2 = simplify(S2,Fuc,4); - SS = lsort(S1,S2,"reduce"); - S1 = SS[0]; S2 = SS[1]; - } - - if(TeX >= 0){ - /* Top linear power */ - TOP = Ps = Sm = ""; - for(TOP = Ps = Sm = "", ST = cdr(S00); ST != []; ST = cdr(ST)){ - SP = car(ST); - if(SP[0] != 0){ - if(SP[1] == 2) - TOP += "(1-x)^"+rtotex(SP[0]); - else - TOP += "(1-x/x_"+rtotex(SP[1])+")^"+rtotex(SP[0]); - } - } - /* Top power */ - PW = my_tex_form(car(S00)); - if(PW == "0") - PW = ""; - NP = length(AL[0][1]); - PWS = newvect(NP); - for(I = 0; I < NP; I++) - PWS[I] = ""; - for(S = S01, I = 0; S != []; S = cdr(S), I++){ - SI = rtotex(car(S)[0]); - if(I > 0) Sm += ",\\ "; - Sm += "n_"+SI+"\\ge0"; - if(PW != "") - PW += "+"; - PW += "n_"+SI; - if(car(S)[1] > 2) - PWS[car(S)[1]] += "-n_"+rtotex(car(S)[0]); - else if(car(S)[1] == 0) - Ps = "C_{n_0}"+Ps; - } - for(I = 3; I < NP; I++){ - if(PWS[I] != "") - Ps += "x_"+rtotex(I)+"^{"+PWS[I]+"}"; - } - Out = str_tb([TOP, Ps, "x^{", PW, "}"], ""); - /* Gamma factor */ - for(I = 0, SS = S1; I <= 1; I++, SS = S2){ - PW = string_to_tb(""); - for(PW1=""; SS != [] ; SS = cdr(SS)){ - for(J = 0, SST = car(SS); SST != []; SST = cdr(SST), J++){ - if(J == 0){ - JJ = (car(SST) == 1)?((length(SST)==2)?(-1):0):1; - if(JJ > 0) - str_tb(["(", my_tex_form(car(SST)), ")_{"], PW); - else if(JJ == 0) - PW1 = "("; - }else{ - if(JJ > 0){ - if(J > 1) write_to_tb("+", PW); - str_tb(["n_", rtotex(car(SST))], PW); - }else{ - if(J > 1) PW1 += "+"; - PW1 += "n_"+rtotex(car(SST)); - } - } - } - if(JJ > 0) write_to_tb("}", PW); - else PW1 += (JJ == 0)?")!":"!"; - } - if(I == 0) - Out0 = "\\frac"; - Out0 += "{"+tb_to_string(PW)+PW1+"}"; - PW = string_to_tb(""); PW1 = ""; - } - if(Out0 == "\\frac{}{}") - Out0 = ""; - Out = "\\sum_{"+Sm+"}"+Out0 + Top + tb_to_string(Out); - if(length(S01) == 1){ - Out = str_subst(Out, "{n_"+SI+"}", "n"); - Out = str_subst(Out, "n_"+SI, "n"); - } - if(Dviout >= 0) - dviout(Out|eq=0,keep=Keep); - return Out; - } - return [cons(S00, S01), S1, S2]; - } - -/* Operator */ - if(T==3){ - Fuc0 = car(Fuc); - if(Fuc0 != 0){ /* Kill Fuchs relation */ - for(V = vars(Fuc0); V != []; V = cdr(V)){ - VT = car(V); - if(deg(Fuc0,VT) == 1){ - AL = mysubst(AL, [VT, -red(coef(Fuc0,0,VT)/coef(Fuc0,1,VT))]); - break; - } - } - if(V == []){ - print("Fuchs condition has no variable with degree 1"); - return 0; - } - } - L = newvect(NP); - Pt = getopt(pt); - for(I = NP-1; I >= 1; I--){ - if(type(Pt) == 4) - L[I] = Pt[I-1]; - else if(I >= 3 || X1 >= 0 || (X2 >= 0 && I >= 2)) - L[I] = makev(["x_", I]); - else L[I] = I-1; - } - if(R){ /* non-rigid basic */ - MM = AL[0][1]; /* Riemann scheme */ - for(OD = 0, MT = car(MM); MT != []; MT = cdr(MT)) - OD += car(MT)[0]; - for(V = DN = [], M = MM; M != []; M = cdr(M)){ - MT = car(M); /* exponents */ - for(K = KM = 0, NT = []; ; K++){ - for(J = 0, P = 1, MTT = MT; MTT != []; MTT = cdr(MTT)){ - if(J == 0 && car(MTT)[1] == 0) - KM = car(MTT)[0]; - for(KK = car(MTT)[0] - K -1; KK >= 0; KK--) - P *= (dx-car(MTT)[1]-KK); - } - if(P == 1) break; - NT = cons(P,NT); - } - V = cons(reverse(NT), V); - DN = cons(KM, DN); - } - V = ltov(reverse(V)); /* conditions for GRS */ - DN = ltov(reverse(DN)); /* dims of local hol. sol. */ - for(J = OD; J >= 0; J--){ - for(I = Q = 1; I < NP; I++){ - if(J > DN[I]) - Q *= (x-L[I])^(J-DN[I]); - } - K = mydeg(Q,x); - if(J == OD){ - P = Q*dx^J; - DM = K; - }else{ - for(I = DM-OD+J-K; I >= 0; I--){ - X = makev(["r",J,"_",I]); - P += Q*x^I*X*dx^J; - } - } - } - for(R = [], I = 0; I < NP; I++){ - Q = toeul(P, [x,dx], (I==0)?"infty":L[I]); /* Euler at I-th pt */ - for(VT = V[I], J=0; VT != [] ; VT = cdr(VT), J++){ - if(car(VT) != 0) - R = cons(rpdiv(coef(Q,J,x), car(VT), dx)[0], R); /* equations */ - } - } - for(RR = RRR = [], I = OD-1; I>=0; I--){ - RR = []; - for(RT = R; RT != [] ; RT = cdr(RT)){ - if( (VT = mycoef(car(RT), I, dx)) != 0) - RR = cons(VT, RR); /* real linear eqs */ - } - J = mydeg(mycoef(P,I,dx),x); - for(S = 0, VVV = []; J >= 0; J--){ - X = makev(["r",I,"_",J]); - VVV = cons(X, VVV); /* unknowns */ - } - RR = lsol(RR,VVV); - LN = length(RR); - for(K=0; K<LN; K++){ - RRT = RR[K]; - if(type(RRT) != 4) continue; - R = mysubst(R,RRT); - P = mysubst(P,RRT); - } - } - }else /* Rigid case */ - P = dx^(AL[0][1][0][0][0]); - /* additions and middle convolutions */ - for(ALT = AL; ALT != []; ALT = cdr(ALT)){ - AI = car(ALT)[0]; - if(type(AI) != 4) continue; - V = ltov(AI); - if(V[0] != 0) P = mc(P,x,V[0]); - for(I = 1; I < NP; I++){ - if(V[I] != 0) - P = sftexp(P,x,L[I],-V[I]); - } - } - P = (Simp>=0)? simplify(P,Fuc,4|var=[dx]):simplify(P,Fuc,4); - if(TeX >= 0){ - Val = 1; - if(mydeg(P,dx) > 2 && AMSTeX == 1 && TeXEq > 3) - Val = (TeXEq==5)?3:2; - Out = fctrtos(P|var=[dx,"\\partial"],TeX=Val); - if(Dviout < 0) return Out; - dviout(Out|eq=0,keep=Keep); - return 1; - } - return P; - } - return 0; -} - -def mcop(P,M,S) -{ - for(V=[],ST=S;ST!=[];ST=cdr(ST)) - if(isvar(VT=car(ST))) V=cons(vweyl(VT),V); - V=reverse(V); - N=length(V); - for(MT=M;MT!=[];MT=cdr(MT)){ - T=car(MT); - if(T[0]!=0) - P=mc(P,V[0],T[0]); - for(TT=cdr(T),ST=cdr(S);ST!=[];TT=cdr(TT),ST=cdr(ST)) - if(car(TT)!=0) P=sftpexp(P,V,S[0]-ST[0],-car(TT)); - } - return P; -} - -/* option: zero, all, raw */ -def shiftop(M,S) -{ - if(type(M)==7) M=s2sp(M); - if(type(S)==7) S=s2sp(S); - Zero=getopt(zero); - NP=length(M); - for(V=L=[],I=NP-1; I>=0; I--){ - V=cons(strtov(asciitostr([97+I])),V); - if(I>2) L=cons(makev(["y_", I-1]),L); - else L=cons(I-1,L); - } - if(type(M[0][0])==4){ - F=1;RS=M;SS=S; - R=chkspt(M); - if(R[2]!=2 || R[3]!=0){ - mycat("GRS is not valid!");return 0; - } - for(; S!=[]; S=cdr(S)){ - if(nmono(S[0][0])!=1) break; - if(isint(S[0][1]-S[0][0])==0) break; - } - if(S!=[]){ - mycat("Error in shift!"); return 0; - } - }else{ - F=0; - RS=sp2grs(M,V,[1,length(M[0]),1]); - for(SS=S0=[],I=0; I<NP; I++){ - for(J=F=0; J<length(M[I]); J++){ - if(I==0 && J==length(M[0])-1) break; - if((U=S[I][J])!=0){ - if(isint(U)!=1){ - mycat("Error in shift!"); return 0; - } - VT=RS[I][J][1]; - SS=cons([VT,VT+U],SS); - }else if(I>0 && Zero==1 && F==0){ - RS=mysubst(RS,[RS[I][J][1],0]); - F=J+1; - } - } - if((F>0 && J==2) || (I==0 && J==1)){ - J=(I==0)?0:2-F; VT=RS[I][J][1]; - S0=cons([VT,strtov(asciitostr([strtoascii(rtostr(VT))[0]]))],S0); - } - } - } - RS1=mysubst(RS,SS); - if(F==1){ - R=chkspt(RS1); - if(R[2]!=2 || R[3]!=0){ - mycat("Error in shift!"); - return 0; - } - } - R=getbygrs(RS,1); R1=getbygrs(RS1,1); - RT=R[0][1][0]; - if(length(RT)!=1 || RT[0][0]!=1){ - mycat("Not rigid!"); - return 0; - } - P=dx;Q=Q1=1; - for(RT = R, RT1=R1; RT != []; RT = cdr(RT), RT1=cdr(RT1)){ - V=car(RT)[0]; V1=car(RT1)[0]; - if(type(V) != 4) continue; - - if(V[0] != 0){ - P = mc(P,x,V[0]); /* middle convolution */ - QT = mc(Q,x,V[0]); - }else QT=Q; - D0=mydeg(Q,dx);D0T=mydeg(QT,dx); - C0=red(mycoef(Q,D0,dx)/mycoef(QT,D0T,dx)); - if(C0!=1) QT=red(C0*QT); - - if(V1[0] != 0) Q1T = mc(Q1,x,V1[0]); - else Q1T=Q1; - D1=mydeg(Q1,dx);D1T=mydeg(Q1T,dx); - C1=red(mycoef(Q1,D1,dx)/mycoef(Q1T,D1T,dx)); - if(C1!=1) Q1T=red(C1*Q1T); - DD=(V[0]-V1[0])+(D0-D0T)-(D1-D1T); - if(DD>0){ - QT=muldo(dx^DD,QT,[x,dx]); - D0T+=DD; - }else if(DD<0){ - Q1T=muldo(dx^(-DD),Q1T,[x,dx]); - D1T-=DD; - } - C=mylcm(dn(QT),dn(Q1T),x); - if(C!=1){ - QT=red(C*QT); Q1T=red(C*Q1T); - } - Q=QT;Q1=Q1T; - for(I = 1; I < NP; I++){ - if(V[I]!=0){ - P = sftexp(P,x,L[I],-V[I]); /* addition u -> (x-L[I])^V[I]u */ - QT = sftexp(QT,x,L[I],-V[I]); - } - if(V1[I]!=0) - Q1T = sftexp(Q1T,x,L[I],-V1[I]); - } - C=red(mycoef(QT,D0T,dx)*mycoef(Q1,D1T,dx)/(mycoef(Q,D0T,dx)*mycoef(Q1T,D1T,dx))); - Q=red(dn(C)*QT);Q1=red(nm(C)*Q1T); - for(I = 1; I < NP; I++){ - if((J=V[I]-V1[I])!=0){ - if(J>0) Q1*=(x-L[I])^J; - else Q*=(x-L[I])^(-J); - } - while((QT=tdiv(Q,x-L[I]))!=0){ - if((Q1T=tdiv(Q1,x-L[I]))!=0){ - Q=QT;Q1=Q1T; - }else break; - } - } - } - P1=mysubst(P,SS); - if(type(S0)==4 && S0!=[]){ - P=mysubst(P,S0); Q=mysubst(Q,S0); - P1=mysubst(P1,S0); Q1=mysubst(Q1,S0); - RS=mysubst(RS,S0); RS1=mysubst(RS1,S0); - } - R=mygcd(Q1,P1,[x,dx]); - if(findin(dx,vars(R[0]))>=0){ - mycat("Some error!"); - return 0; - } - Q=muldo(R[1]/R[0],Q,[x,dx]); - R=divdo(Q,P,[x,dx]); - Q=red(R[1]/R[2]); - R=fctr(nm(Q)); - QQ=Q/R[0][0]; - R1=fctr(dn(QQ)); - for(RR=cdr(R1); RR!=[]; RR=cdr(RR)){ - VT=vars(car(RR)[0]); - if(findin(x,VT)<0 && findin(dx,VT)<0){ - for(I=car(RR)[1];I>0;I--) QQ=red(QQ*car(RR)[0]); - } - } - Raw=getopt(raw); - Dviout=getopt(dviout); - if(Dviout==1) Raw=4; - if(Raw!=1){ - for(RR=cdr(R); RR!=[]; RR=cdr(RR)){ - VT=vars(car(RR)[0]); - if(findin(x,VT)<0 && findin(dx,VT)<0){ - for(I=car(RR)[1];I>0;I--) QQ=red(QQ/car(RR)[0]); - } - } - } - if(Raw==2||Raw==3||Raw==4){ - R=mygcd(QQ,P,[x,dx]); /* R[0]=R[1]*QQ + R[2]*P */ - Q1=red(R[0]/R[2]); - for(Q=1,RR=cdr(fctr(nm(Q1))); RR!=[]; RR=cdr(RR)){ - VT=vars(car(RR)[0]); - if(findin(x,VT)<0){ - for(I=car(RR)[1];I>0;I--) Q*=car(RR)[0]; - } - } - if(Raw==3) QQ=[QQ,Q]; - else if(Raw==4) /* Q=Q*R[1]/R[0]*QQ+Q/R[0]*P */ - QQ=[QQ,Q,red(R[1]*Q/R[0])]; - else QQ=Q; - } - F=getopt(all); - if(Dviout==1){ - Pre = " x=\\infty & 0 & 1"; - for(I=3; I<NP; I++) Pre = Pre+"& "+rtostr(L[I]); - Pre = Pre+"\\\\\n"; - PW=str_tb(ltotex(RS|opt="GRS",pre=Pre),0); - str_tb( -"=\\{u\\mid Pu=0\\}\\\\\n&\\underset{Q_2}{\\overset{Q_1}{\\rightleftarrows}}\n",PW); - str_tb([ltotex(RS1|opt="GRS",pre=Pre),"\\\\\n"],PW); - R=fctrtos(QQ[0]|TeX=3,var=[dx,"\\partial"]); - if(type(R)==4) R="\\frac1{"+R[1]+"}"+R[0]; - str_tb(["Q_1&=",R,"\\\\\n"],PW); - R=fctrtos(QQ[2]|TeX=3,var=[dx,"\\partial"]); - if(type(R)==4) R="\\frac1{"+R[1]+"}"+R[0]; - str_tb(["Q_2&=",R,"\\\\\n"],PW); - str_tb(["Q_2Q_1&\\equiv ",fctrtos(QQ[1]|TeX=3),"\\mod W(x)P"],PW); - if(F==1) - str_tb(["\\\\\nP&=",fctrtos(P|TeX=3,var=[dx,"\\partial"])],PW); - dviout(str_tb(0,PW)|eq=0,title="Shift Operator"); - } - if(F==1) return [QQ,P,RS,P1,RS1]; - else if(F==0) return QQ; - return [QQ,P,RS]; -} - -def conf1sp(M) -{ - if(type(M)==7) M=s2sp(M); - L0 = length(M); - L1 = length(M[L0-1]); - X2 = getopt(x2); - Conf= getopt(conf); - if(Conf != 0) - Conf = -1; - if((X2==1 || X2==-1) && Conf != 0){ - X1 = 0; - X = x_1; - }else{ - X1 = 1; - X = x_2; - } - G = sp2grs(M,a,[L0,L1]); - for(I = 0; I < L0-1; I++){ - V = makev([a,I-Conf,0]); - G = subst(G,V,0); - } - L2 = length(M[1]); - for(I=J=S0=S1=0; I < L2; I++){ - S1 += G[1][I][0]; - while(S0 < S1){ - S0 += G[0][J][0]; - if((V=G[0][J][1]) != 0) - G = mysubst(G,[V,V-G[1][I][1]]); - J++; - } - if(S0 > S1){ - print("Error in data!"); - return 0; - } - } - if(Conf==0){ - for(L=[], I=L0-2; I>=0; I--) - L=cons(I,L); - L=cons(L0-1,L); - P = getbygrs(G,["operator","x2"]|perm=L); - }else if(X1) - P = getbygrs(mperm(G,[[1,2]],[]), ["operator","x2"]); - else - P = getbygrs(G,["operator","x1"]); - if(Conf==0) - P=nm(mysubst(P,[X,c])); - else{ - P = nm(mysubst(P,[X,1/c])); - if(X2==-1){ - for(I=2; I<L0; I++){ - V=makev(["x_",I]); VC=makev([c,I]); - P = nm(mysubst(P,[V,1/VC])); - } - } - } - for(I = 1; I < L2; I++){ - X = G[1][I][1]; - P = nm(mysubst(P,[X,X/c])); - } - VS = vars(P); - while(VS!=[]){ - V = car(VS); - if(str_chr(rtostr(V),0,"r")==0){ - CV = mycoef(P,1,V); - D = mymindeg(CV,c); - if(D > 0) P = mysubst(P,[V,V/c^D]); - CV = mycoef(P,1,V); - DD = mydeg(CV,dx); - CVV = mycoef(CV,DD,dx); - CD1 = mydeg(CVV,x); - CD = (X==x1)?0:CD1; - while(CD>=0 && CD<=CD1){ - CC = mycoef(CVV,CD,x); - if(type(CC)==1){ - VT = mycoef(mycoef(mycoef(P,DD,dx),CD,x),0,V)/CC; - if(VT != 0) P = mysubst(P,[V,V-VT]); - break; - } - if(X==x1) CD++; - else CD--; - } - while(subst(P,c,0,V,0) == 0) - P = red(mysubst(P,[V,c*V])/c); - } - VS =cdr(VS); - } - return P; -} - -def pgen(L,VV) -{ - if(type(L[0])<4) L=[L]; - if(type(L)==4) L=ltov(L); - K=length(L); - V=newvect(K); - if(type(Sum=getopt(sum))!=1) Sum=0; - if((Num=getopt(num))!=1) Num=0; - if((Sep=getopt(sep))!=1) Sep=0; - if(type(Shift=getopt(shift))!=1) Shift=0; - for(;;){ - for(PP=1,R=[],II=K-1; II>=0; II--){ - R=cons(V[II]+Shift,R); - if(II>0 && Sep==1) R=cons("_",R); - PP*=L[II][0]^V[II]; - } - P+=makev(cons(VV,R)|num=Num)*PP; - for(I=0;I<K;){ - if(++V[I]<=L[I][1]){ - if(Sum>0){ - for(S=II=0;II<K;) S+=V[II++]; - if(S>Sum){ - V[I++]=0; - continue; - } - } - }else{ - V[I++]=0; - continue; - } - break; - } - if(I>=K) return P; - } -} - -def diagm(M,A) -{ - return mgen(M,0,A,1); -} - -def mgen(M,N,A,S) -{ - if(M==0 && N==0){ - mycat([ -"mgen(m,n,a,s|sep=1) : generate a matrix of size m x n\n", -" n : a number or \"diagonal\", \"highdiag\", \"lowdiag\",\"skew\",\"symmetric\",\"perm\" = 0,-1,-2,..\n", -" a : a symbol or list (ex. a, [a], [a,b,c], [1,2,3])\n", -" s : 0 or 1 (shift of suffix)\n" - ]); - return 0; - } - if(type(N)==7) N=-findin(N,["diag","highdiag","lowdiag","skew","symmetric","perm"]); - Sep=(getopt(sep)==1)?1:0; - if(S < 0 || S > 2) - S = 0; - if(M+S > 30 || N+S > 30){ - erno(1); - return; - } - if(N==-5){ - NM=newmat(M,M); - for(I=0;I<M;I++,A=cdr(A)) NM[I][car(A)-S]=1; - return NM; - } - if(type(A) == 4) - L = length(A)-1; - else - L = -1; - if(N <= 0 && N >= -2){ - MM = newmat(M,M); - J = K = 0; - if(N == -1){ - K = 1; M--; - }else if(N == -2){ - J = 1; M--; - } - for(I = 0; I < M; I++){ - if(L >= 0) - MM[I+J][I+K] = A[(I > L)?L:I]; - else if(type(A)==7 || isvar(A)) - MM[I+J][I+K] = makev([A,S+I]|sep=Sep); - else - MM[I+J][I+K] = A; - } - return MM; - } - K = N; - if(K < 0) N = M; - MM = newmat(M,N); - for(I = 0; I < M; I++){ - if(L >= 0) - AA = rtostr(A[(I > L)?L:I]); - else - AA = rtostr(A)+rtostr(I+S); - if(AA>="0" && AA<=":"){ - erno(0); return; - } - for(J = 0; J < N; J++){ - if(K < 0){ - if(I > J) continue; - if(K == -3 && I == J) continue; - } - MM[I][J] = makev([AA,J+S]|sep=Sep); - } - } - if(K < 0){ - for(I = 0; I < M; I++){ - for(J = 0; J < I; J++) - MM[I][J] = (K == -4)?MM[J][I]:-MM[J][I]; - } - } - return MM; -} - -def newbmat(M,N,R) -{ - S = newvect(M); - T = newvect(N); - IM = length(R); - for(I = 0; I < IM; I++){ - RI = R[I]; - JM = length(RI); - for(J = 0; J < JM; J++){ - RIJ = RI[J]; - if(type(RIJ) == 6){ - S[I] = size(RIJ)[0]; - T[J] = size(RIJ)[1]; - } - } - } - for(I = K = 0; I < M; I++){ - if(S[I] == 0) - S[I] = 1; - K += S[I]; - } - for(J = L = 0; J < N; J++){ - if(T[J] == 0) - T[J] = 1; - L += T[J]; - } - M = newmat(K,L); - if(type(Null=getopt(null))>0){ - for(I=0;I<K;I++){ - for(J=0;J<L;J++) M[I][J]=Null; - } - } - for(I0 = II = 0; II < IM; I0 += S[II++]){ - RI = R[II]; - JM = length(RI); - for(J0 = JJ = 0; JJ < JM; J0 += T[JJ++]){ - if((RIJ = RI[JJ]) == 0) - continue; - Type = type(RIJ); - for(I = 0; I < S[II]; I++){ - for(J = 0; J < T[JJ]; J++){ - if(Type == 6) - M[I0+I][J0+J] = RIJ[I][J]; - else if(Type == 4 || Type == 5) - M[I0+I][J0+J] = (I>0)?RIJ[I]:RIJ[J]; - else - M[I0+I][J0+J] = RIJ; - } - } - } - } - return M; -} - -def unim(S) -{ - if(!Rand++) random(currenttime()); - if(!isint(Wt=getopt(wt))||Wt<0||Wt>10) Wt=2; - if(!isint(Xa=getopt(abs)) || Xa<1) - Xa=9; - if((Xaa=Xa)>10) Xaa=10; - if(Xaa%2) Xaa++; - Xh=Xaa/2; - if(type(S0=SS=S)==4){ - Int=(getopt(int)==1)?1:0; - U=[1,1,1,1,1,1,1,1,1,1,1,1,2,2,3,4]; - M=newmat(S[0],S[1]); - SS=cdr(S);SS=cdr(SS); - if(Rk=length(SS)) L=SS; - else{ - L=[0]; - I=(S[0]>S[1])?S[1]:S[0]; - if(I<=2) return 0; - if(!isint(Rk=getopt(rank))||Rk<1||Rk>S[0]||Rk>S[1]) - Rk=random()%(I-1)+2; - for(I=1;I<Rk;){ - P=random()%(S[1]+Wt)-Wt; - if(P<=0) P=1; - if(findin(P,L)!=0){ - L=cons(P,L); - I++; - } - } - } - L=ltov(qsort(L)); - M[0][L[0]]=1; - for(I=1;I<Rk;I++){ - P=Int?1:U[random()%length(U)]; - if(P>Xa) P=Xa; - M[I][L[I]]=(random()%2)?P:(-P); - } - for(I=0;I<Rk;I++){ - if(I!=0&&abs(M[I][L[I]])>1) M[K=random()%I][KK=L[I]]=1; - I0=(I==0)?1:L[I]+1; - I1=(I==Rk-1)?S[1]:L[I+1]; - for(J=I0;J<I1;J++){ - for(K=1;K<=Xa;K++){ - P=random()%(I+1); - if((random()%2)==1) M[P][J]++; - else M[P][J]--; - } - } - } - S=M; - Res=(getopt(res)==1)?dupmat(S):0; - } - Conj=0; - if(type(S)<2){ - if(S<2||S>20) return 0; - if(getopt(conj)==1){ - M=S+Wt; - if(M>15) M=10; - M0=floor((M-1)/2); - for(R=[],I=0;I<S;I++) R=cons(random()%M-M0,R); - R=qsort(R); - M=diagm(S,R); - if(getopt(diag)!=1){ - for(I=1;I<S;I++) - if(M[I-1][I-1]==M[I][I] && random()%2) M[I-1][I]=1; - } - if(M[0][0]==M[S-1][S-1]){ - for(I=1;I<S;I++) if(M[I-1][I]==1) break; - if(I==S){ - if(M[0][0]>0) M[0][0]--; - else M[S-1][S-1]++; - } - } - if(getopt(res)==1) RR=diagm(S,[1]); - S1=S; - Res=dupmat(S=M); - if(isint(I=getopt(int))&&I>1&&random()%I==0){ - K=S[0][0];L=K+1; - for(I=1;I<S1;I++){ - if(S[I][I]>L && S[I-1][I]==0 && (I==S1-1||S[I][I+1]==0)){ - L=S[I][I]; - if(RR){ - RR[I][I]=L-K;RR[0][I]=1; - } - S[0][I]=1; - if(!(random()%3)) break; - } - } - if(random()%3==0){ - for(I=0;I<S1-1;I++){ - if(iand(S[I][I],1)&&S[I][I+1]==1){ - for(J=I+2;J<S1&&S[I][J]==0;J++); - if(J<S1) continue; - for(J=I-1;J>=0&&S[J][I]==0;J--); - if(J>=0) continue; - S[I][I+1]=2; - for(J=0;J<S1;J++) RR[I][J]*=2; - break; - } - } - } - } - }else{ - M=diagm(S,[1]); - S1=S; - } - } - if(type(S)==6){ - M=dupmat(S); - S=size(S); - S1=S[1];S=S[0]; - Nt=1; - if(getopt(conj)==1&&S==S1) Conj=1; - } - if(!isint(Ct=getopt(time))) - Ct=(S>3||S1>3)?100:200; - if(getopt(both)==1){ - OL=delopt(getopt(),"both"); - M=unim(mtranspose(M)|option_list=OL); - M=mtranspose(M); - } - Mx=20; - for(I=K=LL=0;I<Ct+Mx;I++){ - P=random()%S;Q=random()%S; - if(3*K>Ct) T=random()%Xaa-Xh; - else if(5*K<Ct) T=random()%2-1; - else T=random()%4-2; - if(T>=0) T++; - if(P==Q) continue; - for(G=0,J=S1-1;J>=0;J--){ - if((H=abs(M[Q][J]+M[P][J]*T))>Xa&&(!Conj||J!=P)) break; - if(K<Mx&&!Conj) G=igcd(G,H); - } - if(K<Mx && G>1) J=1; - if(J>0) continue; - if(J<0&&Conj==1){ - for(J=S1-1;J>=0;J--) - if(J!=Q&&abs(M[J][P]-M[J][Q]*T)>Xa) break; - if(J<0&&abs(M[Q][P]-M[Q][Q]*T+M[P][P]*T-M[P][Q]*T^2)>Xa) J=1; - if(J<0&&M[P][P]==M[Q][Q]){ - LF=0; - for(L=S1-1;J>=0;J--) if(L!=Q&&M[J][Q]!=0) LF++; - for(L=S1-1;J>=0;J--) if(L!=P&&M[P][J]!=0) LF++; - if(!LF) J=1; - } - } - if(J<0){ - for(J=S1-1;J>=0;J--) - M[Q][J]+=M[P][J]*T; - if(Conj==1) - for(J=S1-1;J>=0;J--) M[J][P]-=M[J][Q]*T; - if(RR) for(J=S1-1;J>=0;J--) RR[Q][J]+=RR[P][J]*T; - K++; - } - if(K%5==0){ - if(!Nt) M=mtranspose(M); - else if(!Conj&&K%2==0){ - for(F=0;F<S;F++){ - if((V=lgcd(M[F]))>1){ - for(L=0;L<S1;L++) M[F][L]/=V; - } - } - } - } - if(I>Ct){ - for(L=S-1;L>=0;L--){ - for(F=0,J=S1-1;J>=0;J--) - if(M[L][J]!=0) F++; - if(F<2){ - F=-1;break; - } - else F=0; - } - if(F<0 && LL++<5){ - I=(CT-CT%2)/2;K=1; - } - if(I>Ct) break; - } - } - if(RR){ - for(I=F=0;I<S1;I++){ - V=Res[I][I]; - for(J=I+1;J<S1;J++){ - if(Res[J][J]!=V) break; - for(LP=0;LP<2;LP++){ - if(J==S1-1||Res[J][J+1]==0){ - if(I==0||Res[I-1][I]==0){ - for(VL=VS=[],K=0;K<S1;K++){ - VL=cons(RR[K][J],VL);VS=cons(RR[K][I],VS); - } - VR=ldev(VL,VS); - if(VR[0]){ - for(K=S1-1,VN=VR[1];K>=0;K--,VN=cdr(VN)) - RR[K][J]=car(VN); - F=1; - } - } - } - K=I;I=J;J=K; - } - } - if(F&&I==S1-1){ - F=0;I=-1; - } - } - if(getopt(int)==1){ - N=mtranspose(M); - for(F=I=0;I<S1;I++) if(lgcd(M[I])>1||lgcd(N[I])>1) F++; - if(F){ - for(F=I=0;I<S1;I++){ - if(Res[I][I]==-1) F=ior(F,1); - else if(Res[I][I]==1) F=ior(F,2); - } - C=0; - if(!iand(F,1)) C=1; - else if(!iand(F,2)) C=-1; - if(C){ - for(I=0;I<S1;I++){ - M[I][I]+=C;Res[I][I]+=C; - } - } - } - } - if(getopt(rep)!=1){ - for(Lp=0;Lp<5;Lp++){ - F=(M==Res||abs(lmax(RR))>Xa*10||abs(lmin(RR))>Xa*10)?1:0; - for(I=0;!F&&I<S1&&Lp<4;I++){ - for(K=L=J=0;J<S1;J++){ - if(M[I][J]) K++; - if(M[J][I]) L++; - } - if(K<2||L<2) F=1; - } - if(!F) break; - R=unim(S0|option_list=cons(["rep",1],getopt())); - M=R[0];Res=R[1];RR=R[3]; - } - } - } - if(Res==0) return M; - if(RR){ - for(I=K=V=0;I<S1;I++){ - for(J=0;J<S1;J++){ - if(RR[J][I]>0) V++; - else if(RR[J][I]<0) V--; - } - if(I<S1-1&&Res[I][I+1]!=0) continue; - if(V<0){ - for(;K<=I;K++) RR=colm(RR,K,-1); - } - K=I+1;V=0; - } - } - if(getopt(rep)!=1){ - if((F=getopt(dviout))==1){ - if(getopt(conj)==1){ - if(RR) show([Res,"=",myinv(RR),M,RR]|opt="spts0",str=1,lim=200); - }else{ - if(type(Lim=getopt(lim))==1) - mtoupper(M,0|step=1,opt=7,dviout=1,pages=1,lim=Lim); - else mtoupper(M,0|step=1,opt=7,dviout=1,pages=1); - } - }else if(F==-1){ - if(getopt(conj)==1){ - if(RR) return ltotex([Res,"=",myinv(RR),M,RR]|opt="spts0",str=1,lim=200); - }else{ - if(type(Lim=getopt(lim))==1) - return mtoupper(M,0|step=1,opt=7,pages=1,lim=Lim,dviout=-1); - else return mtoupper(M,0|step=1,opt=7,pages=1,dviout=-1); - } - } - } - if(RR==0) return[M,Res]; - return [M,Res,myinv(RR),RR]; -} - -def pfrac(F,X) -{ - F = red(F); - FN = nm(F); - FD = dn(F); - if(mydeg(FD,X) == 0) - return [[F,1,1]]; - R = rpdiv(FN,FD,X); - FN = R[0]/R[1]; - R0 = R[2]/R[1]; - FC = fctr(FD); - RT=[]; - if(getopt(root)==2){ - for(FE=[],FT=FC;FT!=[];FT=cdr(FT)){ - if(mydeg(P=car(FT)[0],X)==4 && vars(P)==[X] && pari(issquare,C=mycoef(P,4,X))){ - if((S=mycoef(P,3,X)/4/C)!=0) P=subst(P,X,X-S); - if(mycoef(P,1,X)==0 && pari(issquare,C0=mycoef(P,0,X))){ - C=sqrtrat(C);C0=sqrtrat(C0);C1=2*C*C0-mycoef(P,2,X); - if(C1>0){ - FE=cons([C*(X+S)^2-C1^(1/2)*(X+S)+C0,car(FT)[1]],FE); - FE=cons([C*(X+S)^2+C1^(1/2)*(X+S)+C0,car(FT)[1]],FE); - RT=cons(C1,RT); - continue; - } - } - } - FE=cons(car(FT),FE); - } - FC=reverse(FE); - } - N = Q = 0; - L = []; - for(I = length(FC)-1; I >= 0; I--){ - if((D = mydeg(FC[I][0],X)) == 0) continue; - for(K=1; K<=FC[I][1]; K++){ - for(J=P=0; J < D; J++){ - V = makev(["zz_",++N]); - P = P*X + V; - L = cons(V,L); - } - Q += P/(FC[I][0]^K); - Q = red(Q); - } - } - L=reverse(L); - Q = nm(red(red(Q*FD)-FN)); - Q = ptol(Q,X); - S = lsol(Q,L); - R = (R0==0)?[]:[[R0,1,1]]; - for(N=0,I=length(FC)-1; I >= 0; I--){ - if((D = mydeg(FC[I][0],X)) == 0) continue; - for(K=1; K<=FC[I][1]; K++){ - for(P=J=0; J < D; N++,J++) - P = P*X + S[N][1]; - if(P!=0) R = cons([P,FC[I][0],K],R); - } - } - for(;RT!=[];RT=cdr(RT)){ - RTT=car(RT); - R=mtransbys(os_md.substblock,R,[RTT^(1/2),(RTT^(1/2))^2,RTT]); - } - TeX=getopt(TeX); - if((Dvi=getopt(dviout))==1||TeX==1){ - V=strtov("0"); - for(S=L=0,RR=R;RR!=[];RR=cdr(RR),L++){ - RT=car(RR); - S+=(RT[0]/RT[1]^RT[2])*V^L; - } - if(TeX!=1) fctrtos(S|var=[V,""],dviout=1); - else return fctrtos(S|var=[V,""],TeX=3); - } - return reverse(R); -} - -def cfrac(X,N) -{ - F=[floor(X)]; - if(N<0){ - Max=N=-N; - } - X-=F[0]; - if(Max!=1) - M=mat([F[0],1],[1,0]); - for(;N>0 && X!=0;N--){ - X=1/X; - F=cons(Y=floor(X),F); - X-=Y; - if(Max){ - M0=M[0][0];M1=M[1][0]; - M=M*mat([Y,1],[1,0]); - if(M[0][0]>Max) return M0/M1; - } - } - return (Max==0)?reverse(F):M[0][0]/M[1][0]; -} - -def sqrt2rat(X) -{ - if(type(X)>3) return X; - X=red(X); - if(getopt(mult)==1){ - for(V=vars(X);V!=[];V=cdr(V)){ - T=funargs(F=car(V)); - if(type(T)==4&&length(T)>1){ - Y=T[1]; - Z=sqrt2rat(Y); - if(Y!=Z){ - if(length(T)==2){ - T0=T[0]; - X=subst(X,F,T0(Z)); - }else if(T[0]==pow) - X=subst(X,F,Y^T[2]); - } - } - } - } - for(V=vars(X);V!=[];V=cdr(V)){ /* r(x)^(1/2+n) -> r(x)^n*r(x)^(1/2) */ - T=args(Y=car(V)); - if(functor(Y)==pow&&T[1]!=1/2&&isint(T2=2*T[1])){ - if(iand(T2,1)){ - R=(T[0])^(1/2);T2--; - }else R=1; - R*=T[0]^(T2/2); - X=red(subst(X,Y,R)); - } - } - D=dn(X);N=nm(X); - if(imag(D)!=0){ - N*=conj(D); - D*=conj(D); - return sqrt2rat(N/D); - } - for(V=vars(N);V!=[];V=cdr(V)){ /* (r(x)^(n/m))^k */ - T=args(Y=car(V)); - if(functor(Y)==pow&&(T[1]==0||(type(T[1])==1&&ntype(T[1])==0))){ - Dn=dn(T[1]);Nm=nm(T[1]); - N=substblock(N,Y,Y^Dn,T[0]^Nm); - } - } - for(V=vars(D);V!=[];V=cdr(V)){ - T=args(Y=car(V)); - if(functor(Y)==pow&&(T[1]==0||(type(T[1])==1&&ntype(T[1])==0))){ - Dn=dn(T[1]);Nm=nm(T[1]); - D=substblock(D,Y,Y^Dn,T[0]^Nm); - } - } - for(V=vars(D);V!=[];V=cdr(V)){ - T=args(Y=car(V)); - if(functor(Y)==pow&&T[1]==1/2&&mydeg(D,Y)==1){ - N*=mycoef(D,0,Y)-mycoef(D,1,Y)*Y; - N=mycoef(N,0,Y)+mycoef(N,1,Y)*Y+mycoef(N,2,Y)*T[0]; - D=mycoef(D,0,Y)^2-mycoef(D,1,Y)^2*T[0]; - X=red(N/D); - D=dn(X);N=nm(X); - break; - } - } - X=red(N/D); - D=dn(X);N=nm(X); - for(V=vars(D);V!=[];V=cdr(V)){ - T=args(Y=car(V)); - if(functor(Y)==pow&&T[1]==1/2) - D=substblock(D,T[0]^T[1],(T[0]^T[1])^2,T[0]); - } - for(V=vars(N);V!=[];V=cdr(V)){ - T=args(Y=car(V)); - if(functor(Y)==pow&&T[1]==1/2) - N=substblock(N,T[0]^T[1],(T[0]^T[1])^2,T[0]); - } - for(V=vars(N);V!=[];V=cdr(V)){ - T=args(Y=car(V)); - if(functor(Y)==pow&&T[1]==1/2){ - Ag=T[0]; - R=S=1; - An=fctr(nm(Ag)); - CA=An[0][0]; - if(CA<0){ - CA=-CA;R=-1; - } - if(type(I=sqrtrat(CA))<2) S=I; - else R*=CA; - for(An=cdr(An);An!=[];An=cdr(An)){ - Pw=car(An)[1];I=iand(Pw,1); - if(I) R*=car(An)[0]; - if((Q=(Pw-I)/2)>0) S*=car(An)[0]^Q; - } - for(An=fctr(dn(Ag));An!=[];An=cdr(An)){ - Pw=car(An)[1];I=iand(Pw,1); - if(I) R/=car(An)[0]^I; - if((Q=(Pw-I)/2)>0) S/=car(An)[0]^Q; - } - if(S!=1) N=subst(N,Y,R^(1/2)*S); - } - } - for(V=vars(N);V!=[];V=cdr(V)){ - T=args(Y=car(V)); - if(functor(Y)==pow&&T[1]==1/2){ - C=mycoef(N,1,Y); - for(VC=vars(C);VC!=[];VC=cdr(VC)){ - TC=args(YC=car(VC)); - if(functor(YC)==pow&&TC[1]==1/2){ - Ag=red(T[0]*TC[0]); - R=S=1; - An=fctr(nm(Ag)); - CA=An[0][0]; - if(CA<0){ - CA=-CA;R=-1; - } - if(type(I=sqrtrat(CA))<2) S=I; - else R*=CA; - for(An=cdr(An);An!=[];An=cdr(An)){ - Pw=car(An)[1];I=iand(Pw,1); - if(I) R*=car(An)[0]; - if((Q=(Pw-I)/2)>0) S*=car(An)[0]^Q; - } - for(An=fctr(dn(Ag));An!=[];An=cdr(An)){ - Pw=car(An)[1];I=iand(Pw,1); - if(I) R/=car(An)[0]^I; - if((Q=(Pw-I)/2)>0) S/=car(An)[0]^Q; - } - CC=mycoef(C,1,YC); - N=N-CC*YC*Y+CC*R^(1/2)*S; - } - } - } - } - return red(N/D); -} - -def cfrac2n(X) -{ - if(type(L=getopt(loop))==1&&L>0) - C=x; - else{ - C=0;L=0; - } - if(L>1){ - for(Y=[];L>1;L--){ - Y=cons(car(X),Y); - X=cdr(X); - } - if(X!=[]){ - P=cfrac2n(X|loop=1); - for(V=P,Y=reverse(Y);Y!=[];Y=cdr(Y)) - V=sqrt2rat(car(Y)+1/V); - return V; - }else{ - C=0;X=reverse(Y); - } - } - for(V=C,X=reverse(X);X!=[];X=cdr(X)){ - if(V!=0) V=1/V; - V+=car(X); - } - if(C!=0){ - V=red(V);P=dn(V)*x-nm(V); - S=getroot(P,x|cpx=2); - T=map(eval,S); - V=(T[0]>0)?S[0]:S[1]; - } - return V; -} - -def s2sp(S) -{ - if(getopt(short)==1){ - if(type(F=getopt(std))==1) S=s2sp(S|std=F); - if(type(S)!=7) S=s2sp(S); - L=strtoascii(S); - for(LS=[],F=C=0;L!=[];L=cdr(L)){ - if((G=car(L))!=F){ - LS=cons(G,LS);C=0; - }else if(C<3){ - LS=cons(G,LS); - }else if(C==3){ - LS=cdr(LS);LS=cdr(LS); - LS=cons(94,LS);LS=cons(52,LS); - }else if(C==9){ - LS=cdr(LS);LS=cons(97,LS); - }else{ - K=car(LS);LS=cdr(LS);LS=cons(K+1,LS); - } - C++;F=G; - } - return asciitostr(reverse(LS)); - } - if(type(F=getopt(std))==1){ - F=(F>0)?1:-1; - if(type(S)==7) S=s2sp(S); - for(L=[];S!=[];S=cdr(S)) - L=cons(os_md.msort(car(S),[-1,0]),L); - return os_md.msort(L,[F,2]); - } - if(type(S)==7){ - S = strtoascii(S); - if(type(S) == 5) S = vtol(S); - for(N=0,R=TR=[]; S!=[]; S=cdr(S)){ - if(car(S)==45) /* - */ - N=1; - else if(car(S)==47) /* / */ - N=2; - if(N>0){ - while(car(S)<48&&car(S)!=40) S=cdr(S); - } - if((T=car(S))>=48 && T<=57) TR=cons(T-48,TR); - else if(T>=97) TR=cons(T-87,TR); - else if(T>=65 && T<=90) TR=cons(T-29,TR); /* A-Z */ - else if(T==44){ - R=cons(reverse(TR),R); - TR=[]; - }else if(T==94){ /* ^ */ - S=cdr(S); - if(car(S)==40){ /* ( */ - S=cdr(S); - for(T=0; car(S)!=41 && S!=[]; S=cdr(S)){ - V=car(S)-48; - if(V>=10) V-=39; - T=10*T+V; - } - }else{ - while(car(S)<48) S=cdr(S); - T=car(S)-48; - if(T>=10) T-=39; - } - while(--T>=1) TR=cons(car(TR),TR); - }else if(T==40){ /* ( */ - S=cdr(S); - if(N==1){ - N=0; NN=1; - }else NN=0; - if(car(S)==45){ /* - */ - S=cdr(S); - NN=1-NN; - } - for(I=0; I<2; I++){ - for(V=0; (SS=car(S))!=41 && SS!=47 && S!=[]; S=cdr(S)){ - T=SS-48; - if(T>=10) T-=39; - V=10*V+T; - } - if(NN==1){ - V=-V; NN=0; - } - TR=cons(V,TR); - if(SS!=47) break; - else{ - N=2; S=cdr(S); - } - } - }else if(T==60){ - for(V=[],S=cdr(S);S!=[]&&car(S)!=62;S=cdr(S)) - V=cons(car(S),V); - if(car(S)!=62) continue; - TR=cons(eval_str(asciitostr(reverse(V))),TR); - }else if(T<48) continue; - if(N==1){ - T = car(TR); - TR=cons(-T,cdr(TR)); - N=0; - }else if(N==2){ - T=car(TR); TR=cdr(TR); - TR=cons(car(TR)/T,cdr(TR)); - N=0; - } - } - return reverse(cons(reverse(TR),R)); - }else if(type(S)==4){ - Num=getopt(num); - for(R=[]; ; ){ - if(type(TS=car(S))!=4) return; - for(; TS!=[]; TS=cdr(TS)){ - V=car(TS); - if(type(V)>1||(type(V)==1&&ntype(V)>0)){ - V="<"+rtostr(V)+">"; - R=append(reverse(strtoascii(V)),R); - continue; - } - if(dn(V)>1){ - P=reverse(strtoascii(rtostr(V))); - R=append(P,cons(40,R)); - R=cons(41,R); - continue; - } - if(V<0 && V>-10){ - V=-V; - R=cons(45,R); - } - if(V<0 || V>35 || (V>9 && Num==1)){ - P=reverse(strtoascii(rtostr(V))); - R=append(P,cons(40,R)); - V=41; - }else if(V<10) V+=48; - else V+=87; - R=cons(V,R); - } - if((S=cdr(S))==[]) break; - R=cons(44,R); - } - return asciitostr(reverse(R)); - } - return 0; -} - -def sp2grs(M,A,L) -{ - MM = []; - T0 = 0; - Mat=getopt(mat); - if(Mat!=1) Mat=0; - if(type(M)==7) M=s2sp(M); - if((LM = length(M)) > 10 && type(A) < 4) - CK = 1; - Sft = (type(L)==1)?L:0; - if(type(L)==4 && length(L)>=3) - Sft = L[2]; - if(Sft < 0){ - T0 = 1; - Sft = -Sft-1; - } - for(I = LM-1; I >= 0; I--){ - MI = M[I]; MN = []; - if(CK == 1 && length(MI) > 10){ - erno(1); - return; - } - if(type(A) == 4) - AA = rtostr(A[I]); - else - AA = rtostr(A)+rtostr(I); - for(J = LM = length(MI)-1; J >= 0; J--){ - V = MI[J]; - if(type(V) > 3) - V = V[0]; - if(T0 == 0 || I == 0) - MN = cons([V, makev([AA,J+Sft])], MN); - else{ - if(LM == 1) - MN = cons([V, (J==0)?0:makev([AA])], MN); - else if(I == 1 && Mat == 0) - MN = cons([V, (J==length(MI)-1)?0:makev([AA,J+Sft])], MN); - else - MN = cons([V, (J==0)?0:makev([AA,J])], MN); - } - } - MM = cons(MN, MM); - } - if(type(L) == 4 && length(L) >= 2){ - R = chkspt(MM|mat=Mat); /* R[3]: Fuchs */ - AA = var(MM[L[0]-1][L[1]-1][1]); - if(AA==0) AA=var(R[3]); - if(AA!=0 && (P = mycoef(R[3],1,AA))!=0){ - P = -mycoef(R[3], 0, AA)/P; - MM = mysubst(MM,[AA,P]); - } - } - return MM; -} - -def intpoly(F,X) -{ - if((T=ptype(F,X))<4){ - if(T<3){ /* polynomial */ - if(type(C=getopt(cos))>0){ - V=vars(F); - Z=makenewv(V); - W=makenewv(cons(Z,V)); - Q=intpoly(F,X|exp=Z); - Q=(subst(Q,Z,@i*C)*(Z+@i*W)+subst(Q,Z,-@i*C)*(Z-@i*W))/2; - return [mycoef(Q,1,Z),mycoef(Q,1,W)]; - } - if(type(C=getopt(sin))>0){ - Q=intpoly(F,X|cos=C); - return [-Q[1],Q[0]]; - } - if(type(C=getopt(log))>0){ - Q=intpoly(F,X); - if(C[0]==0) return [Q,0]; - if(length(C)<3) C=[C[0],C[1],1]; - Q-=subst(Q,X,-C[1]/C[0]); - if(iscoef(Q,os_md.israt)) Q=red(Q); - if(C[2]==0) return [Q]; - S=subst(-Q*C[0]*C[2],X,X-C[1]/C[0]); - for(R=0,D=mydeg(S,X);D>0;D--) R+=mycoef(S,D,X)*X^(D-1); - R=subst(R,X,X+C[1]/C[0]); - return cons(Q,intpoly(R,X|log=[C[0],C[1],C[2]-1])); - } - if(type(C=getopt(exp))>0){ - D = mydeg(F,X); - for(P=Q=F/C;D>=0;D--){ - Q=-mydiff(Q,X)/C; - P+=Q; - } - return P; - } - for(P=0,I=mydeg(F,X);I >= 0;I--) - P += mycoef(F,I,X)*X^(I+1)/(I+1); - return P; - } - R=pfrac(F,X|root=2); /* rational */ - for(P=0;R!=[];R=cdr(R)){ - if(type(V=getopt(dumb))==5){ - for(PF=[],RR=R;RR!=[];RR=cdr(RR)) - PF=cons(RR[0][0]/RR[0][1]^RR[0][2],PF); - PF=[cons(X,reverse(PF))]; - if(P) PF=cons([1,P],PF); - V[0]=cons(PF,V[0]); - } - RT=car(R); - if(mydeg(RT[1],X)==0) P+=intpoly(RT[0]*RT[2],X); - else if((Deg=mydeg(RT[1],X))==1){ - if(RT[2]>1) P+=RT[0]*RT[1]^(1-RT[2])/(1-RT[2])/mycoef(RT[1],1,X); - else P+=RT[0]*log(RT[1])/mycoef(RT[1],1,X); - P=red(P); - }else if(Deg==2){ - D1=diff(RT[1],X);C1=mycoef(D1,1,X); - B=2*C1*mycoef(RT[1],0,X)-mycoef(RT[1],1,X)^2; /* ax^2+bx+c => B=4ac-b^2 */ - B=sqrt2rat(B); - N=RT[0]; - for(I=RT[2];I>0&&N!=0;I--){ - C0=mycoef(N,1,X)/C1;N-=C0*D1; - if(C0){ - if(I>1) P-=C0/RT[1]^(I-1)/(I-1); - else P+=C0*log(RT[1]); - } - if(I>1){ - BB=B/C1; - P+=N*X/RT[1]^(I-1)/(I-1)/BB; - N*=(2*I-3)/(I-1)/BB; - }else{ - if(type(BR=sqrtrat(B))>3){ - mycat(["Cannot obtain sqare root of ",B]); - return []; - } - if(real(nm(BR))!=0){ - P+=(2*N/BR)*atan(sqrt2rat(D1/BR|mult=1)); - }else{ - BR*=@i;BRI=sqrt2rat(1/BR); - R1=(-mycoef(RT[1],1,X)+BR)/C1; - R2=(-mycoef(RT[1],1,X)-BR)/C1; - P+=N*BRI*log( /* sqrt2rat */((x-R1)/(x-R2))); - } - } - P=red(P); - } - P=sqrt2rat(P); - }else{ - mycat(["Cannot get an indefinite integral of ",F]); - return []; - } - } - Q=simplog(P,X); - if(type(V)==5&&nmono(P)!=nmono(Q)) V[0]=cons([[1,red(P)]],V[0]); - return red(Q); - } - return []; -} - -def fshorter(P,X) -{ - Q=sqrt2rat(P); - R=trig2exp(Q,X|inv=1); - if(str_len(fctrtos(R))<str_len(fctrtos(Q))) Q=R; - Var=pfargs(Q,X|level=1); - for(C=F=0,R=1,V=Var;V!=[];V=cdr(V)){ - if(findin(car(V)[1],[cos,sin,tan])>=0){ - if(!C){ - F=car(V)[2]; - }else{ - R=red(car(V)[2]/F); - if(type(R)!=1) break; - F/=dn(R); - } - C++; - } - } - if(getopt(period)==1) return F; - if(!isint(Log=getopt(log))) Log=0; - if(V==[]&&F!=0){ - if(iand(Log,1)){ - H=append(cdr(fctr(nm(Q))),cdr(fctr(dn(Q)))); - for(L=0;H!=[];H=cdr(H)) - L+=str_len(rtostr(car(H)[0])); - }else L=str_len(fctrtos(Q)); - S=trig2exp(P,X); - for(T=[sin(F),tan(F),cos(F),sin(F/2),cos(F/2),tan(F/2)];T!=[];T=cdr(T)){ - R=trig2exp(S,X|inv=car(T)); - if(iand(Log,1)){ - H=append(cdr(fctr(nm(R))),cdr(fctr(dn(R)))); - for(K=0;H!=[];H=cdr(H)) - K+=str_len(rtostr(car(H)[0])); - }else K=str_len(fctrtos(R)); - if(K<L){ - Q=R;L=K; - } - } - } - return Q; -} - -def isshortneg(P) -{ - return(str_len(rtostr(P))>str_len(rtostr(-P)))?1:0; -} - -def simplog(R,X) -{ - for(V=[],Var=pfargs(R,X);Var!=[];Var=cdr(Var)){ - VT=car(Var); - if(VT[1]==log && ptype(R,VT[0])==2 && mydeg(R,VT[0])==1) - V=cons([VT[0],VT[2],mycoef(R,1,VT[0])],V); - } - for(;V!=[];V=cdr(V)){ - VT=car(V); - for(V2=cdr(V);V2!=[];V2=cdr(V2)){ - Dn=1; - if((C=red(car(V2)[2]/VT[2]))!=1&&C!=-1){ - if(getopt(mult)==1&&type(C)==1&&ntype(C)==0){ - Dn=dn(C);C*=Dn; - }else continue; - } - Log=red(VT[1]^Dn*car(V2)[1]^(Dn*C)); - L=str_len(rtostr(dn(Log)))-str_len(rtostr(nm(Log))); - if(L>0 || (L==0&&isshortneg(VT[2])) ){ - Dn=-Dn;Log=1/Log; - } - R=mycoef(R,0,VT[0]);R=mycoef(R,0,car(V2)[0]); - return(R+VT[2]*log(Log)/Dn); - } - } - return R; -} - -def integrate(P,X) -{ - Dvi=getopt(dviout); - if(type(I=getopt(I))==4){ - if((R=integrate(P,X))==[]) II="?"; - else if(type(I[0])>3||type(I[1])>3){ - R=subst(R,X,x); - V=flim(R,I[0]);VV=flim(R,I[1]); - if(V==""||VV=="") II="?"; - else if(type(V)==7||type(VV)==7){ - if(V==VV) II="?"; - else II=(VV=="+"||V=="-")?"\\infty":"-\\infty"; - }else{ - II=VV-V; - if(II>10^10) II="\\infty"; - else if(II<-10^10) II="-\\infty"; - } - }else{ - V=subst(R,X,I[1])-subst(R,X,I[0]); - VV=myval(V); - II=(type(VV)>=2||ntype(VV)<1)?VV:evalred(V); - } - if(type(Dvi)!=1) return II; - I=ltov(I); - for(J=0;J<2;J++){ - if(type(I[J])>3){ - if(type(I[J])==4&&length(I[J])>1) I[J]=I[J][1]; - else I[J]=(J==0)?"-\\infty":"\\infty"; - } - if(type(I[J])<4) I[J]=my_tex_form(I[J]); - } - S=(type(II)==7)?II:my_tex_form(II); - S="\\int_{"+I[0]+"}^{"+I[1]+"}"+monototex(P)+"\\,d"+my_tex_form(X)+"&="+S; - if(Dvi==1) dviout(texbegin("align",S)); - return S; - } - if(isint(Dvi)==1){ - if(Dvi==2||getopt(dumb)==-1){ - V=newvect(1);V[0]=[]; - }else V=0; - if((RR=integrate(P,X|dumb=V))==[]) return R; - S=fshorter(RR,X); - VV=[X]; - if(V!=0){ - R=cons([[1,RR]],V[0]); - if(S!=RR) R=cons([[1,RR=S]],R); - for(V=FR=[];R!=[];R=cdr(R)) - if(car(R)!=FR) V=cons(FR=car(R),V); - Var=varargs(V|all=2); - for(S0=[x0,x1,x2,x3],S=[t,s,u,v,w];S0!=[]&&S!=[];){ - if(findin(car(S0),Var)<0){ - S0=cdr(S0); continue; - } - if(findin(car(S),Var)>=0){ - S=cdr(S); continue; - } - V=subst(V,[car(S0),car(S)]);S0=cdr(S0);S=cdr(S); - } - if(Dvi==-2) return V; - S1="\\,dx&"; - }else{ - V=[[],[[1,RR=S]]]; - S1="\\,dx"; - } - if(type(P)>2){ - if(type(nm(P))<2){ - P=P*dx;S1=V?"&":""; - } - S=fctrtos(P|TeX=2,lim=0);SV0=my_tex_form(P); - if(str_len(SV0)<str_len(S)) S=SV0; - }else S=monototex(P); - if(Dvi!=-2) S="\\int "+S+S1; - else S=""; - for(L=[],V=cdr(V);V!=[];V=cdr(V)){ - CL=car(V);S0=["="]; /* a line */ - for(FL=0;CL!=[];CL=cdr(CL),FL++){ - CT=car(CL); /* a term */ - if((Y=CT[0])==0){ /* a variable */ - CT=cdr(CT); - if(length(CT)>2) CT=cdr(CT); - S0=["\\qquad(",CT[0],"=",CT[1],")"]; - break; - }else{ - for(FT=0,S2=[],CT=cdr(CT);CT!=[];CT=cdr(CT),FT++){ - SV=fctrtos(car(CT)|TeX=2,lim=0);SV0=my_tex_form(car(CT)); - if(str_len(SV0)<str_len(SV)) SV=SV0; - if(FL||FT||(F&&type(Y)<2)) SV=minustos(SV); - S2=append(["+",SV],S2); - } - S2=reverse(cdr(S2)); - if(type(Y)>1){ - if(length(S2)>1){ - S1="\\int\\left(";S3="\\right)\\,d"; - }else{ - S1="\\int";S3="\\,d"; - } - S2=cons(S1,append(S2,[S3,Y])); - if(findin(Y,VV)<0) VV=cons(Y,VV); - } - if(FL) S0=append(S0,cons("+",S2)); - else S0=append(S0,S2); - } - } - L=append([S0],L); - }; - V=pfargs(RR,X|level=1); - for(Var=[];V!=[];V=cdr(V)) Var=cons(car(V)[0],Var); - Var=reverse(Var); - if(!isint(J=getopt(frac))) J=0;; - if(!iand(J,4)&&(!iand(J,2)||length(Var)==1)&&(iand(J,8)==8||ptype(RR,Var)==2)){ - F=1; - if(iand(J,1)){ - K=str_len(fctrtos(RR)); - I=str_len(fctrtos(RR|var=Var)); - if(I>=K) F=0; - } - if(F){ - V=[fctrtos(RR|var=Var,TeX=2)]; - if(Dvi!=-2) V=cons("=",V); - if(length(L)>0) L=cdr(L); - L=append([V],L); - } - }else if(ptype(RR,X)==2){ - L=cdr(L); - V=[fctrtos(RR|var=X,TeX=2)]; - if(Dvi!=-2) V=cons("=",V); - L=append([V],L); - } - S=texket(S+ltotex(reverse(L)|opt=["cr","spts0"],str=1)); - if(getopt(log)!=1){ - for(V=[];VV!=[];VV=cdr(VV)) - V=cons(strtoascii(my_tex_form(car(VV))),V); - S1=strtoascii("\\log"); - for(F=1;F;){ /* log(log(x)) */ - F=FT=0; - S0=strtoascii(S); /* log(x) -> log|x| */ - L=length(S0); - S2=str_tb(0,0); - for(I=0;;){ - if(I>=L||(J=str_str(S0,S1|top=I+FT))<0){ - S=str_tb(0,S2)+str_cut(S0,I,100000); - break; - } - if((K=str_str(S0,40|top=J+4))<0 - ||(K!=J+4&&K!=J+9)||(N=str_pair(S0,K+1,40,41))<0){ - FT=J-I+4;continue; - } - FT=0; - if(str_str(S0,V|top=K+1,end=N-1)[0]<0) S2=str_tb(str_cut(S0,I,N),S2); - else{ - /* log(a) -> log(a) */ - F=1; - if(N<L-1&&S0[N+1]==94){ /* log(x)^2 -> (log|x|)^2 */ - S2=str_tb([str_cut(S0,I,J-1),"\\left(",str_cut(S0,J,K-1), - "|",str_cut(S0,K+1,N-1),"|\\right)"],S2); - } - else S2=str_tb([str_cut(S0,I,K-1),"|",str_cut(S0,K+1,N-1),"|"],S2); - } - I=N+1; - } - } - } - if(Dvi>0){ - dviout(texbegin("align*",S)); - return 1; - } - return S; - } /* end of dviout */ - SM=["Cannot integrate",P,"at present"]; - P=sqrt2rat(P|mult=1); - Dumb2=1;Dumb3=0;W=newvect(1);W[0]=[]; - if(type(Dumb=getopt(dumb))==5){ - Dumb2=Dumb3=Dumb;D2=W; - }else if(!isint(Dumb)) Dumb=0; - if(Dumb==-1){ - Dumb2=Dumb3=-1; - } - if(type(Dumb)!=5) D2=Dumb2; - if(!isint(Mul=getopt(mult))) Mul=0; - else Mul++; - if(type(VAR=getopt(var))!=4) VAR=[]; - if(type(P)>4) return []; - if(iand(T=ptype(P=red(P),X),63)>3||Mul>4){ - if(Dumb!=1) mycat(SM); - return []; - } - if(Dumb==-1) mycat(["integrate", P]); - else if(type(Dumb)==5) Dumb[0]=cons([[X,P]],Dumb[0]); - if(T<4 && (T<3||iscoef(P,os_md.israt))){ - if(Dumb==-1) mycat(["rational function",P]); - else if(type(Dumb)==5) Dumb[0]=cons([[X,P]],Dumb[0]); - return intpoly(P,X|dumb=Dumb); /* rational function */ - } - Var=pfargs(P,X); - for(F=0,VV=Var;VV!=[];VV=cdr(VV)){ - /* p(x)*log(x^2-1), @e^x, a^x, f(x)^(m/n) etc.->simplify */ - V=car(VV); - if(V[1]==log && (T=ptype(V[2],X))>1 && T<4){ - if(mydeg(dn(V[2]),X)>0||mydeg(nm(V[2]),X)>1){ - FC=pfctr(V[2],X);RV=1; - if(length(FC)>2){ - RR=0;RV=1; - if((F0=car(FC)[0])!=1){ - if(type(F0)!=1 && F0<0){ - for(FT=cdr(FT);FT!=[];FT=cdr(FT)){ - if(iand(car(FT)[1],1)){ - RV=-1;F0=-F0;break; - } - } - } - } - if(F0!=1) RR=log(F0); - for(FC=cdr(FC);FC!=[];FC=cdr(FC)){ - if(RV==-1&&iand(car(FC)[1],1)==1){ - RR+=car(FC)[1]*log(-car(FC)[0]); - RV=1; - }else - RR+=car(FC)[1]*log(car(FC)[0]); - } - P=subst(P,V[0],RR); - F=1; - } - } - F=1; - }else if(V[1]==pow){ - if(ptype(V[2],X)==1){ - F=1; - if(V[2]==@e){ /* @e^(f(x)) */ - P=subst(P,V[0],exp(V[3])); - }else P=subst(P,V[0],exp(log(V[2])*V[3])); - }else if(type(V[3])<=1 && ntype(V[3])==0){ /* r(x)^(m/n) */ - if((Pw=floor(V[3]))!=0){ - R=V[2]^Pw; - if((PF=V[3]-Pw)!=0) R*=V[2]^PF; - P=subst(P,V[0],R); - F=1; - V=[V[2]^PF,V[1],V[2],PF]; - } - if(ptype(nm(V[2]),X)<2&&V[3]>0){ /* (1/p(x))^(m/n) */ - P=subst(P,V[0],V[2]*red(1/V[2])^(1-V[3])); - F=0;VV=cons(0,Var=pfargs(P,X));continue; - } - if(ptype(V[2],X)<4&&(K=dn(V[3]))>1){ - V2=red(V[2]); - DN=mydeg(nm(V2),X);DD=mydeg(dn(V2),X); - if(DN+DD>1){ - VF=pfctr(V2,X); - R=car(VF)[0]^(car(VF)[1]);RR=0; - for(VF=cdr(VF);VF!=[];VF=cdr(VF)){ - TV=car(VF);TM=TV[1]; - while(abs(TM)>=K){ - RR=1; - if(TM>0){ - TM-=K; - RR*=TV[0]^nm(V[3]); - }else{ - TM+=K; - RR/=TV[0]^nm(V[3]); - } - } - if(TM!=0) R*=TV[0]^TM; - } - if(RR){ - P=subst(P,V[0],RR*red(R)^(V[3]));F=1; - F=0;VV=cons(0,Var=pfargs(P,X));continue; - } - } - } - } - } - } - if(F){ - P=sqrt2rat(P|mult=1); - Var=pfargs(P=red(P),X);T=ptype(P,X); - if(T<4 && (T<3||iscoef(P,os_md.israt))){ - if(Dumb==-1) mycat(["rational function",P]); - else if(type(Dumb)==5){ - Dumb[0]=cons([[X,P]],Dumb[0]); - return intpoly(P,X|dumb=Dumb3); - } - return intpoly(P,X); /* rational function */ - } - } -#if 1 - for(P0=P,V=pfargs(P,X|level=1);V!=[];V=cdr(V)) /* P:tan(x) -> P0:sin(x)/cos(x) */ - if(car(V)[1]==tan) P0=red(subst(P0,car(V)[0],sin(car(V)[2])/cos(car(V)[2]))); - if(iand(ptype(P0,X),128)){ /* (log f)'=f'/f */ - for(Df=cdr(fctr(dn(P0)));Df!=[];Df=cdr(Df)){ - if(!iand(ptype(car(Df)[0],X),64)) continue; - Q=car(Df)[0]^(car(Df)[1]);QQ=red(dn(P0)/Q); - DQ=red(diff(Q,X)*QQ); - if(type(C=DQ/nm(P0))<2&&C!=0){ - PP=0;DN=[1]; - }else for(DN=cdr(fctr(DQ));DN!=[];DN=cdr(DN)){ - Y=car(DN)[0]; - if(!iand(ptype(Y,X),64)||(I=mydeg(nm(P0),Y))!=mydeg(DQ,Y) - || ptype((C=red(mycoef(nm(P0),I,Y)/mycoef(DQ,I,Y))),X)>1||C==0) continue; - PP=red(P0-C*diff(Q,X)/Q); - if(nmono(P0)>nmono(PP)) break; - } - if(DN!=[]){ - R=C*log(Q); - if(PP==0){ - if(P!=P0&&type(Dumb)==5) Dumb[0]=cons([[X,P0]],Dumb[0]); - return R; - } - W[0]=[]; - S=integrate(PP,X|dumb=D2); - if(S!=[]){ - if(type(Dumb)==5){ - Dumb[0]=cons([[X,red(P0-PP),PP]],Dumb[0]); - TD=W[0]; - for(W0=[],TD=reverse(TD);TD!=[];TD=cdr(TD)){ - if(car(TD)[0][0]){ - WL=cons([1,R],car(TD)); - Dumb[0]=cons(WL,Dumb[0]); - } - else Dumb[0]=cons(car(TD),Dumb[0]); - } - } - return red(R+S); - } - } - } - } -#endif - if((length(Var)==1||getopt(exe)==1) && /* p(x)*atan(q(x))^m+r(x), etc */ - findin((VT=car(Var))[1],[atan,asin,acos,log])>=0 && ptype(P,VT[0])==2 && - (VT[1]!=log||(T!=65&&T!=66)||mydeg(VT[2],X)!=1)){ /* exclude x*log(x+1)^2 */ - for(R=0,D=mydeg(P,VT[0]);D>=0;D--){ - Q=S=mycoef(P,D,VT[0]); - if(S){ - if(D>0){ - if((Q=integrate(S,X|mult=Mul))==[]) return Q; - }else{ - W[0]=[]; - if((Q=integrate(S,X|dumb=D2,var=VAR,mult=Mul))==[]) return Q; - if(type(Dumb)==5){ - TD=W[0]; - for(W0=[],TD=reverse(TD);TD!=[];TD=cdr(TD)){ - if(car(TD)[0][0]){ - WL=cons([1,R],car(TD)); - Dumb[0]=cons(WL,Dumb[0]); - } - else Dumb[0]=cons(car(TD),Dumb[0]); - } - if(car(Dumb[0])!=[[1,R],[1,Q]]) - Dumb[0]=cons([[1,R,Q]],Dumb[0]); - } - return red(R+Q); - } - }else if(D>0) continue; - if(D==0){ - if(Q!=0&&type(Dumb)==5) Dumb[0]=cons([[1,R,Q]],Dumb[0]); - return red(Q+R); - } - R0=Q*VT[0]^D; - P=(P0=P)-S*VT[0]^D-Q*diff(VT[0]^D,X); - if(mydeg(P,VT[0])>=D){ /* (x+1)*log(x)/x^2 */ - if(mydeg(P,VT[0])==D && - ptype(C=red(mycoef(P,D,VT[0])/diff(VT[0],X)),VT[0])<2){ - P=P0-(S*VT[0]^D+Q*diff(VT[0]^D,X)+C*diff(VT[0]^(D+1),X)/(D+1)); - R0+=C*VT[0]^(D+1)/(D+1); - }else{ - P=P0; - if(Dumb!=1) mycat(SM); - return []; - } - } - if(type(Dumb)==5){ - if(P) Dumb[0]=cons([R?[1,R,R0]:[1,R0],[X,P]],Dumb[0]); - else if(R!=0) Dumb[0]=cons([[1,R,R0]],Dumb[0]); - } - R+=R0; - } - } - if(length(Var)==1 && (VT=car(Var))[1]==pow && mydeg(P,VT[0])==1 && (PT=ptype(VT[2],X))<4){ - PR=mycoef(P,0,VT[0]); - if(RR!=0){ - RR=integrate(RR,X|dumb=Dumb3,var=Var); - if(RR==[]) return RR; - } - PW=VT[3]; - if((D=mydeg(nm(V2=VT[2]),X))==2&&PT==2){ /* f(x)*(ax^2+bx+c)^(m/2)+r(x) */ - if(isint(2*PW)){ - C2=mycoef(V20=V2,2,X);F=1; - if((C21=sqrtrat(C2))==[]) return []; - if(imag(C21)!=0){ - if(real(C21)!=0) return []; - C21=C21/@i;F=-1; - } - if(type(C21)>3) return []; - P=subst(P,X,X/C21);VT=mysubst(VT,[X,X/C21]);V2=VT[2]; - C1=mycoef(V2,1,X)/F/2; - if(C1!=0){ - P=subst(P,X,X-C1);VT=mysubst(VT,[X,X-C1]);V2=VT[2]; - } - C0=mycoef(V2,0,X); - if((C01=sqrtrat(C0))==[]) return []; - if(imag(nm(C01))!=0){ - if(real(nm(C01))!=0) return []; - C01=C01/@i;G=-1; - }else G=1; - if(type(C01)>3||(F==-1&&G==-1)) return []; - Y=makenewv([P,VAR]|var=x); - if(F==-1){ /* (c^2-x^2)^(1/2) */ - Q=subst(P,VT[0],(C01*cos(Y))^(2*PW),X,YX=C01*sin(Y)) - *C01*cos(Y)/C21; - SY=(C21*X+C1);CY=V20;YY=asin(sqrt2rat((C21*X+C1)/C01|mult=1)); - }else if(G==-1){ /* (x^2-c^2)^(1/2) */ - Q=subst(P,VT[0],(C01*sin(Y)/cos(Y))^(2*PW),X,YX=C01/cos(Y)) - *C01*sin(Y)/cos(Y)^2/C21; - SY=V20;CY=1/(C21*X+C1);YY=acos(sqrt2rat(C01*(C21*X+C1)|mult=1)); - }else{ /* (x^2+c^2)^(1/2) */ - Q=subst(P,VT[0],(C01/cos(Y))^(2*PW),X,YX=C01*sin(Y)/cos(Y)) - *C01/cos(Y)^2/C21; - CY=V20; YY=atan(sqrt2rat((C21*X+C1)/C01|mult=1)); - } - if(Dumb==-1) mycat([C21*X+C1,"=",YX]); - else if(type(Dumb)==5) Dumb[0]=cons([[0,Y,C21*X+C1,YX]],Dumb[0]); - Q=sqrt2rat(Q); - QQ=red(substblock(nm(Q),sin(Y),sin(Y)^2,1-cos(Y)^2) - /substblock(dn(Q),sin(Y),sin(Y)^2,1-cos(Y)^2)); - if(cmpsimple(QQ,Q|comp=2)<0) Q=QQ; - QQ=red(substblock(nm(Q),cos(Y),cos(Y)^2,1-sin(Y)^2) - /substblock(dn(Q),cos(Y),cos(Y)^2,1-sin(Y)^2)); - if(cmpsimple(QQ,Q|comp=2)<0) Q=QQ; - if((Q=integrate(Q,Y|dumb=Dumb2,var=cons(X,Var)))==[]) return []; - Q=trig2exp(Q,Y|inv=cos(Y)); - for(V=vars(Q);V!=[];V=cdr(V)){ - FA=funargs(car(V)); - if(type(FA)==4&&FA[0]==log){ - QQ=trig2exp(FA[1],Y|inv=cos(Y)); - Q=mycoef(Q,0,car(V))+mycoef(Q,1,car(V))*log(QQ); - } - } - if(type(Dumb)==5) Dumb[0]=cons([[1,Q]],Dumb[0]); - if(F==-1) Q=subst(Q,sin(Y),SY/C01,cos(Y),CY^(1/2)/C01,Y,YY); - else if(G==-1){ - Q=red(subst(Q,sin(Y),SY^(1/2)*cos(Y)/C01)); - Q=red(subst(Q,cos(Y),C01*CY,Y,YY)); - }else{ - Q=red(subst(Q,sin(Y),(C21*X+C1)*cos(Y)/C01)); - Nm=substblock(nm(Q),cos(Y),C01^2/CY,cos(Y)^2); - Nm=subst(Nm,cos(Y),C01/CY^(1/2)); - Dn=substblock(dn(Q),cos(Y),C01^2/CY,cos(Y)^2); - Dn=subst(Dn,cos(Y),C01/CY^(1/2)); - Q=red(subst(Nm/Dn,Y,YY)); - } - if(findin(Y,vars(Q))>=0) return []; - for(R=[],Var=vars(Q);Var!=[];Var=cdr(Var)){ - VT=funargs(V=car(Var)); - if(type(VT)==4&&VT[0]==log&&ptype(VT[1],X)>60&&mydeg(Q,V)==1) - R=cons([mycoef(Q,1,V),V],R); - } - if(length(R)==2 && (R[0][0]==R[1][0]||R[0][0]+R[1][0]==0)){ - R0=args(R[0][1])[0];R1=args(R[1][1])[0]; - if(R[0][0]==R[1][0]) S=R0*R1; - else S=R1/R0; - Q=mycoef(Q,0,R[0][1]);Q=mycoef(Q,0,R[1][1]); - Q+=R[1][0]*log(red(S)); - } - for(Var=vars(Q);Var!=[];Var=cdr(Var)){ - VT=funargs(car(Var)); - if(type(VT)==4&&VT[0]==log&&ptype(VT[1],X)>60){ - S=trig2exp(VT[1],X|inv=cos(X),arc=1); - if(ptype(dn(S),X)<2 && mydeg(Q,car(Var))==1 - && ptype(mycoef(Q,1,car(Var)),X)<2){ - S=nm(S); - SF=fctr(S); - S/=SF[0][0]; - } - if(cmpsimple(S,-S)>0) S=-S; - Q=subst(Q,car(Var),log(S)); - } - } /* x/(1-x^2)^(1/2) */ - if(type(Q=red(Q+RR))==2&&type(Dumb)!=5) Q-=cterm(Q); - if(Dumb==-1) mycat(["->",Q]); - else if(type(Dumb)==5) Dumb[0]=cons([[1,Q]],Dumb[0]); - return Q; - } - }else if(D==1 && mydeg(Dn=dn(V2),X)<2 && type(PW)==1 && ntype(PW)==0 && - (V2!=X||ptype(mycoef(P,1,VT[0]),X)>2)){ /* p(x)((ax+b)/(cx+d))^(m/n) */ - PN=nm(PW);PD=dn(PW); - Y=makenewv([P,VAR]|var=x);Q=Y^PD*Dn-nm(V2);F=-mycoef(Q,0,X)/mycoef(Q,1,X); - Q=red(subst(P,VT[0],Y^PN,X,F)*diff(F,Y)); - if(Dumb==-1) mycat([Y,"=",V2^(1/PD)]); - else if(type(Dumb)==5) Dumb[0]=cons([[0,Y,V2^(1/PD)]],Dumb[0]); - if((Q=integrate(Q,Y|dumb=Dumb3,var=cons(X,Var)))==[]) return []; - Q=red(Q); - QN=subst(substblock(nm(Q),Y,Y^PD,V2),Y,V2^(1/PD)); - QD=subst(substblock(dn(Q),Y,Y^PD,V2),Y,V2^(1/PD)); - Q=red(QN/QD+RR); - if(Dumb==-1) mycat(["->",Q]); - else if(type(Dumb)==5) Dumb[0]=cons([[1,Q]],Dumb[0]); - return Q; - } - }else if(length(Var)==2 && /* r(x,(ax+b)^(1/2),(cx+d)^(1/2)) */ - (VT=car(Var))[1]==pow && ptype(VT[2],X)==1 && mydeg(VT[2],X)==1 && VT[3]==1/2 && - (VS=car(car(Var)))[1]==pow && ptype(VS[2],X)==1 && mydeg(VS[2],X)==1 && VS[3]==1/2){ - Y=makenewv([P,VAR]|var=x);R=(Y^2-myceof(VS[0],0,X))/(C=mycoef(VS[0],1,X)); - if(Dumb==-1) mycat([Y,"=",VS[0]]); - else if(type(Dumb)==5) Dumb[0]=cons([[0,Y,VD[0]]],Dumb[0]); - R=integrate(subst(P,VS[0],Y,X,R)*2*Y/C,Y|dumb=Dumb3,var=cons(X,Var)); - if(R!=[]){ - R=subst(substblock(R,Y,VS[0],Y^2),Y,VS[0]); - if(Dumb==-1) mycat(["->",R]); - else if(type(Dumb)==5) Dumb[0]=cons([[1,R]],Dumb[0]); - } - return R; - } - if(T==65||T==66){ /* polynomial including sin, exp etc */ - for(F=0,VT=Var;VT!=[];VT=cdr(VT)){ - VTT=car(VT); - if(ptype(VTT[2],X)>2||mydeg(VTT[2],X)>1) F=ior(F,256); /* compos. or rat. or nonlin. */ - K=findin(VTT[1],[cos,sin,tan,exp,log,pow]); - F=ior(F,2^(K+1)); /* 1:other,2:cos,4:sin,8:tan,16:exp,32:log,64:pow */ - if((Deg=mydeg(P,VTT[0]))>1&&K!=4) F=ior(F,1024); /* nonlinear */ - if(K==5 && (ptype(VTT[3],X)!=0 || VTT[2]!=x||Deg>1)) F=ior(F,8192); /* pow */ - for(;Deg>0;Deg--){ /* coef */ - if(ptype(mycoef(P,Deg,VTT[0]),X)>2){ - if(K==4||K==5) F=ior(F,2048); /* exp, log */ - else F=ior(F,4096); - } - } - } - if(!iand(F,1+8+64+256+512+2048+8192)){ /* cos,sin,exp,log^n,x^c */ - if(iand(F,1024+4096)&&!iand(F,32+64)){ /* cos,sin,exp */ - if(type(Dumb)==5){ - S=trig2exp(P,X|inv=1); - if(P!=S) Dumb[0]=cons([[X,S]],Dumb[0]); - } - R=integrate(trig2exp(P,X),X); - if(R!=[]) S=trig2exp(R,X|inv=1); - R=fshorter(S,X); - if(type(Dumb)==5&&R!=S){ - Dumb[0]=cons([[1,S]],Dumb[0]); - } - return R; - } - for(R=0,VT=Var;VT!=[];VT=cdr(VT)){ - CV=car(VT); - C0=mycoef(CV[2],0,X);C1=mycoef(CV[2],1,X); - Q=mycoef(P,1,CV[0]); - if(CV[1]==sin||CV[1]==cos){ - TR=(CV[1]==sin)?intpoly(Q,X|sin=C1):intpoly(Q,X|cos=C1); - R+=TR[0]*cos(CV[2])+TR[1]*sin(CV[2]); - }else if(CV[1]==exp){ - QT=exp(CV[2]); - for(V2=vars(C1);V2!=[];V2=cdr(V2)){ /* exp(2*log(a)*x) => a^(2*x) */ - if(vtype(VA=car(V2))==2&&functor(VA)==log){ - if(ptype(C1,VA)!=2||mydeg(C1,VA)==1&&mycoef(C1,0,VA)==0){ - QT=args(VA)[0]^(red(C1/VA)*X); - if(C0!=0) QT*=exp(C0); - break; - } - } - } - R+=intpoly(Q,X|exp=C1)*QT; - }else if(CV[1]==pow) - R+=intpoly(Q,X|pow=CV[2])*x^CV[2]; - else if(CV[1]==log){ - for(Deg=mydeg(P,CV[0]);Deg>0; Deg--){ - Q=mycoef(P,Deg,CV[0]); - TR=intpoly(Q,X|log=[C1,C0,Deg]); - for(I=0;TR!=[];I++,TR=cdr(TR)){ - if(I==Deg) R+=car(TR)-subst(car(TR),X,0); - else R+=car(TR)*CV[0]^(Deg-I); - } - } - } - P=mycoef(P,0,CV[0]); - } - R+=intpoly(P,X); - return R; - } - } - for(K=0,VX=[],VT=Var;VT!=[];VT=cdr(VT)){ /* contain only both pow and trig */ - VTT=car(VT); - if(findin(VTT[1],[cos,sin,tan])>=0){ - if(ptype(VTT[2],X)!=2||mydeg(VTT[2],X)!=1) break; - VX=cons(VTT,VX); - }else if(VTT[1]==pow) K=1; - else break; - } - if(VT==[]&&K==1&&VX!=[]){ - D=VX[0][2]; - if(VX[0][1]==tan) D*=2; - for(VT=cdr(VX);VT!=[];VT=cdr(VT)){ - K=VT[0][2]/D; - if(VT[0][1]==tan) K*=2; - if(type(K)!=1||ntype(K)!=0) break; - D/=dn(K); - } - if(VT==[]){ - Y=makenewv([P,VAR]|var=x); - for(Q=P,VT=VX;VT!=[];VT=cdr(VT)){ - VTT=car(VT); - if(VTT[1]==cos||VTT[1]==sin){ - VV=trig2exp(VTT[0],X|inv=cos(D)); - VV=subst(VV,cos(D),(1-Y^2)/(1+Y^2),sin(D),2*Y/(Y^2+1)); - }else if(VTT[1]==tan){ - VV=trig2exp(VTT[0],X|inv=tan(D/2)); - VV=subst(VV,tan(D),Y); - } - Q=subst(Q,VTT[0],VV); - } - Q*=2/(Y^2+1); - if(diff(Q,X)==0){ - if(Dumb==-1) mycat([Y,"=",tan(D/2)]); - else if(type(Dumb)==5) Dumb[0]=cons([[0,Y,tan(D/2)]],Dumb[0]); - R=integrate(Q,Y|dumb=Dumb2,var=cons(X,Var)); - if(R!=[]){ - if(Dumb==-1) mycat(["->",R]); - else if(type(Dumb)==5) Dumb[0]=cons([[1,R]],Dumb[0]); - return sqrt2rat(subst(R,Y,tan(D/2))|mult=1); - } - } - } - } - if(T>65||iand(F,8)){ /* rational for functions or tan */ - if(findin(X,vars(P))<0){ - for(XV=XE=0,VT=Var;VT!=[];VT=cdr(VT)){ - VTT=car(VT); - if(mydeg(VTT[2],X)!=1) break; - if(VTT[1]==cos||VTT[1]==sin||VTT[1]==tan){ - K=red(VTT[2]/X); - if(type(K)>1||ntype(K)>0) break; - if(XV==0) XV=K; - else XV/=dn(K/XV); - if(VTT[1]==tan) P=red(subst(P,VTT[0],sin(VTT[2])/cos(VTT[2]))); - }else if(VTT[1]==exp){ - K=red(VTT[2]/X); - if(type(K)>1||ntype(K)>0) break; - if(XE==0) XE=K; - else XE/=dn(K/XE); - }else break; - } - if(VT==[]&&XE*XV==0){ - if(XE){ - if(XE<0) XE=-XE; - Y=makenewv([P,VAR]|var=x); - for(F=0,VT=Var;VT!=[];VT=cdr(VT),F++){ - VTT=car(VT);C=red(VTT[2]/X/XE); - P=subst(P,VTT[0],Y^C); - if(!F){ - if(Dumb==-1) mycat([Y^C,"=",VTT[0]]); - else if(type(Dumb)==5) Dumb[0]=cons([[0,Y^C,VTT[0]]],Dumb[0]); - } - } - P/=XE*Y; - Q=integrate(P,Y|dumb=Dumb3,var=cons(X,VAR)); - if(Q==[]) return []; - Q=subst(Q,Y,exp(XE*X)); - Q=trig2exp(Q,X); - if(Dumb==-1) mycat(["->",Q]); - else if(type(Dumb)==5) Dumb[0]=cons([[1,Q]],Dumb[0]); - return Q; - } - P=trig2exp(nm(P),X|inv=cos(XV*X))/trig2exp(dn(P),X|inv=cos(XV*X)); - Y=makenewv([P,VAR]|var=x); - Q=red(subst(P,sin(XV*X),Y*cos(XV*X))); - Q=substblock(nm(Q),cos(XV*X),cos(XV*X)^2,1/(Y^2+1))/ - (substblock(dn(Q),cos(XV*X),cos(XV*X)^2,1/(Y^2+1))*(Y^2+1)); - Q=red(Q); - if(ptype(Q,X)<2){ - XV*=2;P=Q; - }else{ - P=subst(P,cos(XV*X),(1-Y^2)/(1+Y^2),sin(XV*X),2*Y/(1+Y^2))*2/K/(1+Y^2); - P=red(P); - } - if(Dumb==-1){ - mycat([Y,"=",tan(XV*X/2)]); - mycat(["integrate",P]); - }else if(type(Dumb)==5) Dumb[0]=cons([[Y,P]],cons([[0,Y,tan(XV*X/2)]],Dumb[0])); - R=intpoly(P,Y|dumb=Dumb); - if(R==[]) return R; - if(Dumb==-1) mycat(["->",R]); - else if(type(Dumb)==5) Dumb[0]=cons([[1,R]],Dumb[0]); - for(Log=1,K=0,Var=pfargs(RR=R,Y);Var!=[];Var=cdr(Var)){ - VTT=car(Var); - if(VTT[1]==log){ - C=mycoef(R,1,VTT[0]); - VT2=VTT[2]; - if(K==0){ - K=C;Log=VT2; - if(K<0){ - K=-K;Log=1/Log; - } - }else{ - if((V=red(C/K))<0){ - VT2=1/VT2;V=-V; - } - if(type(V)>1||ntype(V)>0){ - Log=1;break; - } - if(isint(V)) Log*=VT2^V; - else{ - D=dn(V);K/=D; - Log=Log^D*VT2^nm(V); - } - } - RR=mycoef(RR,0,VTT[0]); - } - } - if(Log!=1){ - R=RR; - if(type(Dumb)==5){ - if(RR) Dumb[0]=cons([[1,K*log(Log),RR]],Dumb[0]); - else Dumb[0]=cons([[1,K*log(Log)]],Dumb[0]); - } - Log=red(subst(red(Log),Y,sin(XV*X/2)/cos(XV*X/2))); - Log=fshorter(Log,X|log=1); /* log(cos(2*x)+1)=-2*log(cos(x)) */ - Nm=fctr(nm(Log)); - for(T=[];Nm!=[];Nm=cdr(Nm)){ - if(ptype(car(Nm)[0],X)>1) T=cons(car(Nm),T); - } - Nm=fctr(dn(Log)); - for(;Nm!=[];Nm=cdr(Nm)){ - if(ptype(car(Nm)[0],X)>1) T=cons([car(Nm)[0],-car(Nm)[1]],T); - } - for(I=0,Nm=T;T!=[];T=cdr(T)){ - if(I=0) I=abs(car(T)[1]); - else I=igcd(I,car(T)[1]); - } - for(Log=1;Nm!=[];Nm=cdr(Nm)) Log*=car(Nm)[0]^(car(Nm)[1]/I); - K*=I; - if(cmpsimple(nm(Log),dn(Log))<0){ - K=-K;Log=red(1/Log); - } - Log=K*log(Log); - if(type(Dumb)==5){ - if(RR) Dumb[0]=cons([[1,Log,RR]],Dumb[0]); - else Dumb[0]=cons([[1,Log]],Dumb[0]); - } - }else Log=0; - for(Atan=0,Var=pfargs(RR=R,Y);Var!=[];Var=cdr(Var)){ - VTT=car(Var); - if(VTT[1]==atan){ - W=subst(VTT[2],Y,sin(XV*X/2)/cos(XV*X/2)); - W=trig2exp(W,X|inv=1); - V2=funargs(dn(W)); - if(type(V2)==4&&length(V2)==2){ - V3=V2[1]*mycoef(R,1,VTT[0]); - Z=0; - if(V2[0]==cos) - Z=red(W*cos(V2[1])/sin(V2[1])); - else if(V2[0]==sin){ - Z=red(W*sin(V2[1])/cos(V2[1])); - V3=-V3; - } - if(Z==1){ - Atan+=V3;W=0; - }else if(Z==-1){ - Atan-=V3;W=0; - } - } - R0=mycoef(R,0,VTT[0]); - if(W!=0) Atan+=subst(R-R0,VTT[0],atan(W)); /* atan(W); */ - R=R0; - } - } - if(R!=0){ - R=subst(R,Y,sin(XV*X/2)/cos(XV*X/2)); - R=red(R); - R=trig2exp(nm(R),X|inv=1)/trig2exp(dn(R),X|inv=1); - } - if(type(Dumb)==5){ - F=0;WL=[]; - if(R){ - WL=cons(R,WL); - F++; - } - if(Atan){ - WL=cons(Atan,WL); - F++; - } - if(Log){ - WL=cons(Log,WL); - F++; - } - WL=cons(1,WL); - if(F>1) Dumb[0]=cons([WL],Dumb[0]); - } - R=red(R+Log+Atan); - if(Dumb==-1) mycat(["->",R]); - else if(type(Dumb)==5) Dumb[0]=cons([[1,R]],Dumb[0]); - return fshorter(R,X); - } - } - } - VT=pfargs(Q=P,X|level=1); - V=(iand(ptype(P,X),7)<3)?[X]:[]; - for(;VT!=[];VT=cdr(VT)) - if(ptype(P,car(VT)[0])<3) V=cons(car(VT)[0],V); - if(length(V)>0){ /* 1/x+tan(x)+... etc.: sums */ - for(R=0;V!=[];V=cdr(V)){ - T=mycoef(Q,0,car(V)); - W[0]=[]; - S=integrate(TD=red(Q-T),X|dumb=D2,mult=Mul,exe=1); - if(S==[]) continue; - if(type(Dumb)==5){ - WL=0; - if(T!=0) WL=[[X,TD,T]]; - if(R!=0) WL=cons([1,R],WL); - if(WL) Dumb[0]=cons(WL,Dumb[0]); - TD=W[0]; - if(R!=0||T!=0){ - for(W0=[],TD=reverse(TD);TD!=[];TD=cdr(TD)){ - if(car(TD)[0][0]){ - WL=(!T)?[]:[[X,T]]; - WL=append(car(TD),WL); - if(R!=0) WL=cons([1,R],WL); - }else WL=car(TD); - Dumb[0]=cons(WL,Dumb[0]); - } - }else Dumb[0]=append(TD,Dumb[0]); - } - R+=S;Q=T; - if(!Q) return red(R); - } - W[0]=[]; - if(P!=Q&&type(S=integrate(Q,X|dumb=D2,mult=Mul))<4){ - RR=red(R+S); - if(type(Dumb)==5){ - TD=W[0]; - for(W0=[],TD=reverse(TD);TD!=[];TD=cdr(TD)){ - if(car(TD)[0][0]){ - WL=cons([1,R],car(TD)); - Dumb[0]=cons(WL,Dumb[0]); - } - else Dumb[0]=append(TD,Dumb[0]); - } - if(nmono(R)+nmono(S)!=nmono(RR)) Dumb[0]=cons([[1,R,S]],Dumb[0]); - } - return RR; - } - } - if(Dumb!=1) mycat(SM); - return []; -} - -def fimag(P) -{ - for(V=vars(P);V!=[];V=cdr(V)){ - Q=[]; - if(vtype(VF=car(V))==2){ - VAA=args(VF); - if(VAA==[]) continue; - VA=sqrt2rat(VAA[0]); - if(functor(VF)==exp){ - if(imag(VA)!=0){ - R=(real(VA)!=0)?exp(real(VA)):1; - Q=subst(P,VF,R*(cos(imag(VA))+sin(imag(VA))*@i)); - } - }else if(functor(VF)==pow){ - VA=sqrt2rat(VAA[1]); - if(imag(VA)!=0){ - R=(real(VA)!=0)?VAA[0]^(real(VA)):1; - L=(VAA[0]!=@e)?log(VAA[0]):1; - Q=subst(P,VAA[0]^(VAA[1]),R*(cos(L*imag(VA))+sin(L*imag(VA))*@i)); - }else if(VAA[1]!=(V0=fimag(VA))) - Q=subst(P,VAA[0]^(VAA[1]),VAA[0]^(V0)); - } - V0=VA; - if(length(VAA)==1&&(VAA[0]!=V0||VA!=(V0=fimag(VA)))) - Q=subst(P,VF,subst(VF,VAA[0],V0)); - } - if(Q!=[]&&P!=Q){ - P=Q;V=cons(0,vars(P)); - } - } - return P; -} - - -def trig2exp(P,X) -{ - if(iand(ptype(P,X),128)){ - OL=getopt(); - Nm=trig2exp(nm(P),X|option_list=OL); - Dn=trig2exp(dn(P),X|option_list=OL); - R=red(Nm/Dn); - if(getopt(arc)==1) return sqrt2rat(R); - } - if((Inv=getopt(inv))==1||type(Inv)==2){ - for(VT=T=vars(P);T!=[];T=cdr(T)){ - if(findin(functor(car(T)),[cos,sin,tan])>=0){ - P=trig2exp(P,X);VT=vars(P);break; - } - } - for(;VT!=[];VT=cdr(VT)){ - if(functor(CT=car(VT))==exp){ - if((Re=real(args(CT)[0]))!=0){ - if(isint(Re)) S=@e^Re; - else S=exp(Re); - }else S=1; - if((Im=imag(args(CT)[0]))!=0){ - Q=nm(Im);Q=mycoef(Q,mydeg(Q,X),X); - if(-Q>Q) S*=cos(-Im)-@i*sin(-Im); - else S*=cos(Im)+@i*sin(Im); - } - P=subst(P,CT,S); - } - } - P=red(P); - U=vars(Inv); - if(length(U)!=1||((F=functor(car(U)))!=sin&&F!=cos&&F!=tan)) return P; - XX=args(car(U))[0]; - if(mydeg(XX,X)!=1) return P; - if(!isvar(XX)) P=subst(P,X,(X-mycoef(XX,0,X))/mycoef(XX,1,X)); - for(VT=vars(P);VT!=[];VT=cdr(VT)){ - if(vtype(CT=car(VT))<2) continue; - TX=args(CT)[0]; - if(mydeg(TX,X)!=1) continue; - if(!isint(C1=mycoef(TX,1,X))) continue; - if((C0=mycoef(TX,0,X))==0){ - CC=1;CS=0; - }else if(vars(C0)==[@pi]){ - CC=myval(cos(C0)); - if(CC!=0&&type(CC)==1&&ntype(CC)!=0){ - CC=cos(C0);CS=sin(C0); - }else CS=myval(sin(C0)); - }else{ - CC=cos(C0);CS=sin(C0); - } - K=C1; - if(K<0) K=-K; - for(CC1=0,I=K;I>=0;I-=2) CC1+=(-1)^((K-I)/2)*binom(K,I)*cos(X)^I*sin(X)^(K-I); - for(CS1=0,I=K-1;I>=0;I-=2) CS1+=(-1)^((K-I-1)/2)*binom(K,I)*cos(X)^I*sin(X)^(K-I); - if(C1<0) CS1=-CS1; - if((TF=functor(CT))==cos) P=subst(P,cos(TX),CC1*CC-CS1*CS); - else if(TF==sin) P=subst(P,sin(TX),CS1*CC+CC1*CS); - } - if(F==sin) - P=substblock(P,cos(X),cos(X)^2,1-sin(X)^2); - else{ - P=substblock(P,sin(X),sin(X)^2,1-cos(X)^2); - if(F==tan){ - P=subst(P,sin(X),cos(X)*tan(X)); - P=substblock(P,cos(X),cos(X)^2,1/(tan(X)^2+1)); - } - } - if(!isvar(XX)) P=subst(P,X,XX); - - if(getopt(arc)==1){ - for(VT=vars(P);VT!=[];VT=cdr(VT)){ - FA=funargs(car(VT)); - if(type(FA)==4&&(FA[0]==cos||FA[0]==sin)&&ptype(FA[1],X)>60){ - VTT=vars(FA[1]); - if(type(FA[1])!=2||length(VTT)!=1) break; - FB=funargs(VTT[0]); - if(type(FB)!=4||(FF=findin(FB[0],[asin,acos,atan]))<0) break; - if(!isint(2*(C=mycoef(FA[1],1,VTT[0])))||mycoef(FA[1],0,VTT[0])!=0) break; - if(C==1/2){ - if(FF==1){ - U=(FA[0]==cos)?(1+FB[1])/2:(1-FB[1])/2; - P=subst(P,car(VT),red(U)^(1/2)); - }else if(FF==2){ - if(FA[0]==sin){ - FB1=red(FB[1]); - Nm=nm(FB1);CC=fctr(Nm)[0][0];Dn=dn(FB1); - if(CC<0) CC=-CC; - Nm/=CC;Dn/=CC; - NN=Nm^2+Dn^2; - P=subst(P,car(VT),((NN)^(1/2)-Dn)/Nm*cos(FA[1])); - } - } - P=red(P); - }else if(C==1){ - if(FF==1){ - if(FA[0]==cos) P=subst(P,car(VT),FB[1]); - else P=subst(P,car(VT),(1-FB[1])^(1/2)); - }else if(FF==0){ - if(FA[0]==sin) P=subst(P,car(VT),FB[1]); - else P=subst(P,car(VT),(1-FB[1])^(1/2)); - } - P=red(P); - } - } - } - P=sqrt2rat(P); - } - return red(P); - } - Var=pfargs(P,X); - for(VT=Var;VT!=[];VT=cdr(VT)){ - CT=car(VT); - if(CT[1]==cos) - P=subst(P,CT[0],exp(CT[2]*@i)/2+exp(-CT[2]*@i)/2); - else if(CT[1]==sin) - P=subst(P,CT[0],exp(-CT[2]*@i)*@i/2-exp(CT[2]*@i)*@i/2); - else if (CT[1]==tan) - P=subst(P,CT[0],(exp(-CT[2]*@i)*@i-exp(CT[2]*@i)*@i)/(exp(CT[2]*@i)+exp(-CT[2]*@i))); - else if(CT[1]==pow){ - if(ptype(CT[2],X)>1) continue; - if(CT[2]==@e) P=subst(P,CT[0],exp(CT[3])); - else P=subst(P,CT[0],exp(log(CT[2])*exp(CT[3]))); - } - } - P=red(P); - for(PP=1,Lp=(dn(P)==1)?1:0;Lp<2;Lp++){ - PP=1/PP; - U=(Lp==0)?dn(P):nm(P); - if(U==1) continue; - Var=vars(U); - for(R=[],VT=Var;VT!=[];VT=cdr(VT)) - if(functor(car(VT))==exp) R=cons(car(VT),R); - RR=os_md.terms(U,R); - for(Q=0,RRT=RR;RRT!=[];RRT=cdr(RRT)){ - for(S=0,CT=cdr(car(RRT)),CR=R,UT=U;CR!=[];CR=cdr(CR),CT=cdr(CT)){ - UT=mycoef(UT,car(CT),car(CR));S+=car(CT)*args(car(CR))[0]; - } - if(S==0) Q+=UT; - else Q+=UT*exp(S); - } - PP*=Q; - } - return PP; -} - -def powsum(N) -{ - if (N < 0) return 0; - if (N == 0) return x; - P = intpoly(N*powsum(N-1),x); - C = subst(P,x,1); - return P+(1-C)*x; -} - -def bernoulli(N) -{ - return mydiff(powsum(N),x) - N*x^(N-1); -} - -/* linfrac01([x,y]) */ -/* linfrac01(newvect(10,[0,1,2,3,4,5,6,7,8,9]) */ -/* 0:x=0, 1:x=y, 2:x=1, 3:y=0, 4:y=1, 5:x=\infty, 6:y=\infty, 7:x=y=0, 8:x=y=1, 9:x=y=\infty - 10:y_2=0, 11:y_2=x, 12:y_2=y, 13: y_2=1, 14: y_2=\infty - 15:y_3=0, 16:y_3=x, 17:y_3=y, 18: y_3=y_2, 19: y_3=1, 20:y_3=\infty - X[0],X[11],X[2],X[10],X[13],X[5],X[14],X[7],X[8],X[9], - X[3],X[1],X[12],X[4],X[6] - - T=0 (x_2,x_1,x_3,x_4,...) - T=-j (x_1,x_2,..,x_{j-1},x_{j+1},x_j,x_{j+2},...) - T=1 (1-x_1,1-x_2,1-x_3,1-x_4,...) - T=2 (1/x_1,1/x_2,1/x_3,1/x_4,...) - T=3 (x_1,x_1/x_2,x_1/x_3,x_1/x_4,...) -*/ - -def lft01(X,T) -{ - MX=getopt(); - if(type(X)==4){ - K=length(X); - if(K>=1) D=1; - } - if(type(X)==5){ - K=length(X); - for(J=5, F=K-10; F>0; F-=J++); - if(F==0) D=2; - } - if(D==0) return 0; - if(T==0){ /* x <-> y */ - if(D==1){ - R=cdr(X); R=cdr(R); - R=cons(X[0],R); - return cons(X[1],R); - } - R=newvect(K,[X[3],X[1],X[4],X[0],X[2],X[6],X[5]]); - for(I=7;I<K;I++) R[I]=X[I]; - for(I=11,J=5; I<K; I+=J++){ - R[I]=X[I+1]; R[I+1]=X[I]; - } - return R; - } - if(T==1){ - if(D==1){ - for(R=[];X!=[];X=cdr(X)) R=cons(1-car(X),R); - return reverse(R); - } - R=newvect(K,[X[2],X[1],X[0],X[4],X[3],X[5],X[6],X[8],X[7],X[9]]); - for(I=11;I<K;I++) R[I]=X[I]; - for(I=10, J=5; I<K; I+=J++){ - R[I]=X[I+J-2]; R[I+J-2]=X[I]; - } - return R; - } - if(T==2){ - if(D==1){ - for(R=[]; X!=[]; X=cdr(X)) R=cons(red(1/car(X)),R); - return reverse(R); - } - R=newvect(K,[X[5],X[1],X[2],X[6],X[4],X[0],X[3],X[9],X[8],X[7]]); - for(I=11;I<K;I++) R[I]=X[I]; - for(I=10,J=5; I<K; I+=J++){ - R[I]=X[I+J-1]; R[I+J-1]=X[I]; - } - return R; - } - if(T==3){ - if(D==1){ - T=car(X); - for(R=[T],X=cdr(X); X!=[]; X=cdr(X)) - R=cons(red(T/car(X)),R); - return reverse(R); - } - R=newvect(K,[X[7],X[4],X[2],X[6],X[1],X[9],X[3],X[0],X[8],X[5]]); - for(I=10,J=5; I<K; I+=J++){ - R[I]=X[I+J-1]; R[I+1]=X[I+J-2]; R[I+J-2]=X[I+1]; R[I+J-1]=X[I]; - } - return R; - } - if(T==-1){ - if(D==1){ - return append([X[1],X[2],X[0]],cdr(cdr(cdr(X)))); - } - R=newvect(K,[X[0],X[11],X[2],X[10],X[13],X[5],X[14],X[7],X[8],X[9], - X[3],X[1],X[12],X[4],X[6]]); - for(I=11;I<K;I++) R[I]=X[I]; - for(I=17,J=5; I<K; I+=J++){ - R[I]=X[I+1]; R[I+1]=X[I]; - } - return R; - } - if(T<0){ - if(D==1){ - for(R=[],I=0; X!=[]; X=cdr(X),I--){ - if(I==T){ - R=cons(X[1],R); - R=cons(X[0],R); - X=cdr(X); - } - else R=cons(car(X),R); - } - return reverse(R); - } - T=3-T; - R=newvect(K); - for(I=0;I<K;I++) R[I]=X[I]; - for(I=10,J=5;J<T;I+=J++); - for(II=0; II<J-2; II++){ - R[I]=X[I+J]; R[I+J]=R[I]; - } - for( ; II<J; II++){ - R[I]=X[I+J+1]; R[I+J+1]=X[I]; - } - return R; - } - return 0; -} - -def linfrac01(X) -{ - if(type(X)==4) K=length(X)-2; - else if(type(X)==5){ - L=length(X); - for(K=0,I=10,J=5; I<L; K++,I+=J++); - if(I!=L) return 0; - } - if(K>3 && getopt(over)!=1) return(-1); - II=(K==-1)?3:4; - for(CC=C=1,L=[X]; C!=0; CC+=C){ - for(F=C,C=0,R=L; F>0; R=cdr(R), F--){ - P=car(R); - for(I=-K; I<II; I++){ - S=lft01(P,I); - if(findin(S,L) < 0){ - C++; L=cons(S,L); - } - } - } - } - return L; -} - - -def varargs(P) -{ - if((All=getopt(all))!=1&&All!=2) All=0; - V=vars(P); - for(Arg=FC=[];V!=[];V=cdr(V)){ - if(vtype(CV=car(V))==0&&All!=0){ - Arg=lsort([CV],Arg,0); - } - if(vtype(CV)!=2) continue; - if(findin(F=functor(CV),FC)<0) FC=cons(F,FC); - for(AT=vars(args(CV));AT!=[];AT=cdr(AT)){ - if(vtype(X=car(AT))<2){ - if(findin(X,Arg)<0) Arg=cons(X,Arg); - }else if(vtype(X)==2){ - R=varargs(X); - if(R[1]!=[]){ - Arg=lsort(R[1],Arg,0); - FC=lsort(R[0],FC,0); - } - } - } - } - Arg=reverse(Arg); - return (All==2)?Arg:[reverse(FC),Arg]; -} - -def pfargs(P,X) -{ - if(type(L=getopt(level))!=1) L=0; - for(Var=[],V=vars(P);V!=[];V=cdr(V)){ - if(vtype(car(V))==2){ - VT=funargs(car(V)); - if(length(VT)>1){ - if(L<2 &&(ptype(VT[1],X)>1 || (length(VT)>2 && ptype(VT[2],X)>1))) - Var=cons(cons(car(V),VT),Var); - if(L!=1 && (R=pfargs(VT[1],X|level=L-1))!=[]) Var=append(R,Var); - } - } - } - return reverse(Var); -} - -def ptype(P,L) -{ - if((T=type(P))<2 || T>3) return T; - if(type(L)!=4) L=[L]; - F=0; - if(lsort(L,varargs(dn(P))[1],2)!=[]) F=128; - if(lsort(L,varargs(nm(P))[1],2)!=[]) F+=64; - if(lsort(L,vars(dn(P)),2)!=[]) return F+3; - return (lsort(L,vars(nm(P)),2)==[])?(F+1):(F+2); -} - -def nthmodp(X,N,P) -{ - X=X%P; - for(Z=1;;){ - if((W=iand(N,1))==1) Z=(Z*X)%P; - if((N=(N-W)/2)<=0) return Z; - X=irem(X*X,P); - } -} - -def issquaremodp(X,P) -{ - N=getopt(power); - if(!isint(N)) N=2; - if(P<=1 || !isint(P) || !pari(ispsp,P) || !isint(X) || !isint(N) || N<1){ - errno(0); - return -2; - } - M=(P-1)/igcd(N,P-1); - if((X%=P) == 0) return 0; - if(X==1 || M==P-1) return 1; - return (nthmodp(X,M,P)==1)?1:-1; -} - -def iscoef(P,F) -{ - if(P==0) return 1; - if(type(P)==1) return F(P); - if(type(P)==2) { - X=var(P); - for(I=deg(P,X); I>=0; I--){ - if(!iscoef(mycoef(P,I,X),F)) return 0; - } - }else if(type(P)==3){ - if(!iscoef(nm(P),F)||!iscoef(dn(P),F)) return 0; - }else if(type(P)==4){ - for(;P!=[];P=cdr(P)) if(!iscoef(P,F)) return 0; - }else if(type(P)>4 && type(P)<7) return iscoef(m2l(PP),F); - else return 0; - return 1; -} - -def rootmodp(X,P) -{ - X%=P; - if(X==0) return [0]; - N=getopt(power); - PP=pari(factor,P); - P0=PP[0][0]; P1=PP[0][1]; - P2=pari(phi,P); - if(!isint(N)) N=2; - N%=P2; - if(P0==2 || size(PP)[0]>1){ - for(I=1,R=[]; I<P2; I++) - if(nthmodp(I,N,P)==X) R=cons(I,R); - return qsort(R); - } - Y=primroot(P); - if(Y==0) return 0; - Z=nthmodp(Y,N,P); - G=igcd(N,P2); - P3=P2/G; - for(I=0, W=1; I<P3;I++){ - if(W==X) break; - W=(W*Z)%P; - } - if(I==P3) return []; - W=nthmodp(Y,I,P); - Z=nthmodp(Y,P3,P); - for(I=0,R=[];;){ - R=cons(W,R); - if(++I>=G) break; - W=(W*Z)%P; - } - return qsort(R); -} - -def primroot(P) -{ - PP=pari(factor,P); - P0=PP[0][0]; P1=PP[0][1]; - S=size(PP); - if(S[0]>1 || !isint(P) || P0<=2){ - print("Not odd prime(power)!"); - return 0; - } - if(isint(Ind=getopt(ind))){ - Ind %= P; - if(Ind<=0 || igcd(Ind,P)!=1 || (Z=primroot(P))==0){ - print("Not exist!"); - return 0; - } - P2=P0^(P1-1)*(P0-1); - for(I=1,S=1; I<P2; I++) - if((S = (S*Z)%P) == Ind) return I; - return 0; - } - if(getopt(all)==1){ - I=primroot(P); - P2=P0^(P1-1)*(P0-1); - for(L=[],J=1; J<P2; J++){ - if(P1>1 && igcd(P0,J)!=1) continue; - if(igcd(P0-1,J)!=1) continue; - L=cons(nthmodp(I,J,P),L); - } - return qsort(L); - } - if(PP[0][1]>1){ - I=primroot(P0); - P2=P0^(P1-2)*(P0-1); - if(nthmodp(I,P2,P)==1) I+=P0; - return I; - } - F=pari(factor,P-1); - SF=size(F)[0]; - for(I=2; I<P; I++){ - for(J=0; J<SF; J++) - if(nthmodp(I,(P-1)/F[J][0],P)==1) break; - if(J==SF) return I; - } -} - -def rabin(P,X) -{ - for(M=0,Q=P-1;iand(Q,1)==0;M++,Q/=2); - Z=nthmodp(X,Q,P); - for(N=M;M>0&&Z!=1&&Z!=P-1;M--,Z=(Z*Z)%P); - return (M<N&&(M==0||Z==1))?0:1; -} - -def powprimroot(P,N) -{ - if(P<3) P=3; - FE=getopt(exp); - if(FE!=1) FE=0; - if((Log=getopt(log))==1||Log==2) FE=-1; - else if(Log==3){ - FE=-2; - for(PP=1, L0=["$r$","$p/a$"];;){ - PP=pari(nextprime,PP+1); - if(PP>=P) break; - L0=cons(PP, L0); - } - L0=reverse(L0); - } - if(FE==0) All=getopt(all); - for(I=0, PP=P, LL=[]; I<N; I++,PP++){ - PP=pari(nextprime,PP); - if(All==1){ - PR=primroot(PP|all=1); - LL=cons(cons(PP,PR),LL); - continue; - } - PR=primroot(PP); - if(FE==-2){ /* log=3 */ - LT=cdr(L0);LT=cdr(L0); - for(L=[PP];LT!=[];LT=cdr(LT)) - L=cons(primroot(PP|ind=car(LT)),L); - LL=cons(reverse(L),LL); - if(I<N-1) L0=append(L0,[PP]); - }else if(FE){ - for(J=1, L=[PP], K=1; J<PP; J++){ - if(FE==-1){ /* log=1,2 */ - K=primroot(PP|ind=J); - if(K==0 && Log==2) K=PP-1; - } - else K=(K*PR)%PP; /* exp=1 */ - L=cons(K,L); - } - LL=cons(reverse(L),LL); - }else - LL=cons([PP,PR],LL); /* default */ - } - LL=reverse(LL); - if(!FE) return LL; - PP--; - if(FE==-2) return append(LL,[L0]); - for(I=1,L=["$p$"];I<PP; I++) L=cons(I,L); - return cons(reverse(L),LL); -} - -def ntable(F,II,D) -{ - F=f2df(F|opt=-1); - Df=getopt(dif); - Str=getopt(str); - if(Df!=1) Df=0; - L=[]; - if(type(D)==4){ - if(type(II[0])==4){ - T1=II[0][1]-II[0][0];T2=II[1][1]-II[1][0]; - for(L0=[],I=0;I<D[0];I++){ - for(R=[],J=0;J<D[1];J++) - R=cons(myf2eval(F,II[0][0]+I*T1/D[0],II[1][0]+J*T2/D[1]),R); - L=cons(reverse(R),L);L0=cons(II[0][0]+I*T1/D[0],L0); - } - }else{ - for(T=II[1]-II[0],L0=[],I=0;I<D[0];I++){ - for(R=[],J=0;J<D[1];J++) - R=cons(myfdeval(F,II[0]+I*T/D[0]+J*T/D[0]/D[1]),R); - L=cons(reverse(R),L);L0=cons(II[0]+I*T/D[0],L0); - } - } - L=reverse(L);L0=reverse(L0); - if(type(Str)==4){ - L0=mtransbys(os_md.sint,L0,[Str[0]]|str=1,zero=0); - L=mtransbys(os_md.sint,L,[Str[1]]|str=1,zero=0); - if(Df==1){ - for(DT=[],RT=L,I=0;RT!=[];){ - for(LT=[],TT=car(RT);TT!=[];TT=cdr(TT)){ - VV=car(TT); - if((J=str_char(VV,0,"."))>=0){ - if(J==0) VV=str_cut(VV,1,10000); - else VV=str_cut(VV,0,J-1)+str_cut(VV,J+1,10000); - } - V1=eval_str(VV); - if(I++) LT=cons(V1-V0,LT); - V0=V1; - } - DT=cons(LT,DT); - if((RT=cdr(RT))==[]){ - VE=rint(myfdeval(F,II[1])*10^Str[1]); - DT=cons([VE-V0],DT); - } - } - for(I=0,D=[],TT=DT;TT!=[];TT=cdr(TT)){ - if(!I++) V=car(TT)[0]; - else{ - T1=reverse(cons(V,car(TT))); - V=car(T1); - if(length(TT)>1) T1=cdr(T1); - D=cons(T1,D); - } - } - for(DD=[],TT=D;TT!=[];TT=cdr(TT)) - DD=cons([os_md.lmin(car(TT)),os_md.lmax(car(TT))],DD); - DD=reverse(DD); - L=lsort(L,DD,"append"); - } - } - L=lsort(L,L0,"cons"); - if(type(Top=getopt(top))==4||getopt(TeX)==1){ - if(type(Top)==4){ - K=length(L[0])-length(Top); - if(K>0&&K<4){ - if(K>1){ - Top=append(Top,["",""]); - K-=2; - } - if(K) Top=cons("",Top); - } - L=cons(Top,L); - } - if(type(H=getopt(hline))!=4) H=[0,1,z]; - if(type(V=getopt(vline))!=4) V=[0,1,(DF)?z-2:z]; - if(type(T=getopt(title))!=7) Out=ltotex(L|opt="tab",hline=H,vline=V); - else Out=ltotex(L|opt="tab",hline=H,vline=V,title=T); - if(Df) Out=str_subst(Out,"\\hline","\\cline{1-"+rtostr(length(L[0])-2)+"}"); - return Out; - } - return L; - } - for(L=[],I=0;I<=D;I++){ - X=II[0]+I*T/D; - L=cons([X,myfdeval(F,X)],L); - } - if(Df==1){ - for(LD=[],LL=L;LL!=[];LL=cdr(LL)){ - if(LD==[]) LD=cons([car(LL)[0],car(LL)[1],0],LD); - else LD=cons([car(LL)[0],car(LL)[1],abs(car(LL)[1]-car(LD)[1])],LD); - } - L=reverse(LD); - } - if(type(Str)==4){ - if(length(Str)==1) Str=[Str[0],Str[0]]; - if(Df==1 && length(Str)==2) Str=[Str[0],Str[1],Str[1]]; - for(S=Str,Str=[];S!=[];S=cdr(S)){ - if(type(car(S))!=4) Str=cons([car(S),3],Str); - else Str=cons(car(S),Str); - } - Str=reverse(Str); - for(LD=[],LL=L;LL!=[];LL=cdr(LL)){ - for(K=[],J=length(Str); --J>=0; ) - K=cons(sint(car(LL)[J],Str[J][0]|str=Str[J][1]),K); - LD=cons(K,LD); - } - L=LD; - }else - L=reverse(L); - if(type(M=getopt(mult))==1){ - Opt=[["opt","tab"],["vline",[[0,2+Df]]],["width",-M]]; - if(type(T=getopt(title))==7) - Opt=cons(["title",T],Opt); - if(type(Tp=getopt(top))==4) - Opt=cons(["top",Tp],Opt); - L=ltotex(L|option_list=Opt); - } - return L; -} - -def distpoint(L) -{ - L=m2l(L|flat=1); - if(getopt(div)==5) Div=5; - else Div=10; - V=newvect(100/Div); - for(LT=L,LL=[],N=0; LT!=[]; LT=cdr(LT)){ - if(type(K=car(LT))>1||K<0){ - N++; continue; - } - LL=cons(K,LL); - T=idiv(K,Div); - if(Div==10 && T>=9) T=9; - else if(Div==5 && T>=19) T=19; - V[T]++; - } - V=vtol(V); - if((Opt=getopt(opt))=="data") return V; - Title=getopt(title); - OpList=[["opt","tab"]]; - if(type(Title=getopt(title)) == 7) - OpList=cons(["title",Title],OpList); - if(Opt=="average"){ - T=isMs()?["•½‹Ï“_","•W€•Î·","Å’á“_","Å‚“_","ŽóŒ±l”"]: - ["average","deviation","min","max","examinees"]; - L=average(LL); - L=[sint(L[0],1),sint(L[1],1),L[3],L[4],L[2]]; - if(N>0){ - T=append(T,[isMs()?"Œ‡ÈŽÒ":"absentees"]);L=append(L,[N]); - } - OpList=cons(["align","c"],OpList); - return ltotex([T,L]|option_list=OpList); - } - - if(getopt(opt)=="graph"){ - Mul=getopt(size); - if(Div==5){ - V0=["00","05","10","15","20","25","30","35","40","45","50","55", - "60","65","70","75","80","85","90","95"]; - if(type(Mul)!=4){ - Size = (TikZ)?[12,3,1/2,0.2]:[120,30,1/2,2]; - } - }else{ - V0=["00-","10-","20-","30-","40-","50-","60-","70-","80-","90-"]; - if(type(Mul)!=4){ - Size = (TikZ)?[8,3,1/2,0.2]:[80,30,1/2,2]; - } - } - return ltotex([V,V0]|opt="graph",size=Size); - } - if(Div==5) - V0=["00--04","05--09","10--14","15--19", "20--24", "25--29", "30--34", "35-39", - "40--44", "45--49","50--54", "55--59","60--64", "65--69", - "70--74", "75--79","80--84", "85--89","90--94", "95--100"]; - else - V0=["00--09","10--19","20--29","30--39","40--49","50--59","60--69", - "70--79","80--89","90--100"]; - Title=getopt(title); - return ltotex([V0,V]|option_list=OpList); -} - -def keyin(S) -{ - print(S,2); - purge_stdin(); - S=get_line(); - L=length(S=strtoascii(S)); - if(L==0) return ""; - return str_cut(S,0,L-2); -} - -def init() { - LS=["DIROUT","DVIOUTA","DVIOUTB","DVIOUTH","DVIOUTL","TeXLim","TeXEq","TikZ", - "XYPrec","XYcm","Canvas"]; - if(!access(get_rootdir()+"/help/os_muldif.dvi")||!access(get_rootdir()+"/help/os_muldif.pdf")) - mycat(["Put os_muldif.dvi and os_muldif.pdf in", get_rootdir()+(isMs()?"\\help.":"/help.")]); - if(!isMs()){ - DIROUT="%HOME%/asir/tex"; - DVIOUTA=str_subst(DVIOUTA,[["\\","/"],[".bat",".sh"]],0); - DVIOUTB=str_subst(DVIOUTB,[["\\","/"],[".bat",".sh"]],0); - DVIOUTL=str_subst(DVIOUTL,[["\\","/"],[".bat",".sh"]],0); - DVIOUTH="%ASIRROOT%/help/os_muldif.pdf"; - } - Home=getenv("HOME"); - if(type(Home)!=7) Home=""; - for(Id=-7, F=Home; Id<-1;){ - G = F+"/.muldif"; - if(access(G)) Id = open_file(G); - else Id++; - if(Id==-6) F+="/asir"; - else if(Id==-5) F=get_rootdir(); - else if(Id==-4) F+="/bin"; - else if(Id==-3) F=get_rootdir()+"/lib-asir-contrib"; - } - if(Id>=0){ - while((S=get_line(Id))!=0){ - if(type(P=str_str(S,LS))==4 && (P0=str_char(S,P[1]+4,"="))>0){ - if(P[0]<5){ - P0=str_chr(S,P0+1,"\""); - if(P0>0){ - for(P1=P0;(P2=str_char(S,P1+1,"\""))>0; P1=P2); - if(P1>P0+1){ - SS=str_cut(S,P0+1,P1-1); - SS=str_subst(SS,["\\\\","\\\""],["\\","\""]); - if(P[0]==0) DIROUT=SS; - else if(P[0]==1) DVIOUTA=SS; - else if(P[0]==2) DVIOUTB=SS; - else if(P[0]==3) DVIOUTH=SS; - else if(P[0]==4) DVIOUTL=SS; - } - } - if(P0<0 || P1<P0+2) mycat(["Error! Definiton of", LS[P[0]], - "in .muldif"]); - }else{ - SV=eval_str(str_cut(S,P0+1,str_len(S)-1)); - if(P[0]==5) TeXLim=SV; - else if(P[0]==6) TeXEq=SV; - else if(P[0]==7) TikZ=SV; - else if(P[0]==8) XYPrec=SV; - else if(P[0]==9) XYcm=SV; - else if(P[0]==10) Canvas=SV; - } - } - } - close_file(Id); - } - chkfun(1,0); -} - -#ifdef USEMODULE -endmodule; -os_md.init()$ -#else -init()$ -#endif - -end$ diff --git a/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h b/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h deleted file mode 100644 index 27a5434f..00000000 --- a/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h +++ /dev/null @@ -1,2127 +0,0 @@ -//20180308 norm added - -int length1(double gdata[]){ - return floor(gdata[0]+0.5); -} - -int length2(double gdata[][2]){ - return floor(gdata[0][0]+0.5); -} - -int length3(double gdata[][3]){ - return floor(gdata[0][0]+0.5); -} - -int length4(double gdata[][4]){ - return floor(gdata[0][0]+0.5); -} - -int length5(double gdata[][5]){ - return floor(gdata[0][0]+0.5); -} - -int length6(double gdata[][6]){ - return floor(gdata[0][0]+0.5); -} - -int length2i(int gdata[][2]){ - return gdata[0][0]; -} - -void copyd(int from, int upto, double q[], double p[]){ - int i; - for(i=from; i<=upto; i++){ - p[i]=q[i]; - } -} - -void copyi(int from, int upto, int q[], int p[]){ - int i; - for(i=from; i<=upto; i++){ - p[i]=q[i]; - } -} - -int push2(double x, double y, double ptL[][2]){ - int nall=length2(ptL); - nall++; - ptL[nall][0]=x; ptL[nall][1]=y; - ptL[0][0]=nall; - return nall; -} - -int push3(double x, double y, double z, double ptL[][3]){ - int nall=length3(ptL); - nall++; - ptL[nall][0]=x; ptL[nall][1]=y; ptL[nall][2]=z; - ptL[0][0]=nall; - return nall; -} - -int push4(double x, double y, double z, double w, double ptL[][4]){ - int nall=length4(ptL); - nall++; - ptL[nall][0]=x; ptL[nall][1]=y; - ptL[nall][2]=z; ptL[nall][3]=w; - ptL[0][0]=nall; - return nall; -} - -int push5(double x, double y, double z, double w, double u, double ptL[][5]){ - int nall=length5(ptL); - nall++; - ptL[nall][0]=x; ptL[nall][1]=y; - ptL[nall][2]=z; ptL[nall][3]=w; ptL[nall][4]=u; - ptL[0][0]=nall; - return nall; -} - -int push6(double x, double y, double z, double w, double u, double v,double ptL[][6]){ - int nall=ptL[0][0]; - nall++; - ptL[nall][0]=x; ptL[nall][1]=y;ptL[nall][2]=z; - ptL[nall][3]=w; ptL[nall][4]=u; ptL[nall][5]=v; - ptL[0][0]=nall; - return nall; -} - -void pull3(int num, double ptL[][3],double pt[3]){ - pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; pt[2]=ptL[num][2]; -} - -void pull2(int num, double ptL[][2],double pt[2]){ - pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; -} - -void pull4(int num, double ptL[][4],double pt[4]){ - pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; - pt[2]=ptL[num][2]; pt[3]=ptL[num][3]; -} - -void pull5(int num, double ptL[][5],double pt[5]){ - pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; - pt[2]=ptL[num][2]; pt[3]=ptL[num][3]; pt[4]=ptL[num][4]; -} - -void pull6(int num, double ptL[][6],double pt[6]){ - pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; pt[2]=ptL[num][2]; - pt[3]=ptL[num][3]; pt[4]=ptL[num][4]; pt[5]=ptL[num][5]; -} - -int add2(double gdata[][2], double x, double y){ - int nall; - nall=push2(x, y, gdata); - return nall; -} - -int add3(double gdata[][3], double x, double y, double z){ - int nall; - nall=push3(x, y, z,gdata); - return nall; -} - -int addptd3(double gdata[][3], double pt[3]){ - int nall; - nall=push3(pt[0],pt[1],pt[2],gdata); - return nall; -} - -int addptd2(double gdata[][2], double pt[2]){ - int nall; - nall=push2(pt[0],pt[1],gdata); - return nall; -} - -int addptd4(double gdata[][4], double pt[4]){ - int nall; - nall=push4(pt[0],pt[1],pt[2],pt[3],gdata); - return nall; -} - -int addptd5(double gdata[][5], double pt[5]){ - int nall; - nall=push5(pt[0],pt[1],pt[2],pt[3],pt[4],gdata); - return nall; -} - -int addptd6(double gdata[][6], double pt[6]){ - int nall; - nall=push6(pt[0],pt[1],pt[2],pt[3],pt[4],pt[5],gdata); - return nall; -} - -int appendd2(int level, int from,int upto, double gdata[][2],double mat[][2]){ - int j, np, nall=length2(mat); - np=upto-from+1; - if(np<0){np=0;} - if(np>0){ - if(level>0){ - if(nall>0){ - nall=add2(mat,Inf, level); - } - } - for(j=1; j<=np; j++){ - mat[nall+j][0]=gdata[from+j-1][0]; - mat[nall+j][1]=gdata[from+j-1][1]; - } - } - mat[0][0]=nall+np; - return nall+np; -} - -int appendd3(int level, int from,int upto, double gdata[][3],double mat[][3]){ - int j, np, nall=length3(mat); - np=upto-from+1; - if(np<0){np=0;} - if(np>0){ - if(level>0){ - if(nall>0){ - nall=add3(mat,Inf, level, 0); - } - } - for(j=1; j<=np; j++){ - mat[nall+j][0]=gdata[from+j-1][0]; - mat[nall+j][1]=gdata[from+j-1][1]; - mat[nall+j][2]=gdata[from+j-1][2]; - } - } - mat[0][0]=nall+np; - return nall+np; -} - -int prependd2(int from,int upto, double gdata[][2],double mat[][2]){ - int j,np, nall=length2(mat); - if(from<=upto){ - np=upto-from+1; - for(j=nall; j>=1; j--){ - mat[np+j][0]=mat[j][0]; - mat[np+j][1]=mat[j][1]; - } - for(j=1; j<=np; j++){ - mat[j][0]=gdata[from+j-1][0]; - mat[j][1]=gdata[from+j-1][1]; - } - }else{ - np=from-upto+1; - for(j=nall; j>=1; j--){ - mat[np+j][0]=mat[j][0]; - mat[np+j][1]=mat[j][1]; - } - for(j=1; j<=np; j++){ - mat[nall+j][0]=gdata[from-j+1][0]; - mat[nall+j][1]=gdata[from-j+1][1]; - } - } - mat[0][0]=nall+np; - return nall+np; -} - -int appendd1(double numvec[], double num){ - int n; - n=floor(numvec[0]+0.5); - numvec[n+1]=num; - numvec[0]=n+1; - return n+1; -} - -int appendi1(int numvec[],int num){ - int n; - n=numvec[0]; - numvec[n+1]=num; - numvec[0]=n+1; - return n+1; -} - -int prependi1(int num, int numvec[]){ - int i,n; - n=numvec[0]; - for(i=n; i>=1; i--){ - numvec[i+1]=numvec[i]; - } - numvec[1]=num; - numvec[0]=n+1; - return n+1; -} - -int removei2(int nrmv,int mat[][2]){ - int j,nall=mat[0][0]; - if(nall>0){ - for(j=nrmv; j<=nall-1; j++){ - mat[j][0]=mat[j+1][0]; - mat[j][1]=mat[j+1][1]; - } - mat[0][0]=nall-1; - return nall-1; - } - else{ - mat[0][0]=0; - return 0; - } -} - -int dataindexd1(double out[],int din[][2]){ - int n1=1, j, ctr=0, nall=floor(out[0]+0.5); - if(nall==0){ - din[0][0]=0; - return 0; - } - for(j=1; j<=nall; j++){ - if(out[j]>Inf-1){ - ctr++; - din[ctr][0]=n1; - din[ctr][1]=j-1; - n1=j+1; - } - } - ctr++; - din[ctr][0]=n1; - din[ctr][1]=nall; - din[0][0]=ctr; - return ctr; -} - -int dataindexd2(int level,double out[][2],int din[][2]){ - int n1=1, j, ctr=0, nall=length2(out); - if(nall==0){ - din[0][0]=0; - return 0; - } - for(j=1; j<=nall; j++){ - if(out[j][0]>Inf-1){ - if((level==0) || (out[j][1]==level)){ - ctr++; - din[ctr][0]=n1; - din[ctr][1]=j-1; - n1=j+1; - } - } - } - ctr++; - din[ctr][0]=n1; - din[ctr][1]=nall; - din[0][0]=ctr; - return ctr; -} - -int dataindexd3(int level, double out[][3],int din[][2]){ - int n1=1, j, ctr=0, nall=length3(out); - if(nall==0){ - din[0][0]=0; - return 0; - } - for(j=1; j<=nall; j++){ - if(out[j][0]>Inf-1){ - if((level==0) || (out[j][1]==level)){ - ctr++; - din[ctr][0]=n1; - din[ctr][1]=j-1; - n1=j+1; - } - } - } - ctr++; - din[ctr][0]=n1; - din[ctr][1]=nall; - din[0][0]=ctr; - return ctr; -} - -int dataindexd4(int level, double out[][4],int din[][2]){ - int n1=1, j, ctr=0, nall=length4(out); - if(nall==0){ - din[0][0]=0; - return 0; - } - for(j=1; j<=nall; j++){ - if(out[j][0]>Inf-1){ - if((level==0) || (out[j][1]==level)){ - ctr++; - din[ctr][0]=n1; - din[ctr][1]=j-1; - n1=j+1; - } - } - } - ctr++; - din[ctr][0]=n1; - din[ctr][1]=nall; - din[0][0]=ctr; - return ctr; -} - -int dataindexi1(int out[],int din[][2]){ - int n1=1, j, ctr=0, nall=out[0], ninfp=0; - if(nall==0){ - din[0][0]=0; din[0][1]=-1; - return 0; - } - for(j=1; j<=nall; j++){ - if(out[j]==Infint){ - ctr++; - if(j==ninfp+1){ - din[ctr][0]=0; din[ctr][1]=-1; - } - else{ - din[ctr][0]=n1; din[ctr][1]=j-1; - } - ninfp=j; - n1=j+1; - } - } - ctr++; - if(out[nall]==Infint){ - din[ctr][0]=0; din[ctr][1]=0; - } - else{ - din[ctr][0]=n1; din[ctr][1]=nall; - } - din[0][0]=ctr; - return ctr; -} - -void dispvec(int n,double dt[]){ - int i; - for(i=0; i<n; i++){ - printf("%f ",dt[i]); - } - printf("\n"); -} - -void dispveci(int n,int dt[]){ - int i; - for(i=0; i<n; i++){ - printf("%d ",dt[i]); - } - printf("\n"); -} - -void dispmatd2(int from, int upto, double mat[][2]){ - int i; - for(i=from; i<upto+1; i++){ - printf("%3d %7.5f %7.5f\n",i,mat[i][0],mat[i][1]); - } -} - -void dispmatd3(int from, int upto, double mat[][3]){ - int i; - for(i=from; i<upto+1; i++){ - printf("%3d %7.5f %7.5f %7.5f\n",i,mat[i][0],mat[i][1],mat[i][2]); - } -} - -void dispmatd4(int from, int upto, double mat[][4]){ - int i; - for(i=from; i<upto+1; i++){ - printf("%3d %7.5f %7.5f ",i,mat[i][0],mat[i][1]); - printf("%7.5f %7.5f\n",mat[i][2],mat[i][3]); - } -} - -void dispmatd5(int from, int upto, double mat[][5]){ - int i; - for(i=from; i<upto+1; i++){ - printf("%3d %7.5f %7.5f ",i,mat[i][0],mat[i][1]); - printf("%7.5f %7.5f %7.5f\n",mat[i][2],mat[i][3],mat[i][4]); - } -} - -void dispmatd6(int from, int upto, double mat[][6]){ - int i; - for(i=from; i<upto+1; i++){ - printf("%3d %7.5f %7.5f %7.5f ",i,mat[i][0],mat[i][1],mat[i][2]); - printf("%7.5f %7.5f %7.5f\n",mat[i][3],mat[i][4],mat[i][5]); - } -} - -void dispmatd2all(double mat[][2]){ - int i; - if(mat[0][0]==0){printf("%s\n","no data");return;} - for(i=1; i<mat[0][0]+1; i++){ - printf("%3d %7.5f %7.5f\n",i,mat[i][0],mat[i][1]); - } -} - -void dispmatd3all(double mat[][3]){ - int i; - if(mat[0][0]==0){printf("%s\n","no data");return;} - for(i=1; i<mat[0][0]+1; i++){ - printf("%3d %7.5f %7.5f %7.5f\n",i,mat[i][0],mat[i][1],mat[i][2]); - } -} - -void dispmatd4all(double mat[][4]){ - int i; - if(mat[0][0]==0){printf("%s\n","no data");return;} - for(i=1; i<mat[0][0]+1; i++){ - printf("%3d %7.5f %7.5f ",i,mat[i][0],mat[i][1]); - printf("%7.5f %7.5f\n",mat[i][2],mat[i][3]); - } -} - -void dispmatd5all(double mat[][5]){ - int i; - if(mat[0][0]==0){printf("%s\n","no data");return;} - for(i=1; i<mat[0][0]+1; i++){ - printf("%3d %7.5f %7.5f ",i,mat[i][0],mat[i][1]); - printf("%7.5f %7.5f %7.5f\n",mat[i][2],mat[i][3],mat[i][4]); - } -} - -void dispmatd6all(double mat[][6]){ - int i; - if(mat[0][0]==0){printf("%s\n","no data");return;} - for(i=1; i<mat[0][0]+1; i++){ - printf("%3d %7.5f %7.5f %7.5f ",i,mat[i][0],mat[i][1],mat[i][2]); - printf("%7.5f %7.5f %7.5f\n",mat[i][3],mat[i][4],mat[i][5]); - } -} - -void dispmati2(int from, int upto, int mat[][2]){ - int i; - for(i=from; i<upto+1; i++){ - printf("%3d %d %d\n",i,mat[i][0],mat[i][1]); - } -} - -void dispmati1(int from, int upto, int mat[]){ - int i; - for(i=from; i<upto+1; i++){ - printf("%3d %d\n",i,mat[i]); - } -} - -void readdata3(const char *fname, double out[][3]){ - double data[DsizeL][4]; - int i, j, ndata, nall; - FILE *fp; - fp=fopen(fname,"r"); - if(fp==NULL){ - printf("file not found\n"); - return; - } - ndata=0; - i=1; - while( ! feof(fp) && i<DsizeL){ - for(j=0;j<4;j++){ - fscanf(fp,"%lf",&data[i][j]); - } - i++; - ndata++; - } - ndata--; - fclose(fp); - out[0][0]=0; nall=0; - for(i=1; i<=ndata; i++){ - nall=add3(out, data[i][0], data[i][1], data[i][2]); - } - return; -} - -void readdata2(const char *fname, double out[][2]){ - double data[DsizeL][3]; - int i, j, ndata, nall; - FILE *fp; - fp=fopen(fname,"r"); - if(fp==NULL){ - printf("file not found\n"); - return; - } - ndata=0; - i=1; - while( ! feof(fp) && i<DsizeL){ - for(j=0;j<3;j++){ - fscanf(fp,"%lf",&data[i][j]); - } - i++; - ndata++; - } - ndata--; - fclose(fp); - out[0][0]=0; nall=0; - for(i=1; i<=ndata; i++){ - nall=add2(out, data[i][0], data[i][1]); - } - return; -} - -int output2(const char *var, const char *fname, int level, double out[][2]){ - int nall=length2(out), ndin, din[DsizeM][2],i,j; - double tmpd[2]; - FILE *fp; - fp=fopen(fname,"w"); - if (fp == NULL) { - printf("cannot open\n"); - return -1; - } - ndin=dataindexd2(level, out,din); - fprintf(fp,"%s//\n",var); - for(i=1; i<=ndin; i++){ - fprintf(fp,"start//\n"); - fprintf(fp,"["); - for(j=din[i][0]; j<=din[i][1]; j++){ - pull2(j,out,tmpd); - fprintf(fp,"[ %7.5f, %7.5f]",tmpd[0],tmpd[1]); - if(j<din[i][1]){ - fprintf(fp,","); - } - } - fprintf(fp,"]//\n"); - if(i<ndin){ - fprintf(fp,"end//\n"); - } - else{ - fprintf(fp,"end////\n"); - } - } - fclose(fp); - return 0; -} - -void simplesort(double number[]){ - int i,j, total=number[0]; - double tmp; - for (i=1; i<=total; i++) { - for (j=i+1; j<=total; j++) { - if (number[i] > number[j]) { - tmp = number[i]; - number[i] = number[j]; - number[j] = tmp; - } - } - } -} - -int memberi(int a, int list[]){ - int i, n=list[0]; - for(i=1; i<=n; i++){ - if(a==list[i]){ - return 1; - } - } - return 0; -} - -double dotprod(int dim, double p[], double q[]){ - double ans; - ans=p[0]*q[0]+p[1]*q[1]; - if(dim>2){ - ans=ans+p[2]*q[2]; - } - return ans; -} - -double norm(int dim, double p[]){ - double ans; - ans=dotprod(dim,p,p); - return sqrt(ans); -} - -double dist(int dim, double p[], double q[]){ - double tmp; - tmp=pow(q[0]-p[0],2)+pow(q[1]-p[1],2); - if(dim>2){ - tmp=tmp+pow(q[2]-p[2],2); - } - return sqrt(tmp); -} - -void crossprod(int dim,double a[3],double b[3], double out[3]){ - if(dim==3){ - out[0]=a[1]*b[2]-a[2]*b[1]; - out[1]=a[2]*b[0]-a[0]*b[2]; - out[2]=a[0]*b[1]-a[1]*b[0]; - }else{ - out[0]=a[0]*b[1]-a[1]*b[0]; - out[1]=Inf; - } -} - -void reflectpoint(double p1[2],double regard[][2],double p2[2]){ - double pa[2],pb[2],u,v,a,b,u2,v2; - pull2(1,regard,pa); - if(length2(regard)==1){ - p2[0]=2*pa[0]-p1[0]; p2[1]=2*pa[1]-p1[1]; - }else{ - pull2(2,regard,pb); - u=pb[0]-pa[0]; u2=pow(u,2.0); - v=pb[1]-pa[1]; v2=pow(v,2.0); - a=pa[0]; b=pa[1]; - p2[0]=(u2-v2)/(u2+v2)*p1[0]+2*u*v/(u2+v2)*p1[1]; - p2[0]=p2[0]-2*v*(u*b-v*a)/(u2+v2); - p2[1]=2*u*v/(u2+v2)*p1[0]-(u2-v2)/(u2+v2)*p1[1]; - p2[1]=p2[1]+2*u*(u*b-v*a)/(u2+v2); - } -} - -void pointoncurve(double t, double gdata[][2], double eps, double pt[]){ - double pa[2],pb[2], s; - int n, nall; - n=floor(t+eps); - s=fmax(t-n,0); - nall=length2(gdata); - if(n>=nall){ - pull2(nall,gdata,pt); -// pt[0]=gdata[nall][0]; pt[1]=gdata[nall][1]; - } - else{ - pull2(n,gdata,pa); - pull2(n+1,gdata,pb); - pt[0]=(1-s)*pa[0]+s*pb[0]; - pt[1]=(1-s)*pa[1]+s*pb[1]; - } -} - -int partcrv(double a,double b,double pkL[][2], double pL[][2]){ - int i, is, ie, nall; - double eps=pow(10,-3.2); - is=ceil(a); - ie=floor(b); - nall=0; - if(a<is-eps){ - nall++; - pL[nall][0]=(is-a)*pkL[is-1][0]+(1-is+a)*pkL[is][0]; - pL[nall][1]=(is-a)*pkL[is-1][1]+(1-is+a)*pkL[is][1]; - } - for(i=is; i<=ie; i++){ - nall++; - pL[nall][0]=pkL[i][0]; - pL[nall][1]=pkL[i][1]; - } - if(b>ie+eps){ - nall++; - pL[nall][0]=(1-b+ie)*pkL[ie][0]+(b-ie)*pkL[ie+1][0]; - pL[nall][1]=(1-b+ie)*pkL[ie][1]+(b-ie)*pkL[ie+1][1]; - } - pL[0][0]=nall; - return nall; -} - -int partcrv3(double a,double b,double pkL[][3], double pL[][3]){ - int i, is, ie, nall; - double eps=pow(10,-3.2); - is=ceil(a); - ie=floor(b); - nall=0; - if(a<is-eps){ - nall++; - pL[nall][0]=(is-a)*pkL[is-1][0]+(1-is+a)*pkL[is][0]; - pL[nall][1]=(is-a)*pkL[is-1][1]+(1-is+a)*pkL[is][1]; - pL[nall][2]=(is-a)*pkL[is-1][2]+(1-is+a)*pkL[is][2]; - } - for(i=is; i<=ie; i++){ - nall++; - pL[nall][0]=pkL[i][0]; - pL[nall][1]=pkL[i][1]; - pL[nall][2]=pkL[i][2]; - } - if(b>ie+eps){ - nall++; - pL[nall][0]=(1-b+ie)*pkL[ie][0]+(b-ie)*pkL[ie+1][0]; - pL[nall][1]=(1-b+ie)*pkL[ie][1]+(b-ie)*pkL[ie+1][1]; - pL[nall][2]=(1-b+ie)*pkL[ie][2]+(b-ie)*pkL[ie+1][2]; - } - pL[0][0]=nall; - return nall; -} - -int connectseg(double pdata[][2], double eps, double out[][2]){ - int din[DsizeM][2], nd, nq, i, j, flg, st, en, ntmp; - int nall=length2(pdata), nout=0; - double qd[DsizeM][2], ah[2], ao[2], p[2], q[2], tmp[2]; - out[0][0]=0; - nd=dataindexd2(0,pdata,din); - qd[0][0]=0; - nq=appendd2(0,din[1][0],din[1][1],pdata,qd); - nd=removei2(1,din); - while(nd>0){ - pull2(1,qd,ah); - pull2(nq,qd,ao); - flg=0; - for(j=1; j<=nd; j++){ - st=din[j][0]; - en=din[j][1]; - pull2(st,pdata,p); - pull2(en,pdata,q); - if(dist(2,p,ao)<eps){ - nq=appendd2(0,st+1,en,pdata,qd); - nd=removei2(j,din); - flg=1; - break; - } - if(dist(2,q,ao)<eps){ - nq=appendd2(0,en-1,st,pdata,qd); - nd=removei2(j,din); - flg=1; - break; - } - if(dist(2,p,ah)<eps){ - nq=prependd2(en,st+1,pdata,qd); - nd=removei2(j,din); - flg=1; - break; - } - if(dist(2,q,ah)<eps){ - nq=prependd2(st,en-1,pdata,qd); - nd=removei2(j,din); - flg=1; - break; - } - } - if(flg==0){ - nout=appendd2(2,1,nq,qd,out); - qd[0][0]=0; - nq=appendd2(0,din[1][0],din[1][1],pdata,qd); - nd=removei2(1,din); - } - } - if(nq>0){ - nout=appendd2(2,1,nq,qd,out); - } - return nout; -} - -void koutenseg(double a[2], double b[2], double c[2], double d[2], - double eps, double eps2, double out[4]){ - double v[2], epss,eps0=Eps, sv2, p1, p2, q1,q2,m1, m2, M1, M2, t; - double tmp1d2[2], tmp2d1, p[2], q[2]; - v[0]=b[0]-a[0]; v[1]=b[1]-a[1]; - sv2=pow(v[0],2.0)+pow(v[1],2.0); - if(sv2<pow(10,-6.0)){ - out[0]=Inf; - return; - } - p[0]=c[0]-a[0]; p[1]=c[1]-a[1]; - q[0]=d[0]-a[0]; q[1]=d[1]-a[1]; - epss=fmin(eps2, eps/sqrt(sv2)); - p1=(p[0]*v[0]+p[1]*v[1])/sv2; - p2=(-p[0]*v[1]+p[1]*v[0])/sv2; - q1=(q[0]*v[0]+q[1]*v[1])/sv2; - q2=(-q[0]*v[1]+q[1]*v[0])/sv2; - m1=-epss; M1=1+epss; - m2=-epss; M2=epss; - if((fmax(p1,q1)<m1) || (fmin(p1,q1)>M1)){ - out[0]=Inf; - return; - } - if((fmax(p2,q2)<m2) || (fmin(p2,q2)>M2)){ - out[0]=Inf; - return; - } - if(p2*q2<0){ - t=p1-(q1-p1)/(q2-p2)*p2; - if((t>m1)&& (t<M1)){ - if((t>-eps0) && (t<1+eps0)){ - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - tmp2d1=fmin(fmax(t,0),1); - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=tmp2d1; out[3]=0; - } - else{ - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - tmp2d1=fmin(fmax(t,0),1); - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=tmp2d1; out[3]=1; - } - return; - } - if((p1<m1)||(p1>M1)||(p2<m2)||(p2>M2)){ - if((q1<m1)||(q1>M1)||(q2<m2)||(q2>M2)){ - out[0]=Inf; - return; - } - t=fmin(fmax(q1,0),1); - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=t; out[3]=1; - return; - } - t=fmin(fmax(p1,0),1); - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=t; out[3]=1; - return; - } - if((p1>-eps0)&&(p1<1+eps0)&&(p2>-eps0)&&(p2<eps0)){ - t= p1; - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=t; out[3]=0; - return; - } - if((q1>-eps0)&&(q1<1+eps0)&&(q2>-eps0)&&(q2<eps0)){ - t= q1; - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=t; out[3]=0; - return; - } - if((p1<m1)||(p1>M1)||(p2<m2)||(p2>M2)){ - if((q1<m1)||(q1>M1)||(q2<m2)||(q2>M2)){ - out[0]=Inf; - return; - } - t=fmin(fmax(q1,0),1); - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=t; out[3]=1; - return; - } - if((q1<m1)||(q1>M1)||(q2<m2)||(q2>M2)){ - t=fmin(fmax(p1,0),1); - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=t; out[3]=1; - return; - } - if(fabs(p2)<fabs(q2)){ - t=fmin(fmax(p1,0),1); - } - else{ - t=fmin(fmax(q1,0),1); - } - tmp1d2[0]=a[0]+t*v[0]; tmp1d2[1]=a[1]+t*v[1]; - out[0]=tmp1d2[0]; out[1]=tmp1d2[1]; - out[2]=t; out[3]=1; - return; -} - -double paramoncurve(double p[2], int n, double ptL[][2]){ - double pa[2], pb[2], v[2], w[2], o[2], d2, s; - int nptL=length2(ptL); - if(n==nptL){ - return nptL; - } - else{ - pull2(n,ptL,pa); - pull2(n+1,ptL,pb); - v[0]=pb[0]-pa[0]; v[1]=pb[1]-pa[1]; - w[0]=p[0]-pa[0]; w[1]=p[1]-pa[1]; - o[0]=0; o[1]=0; - d2=pow(dist(2,v,o),2.0); - s=dotprod(2,v,w)/d2; - s=fmin(fmax(s,0),1); - return n+s; - } -} - -void nearestptpt(double pa[2], double pL[][2], double pt[4]){ - double eps0=pow(10,-6.0), p[2], pm[2], im, sm, s; - double ans[7], a1,a2, b1,b2, v1, v2, x1, x2, t, tmpd1; - int i, n, npL=length2(pL); - ans[0]=pa[0]; ans[1]=pa[1]; - ans[2]=1; - p[0]=pL[1][0]; p[1]=pL[1][1]; - ans[3]=p[0]; ans[4]=p[1]; - ans[5]=1; ans[6]=dist(2,pa,p); - pm[0]=pL[1][0]; pm[1]=pL[1][1]; - im=1; - sm=dist(2,pm,pa); - for(i=1; i<=npL-1; i++){ - a1=pL[i][0]; a2=pL[i][1]; - b1=pL[i+1][0]; b2=pL[i+1][1]; - v1=b1-a1; v2=b2-a2; - x1=pa[0]; x2=pa[1]; - tmpd1=pow(v2,2.0)+pow(v1,2.0); - if(fabs(tmpd1)<eps0){ - continue; - } - t=(-a2*v2-v1*a1+v1*x1+x2*v2)/tmpd1; - if(t<-eps0){ - p[0]=a1; p[1]=a2; - } - else if(t>1+eps0){ - p[0]=b1; p[1]=b2; - } - else{ - p[0]=a1+t*v1; p[1]=a2+t*v2; - } - s=dist(2,p,pa); - if(s<sm-eps0){ - tmpd1=paramoncurve(p,i,pL); - pm[0]=p[0]; pm[1]=p[1]; - im=tmpd1; sm=s; - } - } - if(sm<ans[6]){ - ans[0]=pa[0]; ans[1]=pa[1]; - ans[2]=n; - ans[3]=pm[0]; ans[4]=pm[1]; - ans[5]=im; ans[6]=sm; - } - pt[0]=ans[3]; pt[1]=ans[4]; - pt[2]=ans[5]; pt[3]=ans[6]; -} - -int intersectselfPp(double data1[][2],double eps,double eps1s,double kL[][4]){ - double a[2], b[2], tmpd2[2], tmpd4[4], tmpd5[5], p[2], q[2], t, s; - double eps0=pow(10,-5.0); - double tmpd1, tmp1d1, tmp2d1; - int i, j, k, n, is, ndata1,nkL, ntmp, ntmp1,flg, closed=0; - ndata1=length2(data1); - p[0]=data1[1][0]; p[1]=data1[1][1]; - q[0]=data1[ndata1][0]; q[1]=data1[ndata1][1]; - if(dist(2,p,q)<Eps){closed=1;} - kL[0][0]=0; nkL=0; - for(i=1; i<=ndata1; i++){ - ntmp=0; tmpd1=Inf; - pull2(i,data1,a); - nearestptpt(a, data1, tmpd4); - n=floor(tmpd4[2]+0.5); - if(n==i){continue;} - if(closed==1){ - if((i==1)&&(n==ndata1)){continue;} - if((i==ndata1)&&(n==1)){continue;} - } - ntmp1=floor(tmpd4[2]+Eps); - if((tmpd4[3]<eps1s)&&(ntmp1!=i)){ - if(ntmp<ntmp1){ - ntmp=ntmp1; - tmpd1=tmpd4[3]; - nkL=addptd4(kL,tmpd4); - } - else if(tmpd4[3]<tmpd1){ - tmpd1=tmpd4[3]; - kL[0][0]--; - nkL=addptd4(kL,tmpd4); - } - } - } - return nkL; -} - -/* -int intersectcrvsPptest(double data1[][2], double data2[][2], - double eps1,double eps2, double kL[][4]){ - double t, s, a[2], b[2], p[2], q[2]; - double sqeps=pow(10,-10.0), eps0=pow(10,-2.0); - double tmp1d2[2],tmp2d2[2],tmpd4[4],tmp1d4[4],tmpd5[5]; - double tmpd1,tmp1d1,tmp2d1, kL0[DsizeL][5], ds; - int i, j, k, n, is, nkL, nall, ndata1,ndata2,ntmp, ntmp1, flg; - ndata1=length2(data1); - ndata2=length2(data2); - if(ndata1==ndata2){ - tmp1d1=0; tmp2d1=0; - for(i=1; i<=ndata1; i++){ - tmp1d1=tmp1d1+pow(data1[i][0]-data2[i][0],2.0); - tmp1d1=tmp1d1+pow(data1[i][1]-data2[i][1],2.0); - tmp2d1=tmp2d1+pow(data1[i][0]-data2[ndata2-i+1][0],2.0); - tmp2d1=tmp2d1+pow(data1[i][1]-data2[ndata2-i+1][1],2.0); - } - tmp1d1=sqrt(tmp1d1); tmp2d1=sqrt(tmp2d1); - if((tmp1d1<Eps)||(tmp2d1<Eps)){ - kL[0][0]=0; nkL=0; - return nkL; - } - } - kL0[0][0]=0; nkL=0; - for(i=1; i<=ndata1; i++){ - ntmp=0; tmpd1=Inf; - pull2(i,data1,a); - nearestptpt(a, data2, tmpd4); - tmp1d1=floor(tmpd4[2]+Eps); //17.06.03 - a[0]=tmpd4[0]; a[1]=tmpd4[1]; - nearestptpt(a, data1, tmpd4); - tmpd5[0]=tmpd4[0]; tmpd5[1]=tmpd4[1]; - tmpd5[2]=tmpd4[2]; tmpd5[3]=tmp1d1; - tmpd5[4]=tmpd4[3]; - nkL=addptd5(kL0,tmpd5); - } - kL[0][0]=0; nall=0; - p[0]=Inf; p[1]=0; - for(i=1; i<=nkL; i++){ - if(kL0[i][4]<eps2){ - q[0]=kL0[i][0]; q[1]=kL0[i][1]; - if(dist(2,p,q)>eps2){ - nall=push4(kL0[i][0],kL0[i][1],kL0[i][2],kL0[i][3],kL); - p[0]=kL0[i][0]; p[1]=kL0[i][1]; - ds=kL0[i][4]; - continue; - } - if(kL0[i][4]<ds){ - kL[0][0]--; - nall=push4(kL0[i][0],kL0[i][1],kL0[i][2],kL0[i][3],kL); - p[0]=kL0[i][0]; p[1]=kL0[i][1]; - ds=kL0[i][4]; - } - } - } - return nall; -} -*/ - -int intersectcrvsPp(double data1[][2], double data2[][2], - double eps,double eps1s, double kL[][4]){ - double t, s, a[2], b[2], p[2], q[2]; - double sqeps=pow(10,-10.0), eps0=pow(10,-2.0); - double tmp1d2[2],tmp2d2[2],tmpd4[4],tmp1d4[4],tmpd5[5]; - double tmpd1,tmp1d1,tmp2d1; - int i, j, k, n, is, ndata1, ndata2, nkL,nkL1,nkL2,ntmp, ntmp1, flg; - ndata1=length2(data1); - ndata2=length2(data2); - if(ndata1==ndata2){ - tmp1d1=0; tmp2d1=0; - for(i=1; i<=ndata1; i++){ - tmp1d1=tmp1d1+pow(data1[i][0]-data2[i][0],2.0); - tmp1d1=tmp1d1+pow(data1[i][1]-data2[i][1],2.0); - tmp2d1=tmp2d1+pow(data1[i][0]-data2[ndata2-i+1][0],2.0); - tmp2d1=tmp2d1+pow(data1[i][1]-data2[ndata2-i+1][1],2.0); - } - tmp1d1=sqrt(tmp1d1); tmp2d1=sqrt(tmp2d1); - if((tmp1d1<Eps)||(tmp2d1<Eps)){ - kL[0][0]=0; nkL=0; - return nkL; - } - } - kL[0][0]=0; nkL=0; - for(i=1; i<=ndata1;i++){ - ntmp=0; tmpd1=Inf; - pull2(i,data1,a); - nearestptpt(a, data2, tmpd4); - tmp1d1=floor(tmpd4[2]+Eps); //17.06.03 - a[0]=tmpd4[0]; a[1]=tmpd4[1]; - nearestptpt(a, data1, tmpd4); - if(tmpd4[3]<eps1s){ - flg=0; - p[0]=tmpd4[0]; p[1]=tmpd4[1]; - for(j=1; j<=nkL; j++){ - q[0]=kL[j][0]; q[1]=kL[j][1]; - if(dist(2,p,q)<eps0){ - flg=1; - break; - } - } - if(flg==1){continue;} - ntmp1=floor(tmpd4[2]+Eps); - if(ntmp<ntmp1){ - ntmp=ntmp1; - tmpd1=tmpd4[3]; - tmp1d4[0]=tmpd4[0]; tmp1d4[1]=tmpd4[1]; - tmp1d4[2]=tmpd4[2]; tmp1d4[3]=tmp1d1; - nkL=addptd4(kL,tmp1d4); - } - else if(tmpd4[3]<tmpd1){ - tmpd1=tmpd4[3]; - kL[0][0]--; - tmp1d4[0]=tmpd4[0]; tmp1d4[1]=tmpd4[1]; - tmp1d4[2]=tmpd4[2]; tmp1d4[3]=tmp1d1; - nkL=addptd4(kL,tmp1d4); - } - } - } - return nkL; -} - -int intersectcrvsPpold(double data1[][2], double data2[][2], - double eps,double eps1s, double kL[][4]){ -// 17.05.22 - double kL1[DsizeL][5], kL2[DsizeL][5]; - double t, s, a[2], b[2], p[2], q[2]; - double sqeps=pow(10,-10.0), eps0=pow(10,-6.0); - double tmp1d2[2],tmp2d2[2],tmpd4[4],tmpd5[5]; - double tmpd1,tmp1d1,tmp2d1; - int i, j, k, n, is, ndata1, ndata2, nkL,nkL1,nkL2,ntmp,flg; - ndata1=length2(data1); - ndata2=length2(data2); - if(ndata1==ndata2){ - tmp1d1=0; tmp2d1=0; - for(i=1; i<=ndata1; i++){ - tmp1d1=tmp1d1+pow(data1[i][0]-data2[i][0],2.0); - tmp1d1=tmp1d1+pow(data1[i][1]-data2[i][1],2.0); - tmp2d1=tmp2d1+pow(data1[i][0]-data2[ndata2-i+1][0],2.0); - tmp2d1=tmp2d1+pow(data1[i][1]-data2[ndata2-i+1][1],2.0); - } - tmp1d1=sqrt(tmp1d1); tmp2d1=sqrt(tmp2d1); - if((tmp1d1<eps0)||(tmp2d1<eps0)){ - kL[0][0]=0; nkL=0; - return nkL; - } - } - kL1[0][0]=0; nkL1=0; - kL2[0][0]=0; nkL2=0; - for(i=1; i<=ndata1-1; i++){ - pull2(i,data1,a); - pull2(i+1,data1,b); - for(j=1; j<=ndata2-1; j++){ - pull2(j, data2, p); - pull2(j+1, data2, q); - koutenseg(a,b,p,q,eps,eps1s,tmpd4); - if(tmpd4[0]<Inf-1){ - ntmp=floor(tmpd4[3]+Eps); - if(ntmp==0){ - tmpd5[0]=tmpd4[0]; tmpd5[1]=tmpd4[1]; - tmpd5[2]=tmpd4[2]; tmpd5[3]=i; tmpd5[4]=j; - nkL1=addptd5(kL1,tmpd5); - } - else{ - tmpd5[0]=tmpd4[0]; tmpd5[1]=tmpd4[1]; - tmpd5[2]=tmpd4[2]; tmpd5[3]=i; tmpd5[4]=j; - nkL2=addptd5(kL2,tmpd5); - } - } - } - } - kL[0][0]=0; nkL=0; - if(nkL1>0){ - pull5(1,kL1,tmpd5); - p[0]=tmpd5[0]; p[1]=tmpd5[1]; - t=tmpd5[2]; - i=floor(tmpd5[3]+Eps); - j=floor(tmpd5[4]+Eps); - tmpd4[0]=p[0]; tmpd4[1]=p[1]; - tmpd4[2]=i+t; tmpd4[3]=j; - nkL=addptd4(kL,tmpd4); - } - for(n=2; n<=nkL1; n++){ - pull5(n,kL1,tmpd5); - p[0]=tmpd5[0]; p[1]=tmpd5[1]; - flg=0; - for(k=1; k<=nkL; k++){ - pull4(k,kL,tmpd4); - tmp1d2[0]=tmpd4[0]; tmp1d2[1]=tmpd4[1]; - if(pow(dist(2,p,tmp1d2),2.0)<sqeps){ - flg=1; - break; - } - } - if(flg==0){ - tmpd4[0]=p[0]; tmpd4[1]=p[1]; - t=tmpd5[2]; - i=floor(tmpd5[3]+Eps); - j=floor(tmpd5[4]+Eps); - tmpd4[2]=t+i; tmpd4[3]=j; - nkL=addptd4(kL,tmpd4); - } - } - for(n=1; n<=nkL2; n++){ - pull5(n,kL2,tmpd5); - p[0]=tmpd5[0]; p[1]=tmpd5[1]; - flg=0; - for(k=1; k<=nkL; k++){ - pull4(k,kL,tmpd4); - tmp1d2[0]=tmpd4[0]; tmp1d2[1]=tmpd4[1]; - if(pow(dist(2,p,tmp1d2),2.0)<sqeps){ - flg=1; - break; - } - } - if(flg==0){ - tmpd4[0]=p[0]; tmpd4[1]=p[1]; - t=tmpd5[2]; - i=floor(tmpd5[3]+Eps); - j=floor(tmpd5[4]+Eps); - tmpd4[2]=i+t; tmpd4[3]=j; - nkL=addptd4(kL,tmpd4); - } - } - return nkL; -} - -int dropnumlistcrv(double qd[][2], double eps1, int out[]){ - int i,j,k, nout,nall=length2(qd), nd, se, en, npd, nptL; - int din[DsizeM][2],ptL[DsizeL]; - double eps=pow(10.0,-6.0), pd[DsizeL][2], p[2], tmp2d[2]; - out[0]=0; nout=0; - nd=dataindexd2(2,qd,din); - for(j=1; j<=nd; j++){ - se=din[j][0]; en=din[j][1]; - pd[0][0]=0; npd=0; - npd=appendd2(0,se,en,qd,pd); - ptL[0]=0; nptL=0; - nptL=appendi1(ptL,1); - pull2(1,pd,p); - for(k=2; k<=npd-1; k++){ - pull2(k,pd,tmp2d); - if(dist(2,p,tmp2d)>eps1){ - nptL=appendi1(ptL,k); - pull2(k,pd,p); - } - } - pull2(npd-1,pd,p); - pull2(npd,pd,tmp2d); - if(dist(2,p,tmp2d)>eps){ // eps -> eps1 ? - nptL=appendi1(ptL,npd); - } - if(nptL==1){ptL[0]=0; nptL=0;} - if(nout>0){ - nout=appendi1(out,Infint); - } - for(i=1; i<=nptL; i++){ - nout=appendi1(out,ptL[i]); - } - } - out[0]=nout; - return nout; -} - -int increasept2(double ptL[][2], int nn, double out[][2]){ - int ii, jj, npt, nall; - double tmpd2[2]; - npt=length2(ptL); - out[0][0]=0; - for(ii=1; ii<=npt-1; ii++){ - for(jj=0; jj<nn; jj++){ - tmpd2[0]=ptL[ii][0]+1.0*jj/nn*(ptL[ii+1][0]-ptL[ii][0]); - tmpd2[1]=ptL[ii][1]+1.0*jj/nn*(ptL[ii+1][1]-ptL[ii][1]); - addptd2(out,tmpd2); - } - } - nall=appendd2(0,npt,npt,ptL,out); - return nall; -} - -int increasept3(double ptL[][3], int nn, double out[][3]){ - int ii, jj, npt, nall; - double tmpd3[3]; - npt=length3(ptL); - out[0][0]=0; - for(ii=1; ii<=npt-1; ii++){ - for(jj=0; jj<nn; jj++){ - tmpd3[0]=ptL[ii][0]+1.0*jj/nn*(ptL[ii+1][0]-ptL[ii][0]); - tmpd3[1]=ptL[ii][1]+1.0*jj/nn*(ptL[ii+1][1]-ptL[ii][1]); - tmpd3[2]=ptL[ii][2]+1.0*jj/nn*(ptL[ii+1][2]-ptL[ii][2]); - addptd3(out,tmpd3); - } - } - nall=appendd3(0,npt,npt,ptL,out); - return nall; -} - -void bezierpt(double t, double p0[], double p3[], double p1[], double p2[], - double pout[]){ - double p4[2], p5[2], p6[2], p7[2], p8[2]; - int i, flg3=1; - if(p2[0]>Inf-1){ - for(i=0; i<2; i++){ - p2[i]=p3[i]; - } - flg3=0; - } - for(i=0; i<2; i++){ - p4[i]=(1-t)*p0[i]+t*p1[i]; - } - for(i=0; i<2; i++){ - p5[i]=(1-t)*p1[i]+t*p2[i]; - } - for(i=0; i<2; i++){ - p6[i]=(1-t)*p2[i]+t*p3[i]; - } - for(i=0; i<2; i++){ - p7[i]=(1-t)*p4[i]+t*p5[i]; - } - if(flg3==0){ - for(i=0; i<2; i++){ - pout[i]=p7[i]; - } - } - else{ - for(i=0; i<2; i++){ - p8[i]=(1-t)*p5[i]+t*p6[i]; - } - for(i=0; i<2; i++){ - pout[i]=(1-t)*p7[i]+t*p8[i]; - } - } -} - -int bezier(double ptL[][2], double ctrL[][4], int num, double out[][2]){ - double p0[2], p3[2], p1[2], p2[2], pt[2], dt=1.0/num; - int i, j, n, nall; - out[0][0]=0; nall=0; - nall=appendd2(0,1,1,ptL,out); - n=length2(ptL); - for(i=1; i<=n-1; i++){ - pull2(i,ptL, p0); - pull2(i+1,ptL, p3); - p1[0]=ctrL[i][0]; p1[1]=ctrL[i][1]; - p2[0]=ctrL[i][2]; p2[1]=ctrL[i][3]; - for(j=1; j<=num; j++){ - bezierpt(j*dt,p0,p3,p1,p2,pt); - nall=push2(pt[0],pt[1], out); - } - } - return nall; -} - -int ospline(int level, double ptL[][2], int num, double out[][2]){ - double ctrlist[DsizeM][4], eps0=pow(10,-6.0), tmp, cc; - double p[2], q[2], p0[2], p3[2], p1[2], p2[2], pQ[2], pR[2]; - double ptlist[DsizeM][2], tmpmd2[DsizeM][2]; - int nd, i, j, npt, nall, nctr, flg, ndin, closed, din[DsizeM][2], ntmp; - out[0][0]=0; - if(num==1){ - npt=length2(ptL); - for(i=0; i<=npt; i++){ - out[i][0]=ptL[i][0]; out[i][1]=ptL[i][1]; - } - nall=length2(out); - return nall; - } - ndin=dataindexd2(level,ptL,din); - for(nd=1; nd<=ndin; nd++){ - ptlist[0][0]=0; - npt=appendd2(0,din[nd][0],din[nd][1],ptL,ptlist); - if(npt==2){ - appendd2(2, 1,npt,ptlist,out); - continue; - } - closed=0; - pull2(1,ptlist,p); - pull2(npt,ptlist,q); - if(dist(2,p,q)<eps0){ - closed=1; - } - ctrlist[0][0]=0; nctr=0; - for(i=1; i<=npt-1; i++){ - flg=0; - pull2(i, ptlist,p1); - pull2(i+1, ptlist,p2); - if((i==1)||(i==npt-1)){ - flg=1; - if(closed==0){ - pQ[0]=(p1[0]+2*p2[0])/3.0; - pQ[1]=(p1[1]+2*p2[1])/3.0; - pR[0]=(2*p1[0]+p2[0])/3.0; - pR[1]=(2*p1[1]+p2[1])/3.0; - nctr++; - ctrlist[nctr][0]=pQ[0]; ctrlist[nctr][1]=pQ[1]; - ctrlist[nctr][2]=pR[0]; ctrlist[nctr][3]=pR[1]; - flg=2; - } - else{ - if(i==1){ - pull2(npt-1, ptlist,p0); - pull2(i+2, ptlist,p3); - } - else{ - pull2(i-1, ptlist, p0); - pull2(2, ptlist, p3); - } - } - } - if(flg<=1){ - if(flg==0){ - pull2(i-1, ptlist, p0); - pull2(i+2, ptlist, p3); - } - p[0]=p2[0]-p0[0]; p[1]=p2[1]-p0[1]; - q[0]=p3[0]-p1[0]; q[1]=p3[1]-p1[1]; - tmp=1+sqrt((1+dotprod(2,p,q)/dist(2,p0,p2)/dist(2,p1,p3))/2); - cc=4*dist(2,p1,p2)/3/(dist(2,p0,p2)+dist(2,p1,p3))/tmp; - pQ[0]=p1[0]+cc*(p2[0]-p0[0]); pQ[1]=p1[1]+cc*(p2[1]-p0[1]); - pR[0]=p2[0]+cc*(p1[0]-p3[0]); pR[1]=p2[1]+cc*(p1[1]-p3[1]); - nctr++; - ctrlist[nctr][0]=pQ[0]; ctrlist[nctr][1]=pQ[1]; - ctrlist[nctr][2]=pR[0]; ctrlist[nctr][3]=pR[1]; - } - } - if(closed==0){ - p1[0]=ctrlist[2][0]; p1[1]=ctrlist[2][1]; - pull2(2, ptlist, p2); - pQ[0]=p2[0]+(p2[0]-p1[0]); pQ[1]=p2[1]+(p2[1]-p1[1]); - ctrlist[1][0]=pQ[0]; ctrlist[1][1]=pQ[1]; - ctrlist[1][2]=Inf; ctrlist[1][3]=0; - p1[0]=ctrlist[nctr-1][2]; p1[1]=ctrlist[nctr-1][3]; - pull2(nctr,ptlist,p2); - pQ[0]=p2[0]+(p2[0]-p1[0]); pQ[1]=p2[1]+(p2[1]-p1[1]); - ctrlist[nctr][0]=pQ[0]; ctrlist[nctr][1]=pQ[1]; - ctrlist[nctr][2]=Inf; ctrlist[1][3]=0; - } - ctrlist[0][0]=nctr; - if(length2(ptlist)>2){ - ntmp=bezier(ptlist,ctrlist,num, tmpmd2); - nall=appendd2(2,1,ntmp,tmpmd2,out); - } - } - return nall; -} - -void bezierpt3(double t, double p0[], double p3[], double p1[], double p2[], - double pout[]){ - double p4[3], p5[3], p6[3], p7[3], p8[3]; - int i, flg3=1; - if(p2[0]>Inf-1){ - for(i=0; i<3; i++){ - p2[i]=p3[i]; - } - flg3=0; - } - for(i=0; i<3; i++){ - p4[i]=(1-t)*p0[i]+t*p1[i]; - } - for(i=0; i<3; i++){ - p5[i]=(1-t)*p1[i]+t*p2[i]; - } - for(i=0; i<3; i++){ - p6[i]=(1-t)*p2[i]+t*p3[i]; - } - for(i=0; i<3; i++){ - p7[i]=(1-t)*p4[i]+t*p5[i]; - } - if(flg3==0){ - for(i=0; i<3; i++){ - pout[i]=p7[i]; - } - } - else{ - for(i=0; i<3; i++){ - p8[i]=(1-t)*p5[i]+t*p6[i]; - } - for(i=0; i<3; i++){ - pout[i]=(1-t)*p7[i]+t*p8[i]; - } - } -} - -int bezier3(double ptL[][3], double ctrL[][6], int num, double out[][3]){ - double p0[3], p3[3], p1[3], p2[3], pt[3], dt=1.0/num; - int i, j, n, nall; - out[0][0]=0; nall=0; - nall=appendd3(0,1,1,ptL,out); - n=length3(ptL); - for(i=1; i<=n-1; i++){ - pull3(i,ptL, p0); - pull3(i+1,ptL, p3); - p1[0]=ctrL[i][0]; p1[1]=ctrL[i][1]; p1[2]=ctrL[i][2]; - p2[0]=ctrL[i][3]; p2[1]=ctrL[i][4]; p2[2]=ctrL[i][5]; - for(j=1; j<=num; j++){ - bezierpt3(j*dt,p0,p3,p1,p2,pt); - nall=push3(pt[0],pt[1],pt[2], out); - } - } - return nall; -} - -int ospline3(int level, double ptL[][3], int num, double out[][3]){ - double ctrlist[DsizeM][6], eps0=pow(10,-6.0), tmp, cc; - double p[3], q[3], p0[3], p3[3], p1[3], p2[3], pQ[3], pR[3]; - double ptlist[DsizeM][3], tmpmd2[DsizeM][3]; - int nd, i, j, n, npt, nall, nctr, closed, flg, ndin, din[DsizeM][2], ntmp; - out[0][0]=0; nall=0; - if(num==1){ - npt=length3(ptL); - for(i=0; i<=npt; i++){ - out[i][0]=ptL[i][0]; out[i][1]=ptL[i][1]; out[i][2]=ptL[i][2]; - } - nall=length3(out); - return nall; - } - ndin=dataindexd3(2,ptL,din); - for(nd=1; nd<=ndin; nd++){ - ptlist[0][0]=0; - npt=din[nd][1]-din[nd][0]; - if(npt<=3){ - n=appendd3(0, din[nd][0], din[nd][0], ptL, ptlist); - for(i=1; i<=npt-1; i++){ - pull3(din[nd][0]+i,ptL,p); - pull3(din[nd][0]+i+1,ptL,q); - for(j=1; j<=num; j++){ - p1[0]=p[0]+1.0*j/num*(q[0]-p[0]); - p1[1]=p[1]+1.0*j/num*(q[1]-p[1]); - p1[2]=p[2]+1.0*j/num*(q[2]-p[2]); - n=addptd3(ptlist,p1); - } - } - nall=appendd3(2, 1,n,ptlist,out); - continue; - } - appendd3(0,din[nd][0],din[nd][1],ptL,ptlist); - closed=0; - pull3(1,ptlist,p); - pull3(npt,ptlist,q); - if(dist(3,p,q)<eps0){closed=1;} - ctrlist[0][0]=0; nctr=0; - for(i=1; i<=npt-1; i++){ - flg=0; - pull3(i, ptlist,p1); - pull3(i+1, ptlist,p2); - if((i==1)||(i==npt-1)){ - flg=1; - if(closed==0){ - pQ[0]=(p1[0]+2*p2[0])/3.0; - pQ[1]=(p1[1]+2*p2[1])/3.0; - pQ[2]=(p1[2]+2*p2[2])/3.0; - pR[0]=(2*p1[0]+p2[0])/3.0; - pR[1]=(2*p1[1]+p2[1])/3.0; - pR[2]=(2*p1[2]+p2[2])/3.0; - nctr++; - ctrlist[nctr][0]=pQ[0]; ctrlist[nctr][1]=pQ[1]; ctrlist[nctr][2]=pQ[2]; - ctrlist[nctr][3]=pR[0]; ctrlist[nctr][4]=pR[1]; ctrlist[nctr][5]=pR[2]; - flg=2; - } - else{ - if(i==1){ - pull3(npt-1, ptlist,p0); - pull3(i+2, ptlist,p3); - } - else{ - pull3(i-1, ptlist, p0); - pull3(2, ptlist, p3); - } - } - } - if(flg<=1){ - if(flg==0){ - pull3(i-1, ptlist, p0); - pull3(i+2, ptlist, p3); - } - p[0]=p2[0]-p0[0]; p[1]=p2[1]-p0[1]; p[2]=p2[2]-p0[2]; - q[0]=p3[0]-p1[0]; q[1]=p3[1]-p1[1]; q[2]=p3[2]-p1[2]; - tmp=1+sqrt((1+dotprod(3,p,q)/dist(3,p0,p2)/dist(3,p1,p3))/2); - cc=4*dist(3,p1,p2)/3/(dist(3,p0,p2)+dist(3,p1,p3))/tmp; - pQ[0]=p1[0]+cc*(p2[0]-p0[0]); pQ[1]=p1[1]+cc*(p2[1]-p0[1]); - pQ[2]=p1[2]+cc*(p2[2]-p0[2]); - pR[0]=p2[0]+cc*(p1[0]-p3[0]); pR[1]=p2[1]+cc*(p1[1]-p3[1]); - pR[2]=p2[2]+cc*(p1[2]-p3[2]); - nctr++; - ctrlist[nctr][0]=pQ[0]; ctrlist[nctr][1]=pQ[1]; ctrlist[nctr][2]=pQ[2]; - ctrlist[nctr][3]=pR[0]; ctrlist[nctr][4]=pR[1]; ctrlist[nctr][5]=pR[2]; - } - } - if(closed==0){ - p1[0]=ctrlist[2][0]; p1[1]=ctrlist[2][1]; p1[2]=ctrlist[2][2]; - pull3(2, ptlist, p2); - pQ[0]=p2[0]+(p2[0]-p1[0]); pQ[1]=p2[1]+(p2[1]-p1[1]); - pQ[2]=p2[2]+(p2[2]-p1[2]); - ctrlist[1][0]=pQ[0]; ctrlist[1][1]=pQ[1]; ctrlist[1][2]=pQ[2]; - ctrlist[1][3]=Inf; ctrlist[1][4]=0; ctrlist[1][5]=0; - p1[0]=ctrlist[nctr-1][3]; p1[1]=ctrlist[nctr-1][4]; p1[2]=ctrlist[nctr-1][5]; - pull3(nctr,ptlist,p2); - pQ[0]=p2[0]+(p2[0]-p1[0]); pQ[1]=p2[1]+(p2[1]-p1[1]); - pQ[2]=p2[2]+(p2[2]-p1[2]); - ctrlist[nctr][0]=pQ[0]; ctrlist[nctr][1]=pQ[1]; ctrlist[nctr][2]=pQ[2]; - ctrlist[nctr][3]=Inf; ctrlist[1][4]=0; ctrlist[1][5]=0; - } - ctrlist[0][0]=nctr; - if(length3(ptlist)>2){ - ntmp=bezier3(ptlist,ctrlist,num, tmpmd2); - nall=appendd3(2,1,ntmp,tmpmd2,out); - } - } - return nall; -} - -void segplot(double x1,double y1,double x2,double y2,double seg[][2]){ - seg[0][0]=0; - push2(x1,y1,seg); - push2(x2,y2,seg); -} - -void addsegplot(double x1,double y1,double seg[][2]){ - push2(x1,y1,seg); -} - -void circledata(double cx,double cy,double r, int num,double out[][2]){ - double t,dt,pt[2]; - int i; - dt=2*M_PI/num; - out[0][0]=0; - for(i=0; i<=num; i++){ - push2(cx+r*cos(i*dt),cy+r*sin(i*dt),out); - } -} - -void intersectline(double p1[2],double v1[2], double p2[2],double v2[2],double out[4]){ - double tmp,d,dt,ds,t,s,tmp1[2],tmp2[2],tmp3[2],pt[2]; - tmp=dotprod(2,v1,v2); - tmp1[0]=tmp; tmp1[1]=pow(norm(2,v1),2.0); - tmp2[0]=-pow(norm(2,v2),2.0);tmp2[1]=-tmp; - pt[0]=p2[0]-p1[0];pt[1]=p2[1]-p1[1]; - tmp3[0]=dotprod(2,pt,v2);tmp3[1]=dotprod(2,pt,v1); - crossprod(2,tmp1,tmp2,pt); d=pt[0]; - crossprod(2,v1,v2,pt); tmp=fabs(pt[0]); - if(tmp>Eps){ - crossprod(2,tmp3,tmp2,pt); dt=pt[0]; - crossprod(2,tmp1,tmp3,pt); ds=pt[0]; - t=dt/d; - s=ds/d; - pt[0]=p1[0]+v1[0]*t; pt[1]=p1[1]+v1[1]*t; - out[0]=pt[0];out[1]=pt[1];out[2]=t; out[3]=s; - }else{ - pt[0]=p2[0]-p1[0];pt[1]=p2[1]-p1[1]; - crossprod(2,pt,v1,tmp1); - tmp=tmp1[0]/norm(2,v1); - out[0]=fabs(tmp); out[1]=Inf; - } -} - -void intersectseg(double seg1[][2],double seg2[][2], double out[5]){ - double p1[2],q1[2],p2[2],q2[2],pt[2],pt1[2],nv[2],pts[DsizeS][4]; - double q1p1[2],q2p2[2],p1q2[2],q1p2[2],p1p2[2],q1q2[2]; - double tmp[2],tmp1[2],tmp2[2],tmp3[2],tmp4[2]; - double tmpd1,x,y,t,s,t1,s1,distance,tmpd[4],tmp3d[7]; - int ctr=0, i; - pull2(1,seg1,p1); pull2(2,seg1,q1); - pull2(1,seg2,p2); pull2(2,seg2,q2); - q1p1[0]=q1[0]-p1[0];q1p1[1]=q1[1]-p1[1]; - q2p2[0]=q2[0]-p2[0];q2p2[1]=q2[1]-p2[1]; - p1q2[0]=p1[0]-q2[0];p1q2[1]=p1[1]-q2[1]; - q1p2[0]=q1[0]-p2[0];q1p2[1]=q1[1]-p2[1]; - p1p2[0]=p1[0]-p2[0];p1p2[1]=p1[1]-p2[1]; - p1q2[0]=p1[0]-q2[0];p1q2[1]=p1[1]-q2[1]; - q1q2[0]=q1[0]-q2[0];q1q2[1]=q1[1]-q2[1]; - if((norm(2,q1p1)<Eps)||(norm(2,q2p2)<Eps)){ - out[0]=-1; out[1]=Inf; - }else{ - intersectline(p1,q1p1,p2,q2p2,tmpd); - if(tmpd[1]<Inf-Eps){ - pt[0]=tmpd[0];pt[1]=tmpd[1];t=tmpd[2];s=tmpd[3]; - if((t*(t-1)<Eps)&&(s*(s-1)<Eps)){ - out[0]=0;out[1]=pt[0];out[2]=pt[1];out[3]=t;out[4]=s; - }else{ - if(t<0){t=0;}; if(t>1){t=1;}; - if(s<0){s=0;}; if(s>1){s=1;}; - tmp3d[ctr]=norm(2,p1p2);ctr++; - tmp3d[ctr]=norm(2,p1q2);ctr++; - tmp3d[ctr]=norm(2,q1p2);ctr++; - tmp3d[ctr]=norm(2,q1q2);ctr++; - tmp1[0]=q2p2[1];tmp1[1]=-q2p2[0]; - intersectline(p1,tmp1,p2,q2p2,tmpd); - if(tmpd[1]!=Inf){ - pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3]; - if(s1*(s1-1)<Eps){ - tmp3d[ctr]=dist(2,pt1,p1);ctr++; - } - } - intersectline(q1,tmp1,p2,q2p2,tmpd); - if(tmpd[1]!=Inf){ - pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3]; - if(s1*(s1-1)<Eps){ - tmp3d[ctr]=dist(2,pt1,q1);ctr++; - } - } - tmp1[0]=q1p1[1];tmp1[1]=-q1p1[0]; - intersectline(p2,tmp1,p1,q1p1,tmpd); - if(tmpd[1]!=Inf){ - pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3]; - if(s1*(s1-1)<Eps){ - tmp3d[ctr]=dist(2,pt1,p2);ctr++; - } - } - intersectline(q2,tmp1,p1,q1p1,tmpd); - if(tmpd[1]!=Inf){ - pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3]; - if(s1*(s1-1)<Eps){ - tmp3d[ctr]=dist(2,pt1,q2);ctr++; - } - } - tmpd1=tmp3d[0]; - for(i=1;i<ctr;i++){ - if(tmp3d[i]<tmpd1){tmpd1=tmp3d[i];}; - } - out[0]=tmpd1;out[1]=pt[0];out[2]=pt[1]; - out[3]=t;out[4]=s; - } - }else{ - distance=tmpd[0]; - nv[0]=q1p1[1]/norm(2,q1p1);nv[1]=-q1p1[0]/norm(2,q1p1); - pts[0][0]=0; - intersectline(p1,nv,p2,q2p2,tmpd); - s1=tmpd[3]; - if((tmpd[1]!=Inf)&&(s1*(s1-1)<Eps)){ - x=(1-s1)*p2[0]+s1*q2[0];y=(1-s1)*p2[1]+s1*q2[1]; - push4(x,y,0,s1,pts); - } - intersectline(q1,nv,p2,q2p2,tmpd); - s1=tmpd[3]; - if((tmpd[1]!=Inf)&&(s1*(s1-1)<Eps)){ - x=(1-s1)*p2[0]+s1*q2[0];y=(1-s1)*p2[1]+s1*q2[1]; - push4(x,y,1,s1,pts); - } - intersectline(p2,nv,p1,q1p1,tmpd); - s1=tmpd[3]; - if((tmpd[1]!=Inf)&&(s1*(s1-1)<Eps)){ - x=(1-s1)*p1[0]+s1*q1[0];y=(1-s1)*p1[1]+s1*q1[1]; - push4(x,y,s1,0,pts); - } - intersectline(q2,nv,p1,q1p1,tmpd); - if((tmpd[1]!=Inf)&&(s1*(s1-1)<Eps)){ - x=(1-s1)*p1[0]+s1*q1[0];y=(1-s1)*p1[1]+s1*q1[1]; - push4(x,y,s1,2,pts); - } - if(length4(pts)==0){ - tmpd1=norm(2,p1p2); - if(norm(2,p1q2)<tmpd1){tmpd1=norm(2,p1q2);} - if(norm(2,q1p2)<tmpd1){tmpd1=norm(2,q1p2);} - if(norm(2,q1q2)<tmpd1){tmpd1=norm(2,q1q2);} - out[0]=tmpd1;out[1]=Inf; - }else{ - if(distance>Eps1){ - out[0]=distance;out[1]=Inf; - }else{ - x=0; y=0; - for(i=1; i<=length4(pts); i++){ - x=x+pts[i][0]; - y=y+pts[i][1]; - } - tmp3[0]=x/length4(pts); tmp3[1]=y/length4(pts); - nearestptpt(tmp3,seg1,tmpd); - t=tmpd[2]; - nearestptpt(tmp3,seg2,tmpd); - s=tmpd[2]; - out[0]=distance; out[1]=tmp3[0]; out[2]=tmp3[1]; - out[3]=t;out[4]=s; - } - } - } - } -} - -int osplineseg(double ptlist[5][2],int num,double out[][2]){ - double p0[2],p1[2],p2[2],p3[2],p2p0[2],p3p1[2],p2p1[2]; - double tmp,cc,pq[2],pr[2],knots[3][2],ctrlist[2][4]; - pull2(1,ptlist,p0); pull2(2,ptlist,p1); - pull2(3,ptlist,p2); pull2(4,ptlist,p3); - p2p0[0]=p2[0]-p0[0];p2p0[1]=p2[1]-p0[1]; - p3p1[0]=p3[0]-p1[0];p3p1[1]=p3[1]-p1[1]; - p2p1[0]=p2[0]-p1[0];p2p1[1]=p2[1]-p1[1]; - tmp=norm(2,p2p0)*norm(2,p3p1); - tmp=1+sqrt((1+dotprod(2,p2p0,p3p1)/tmp)/2); - cc=4*norm(2,p2p1)/3/(norm(2,p2p0)+norm(2,p3p1))/tmp; - pq[0]=p1[0]+cc*p2p0[0]; pq[1]=p1[1]+cc*p2p0[1]; - pr[0]=p2[0]-cc*p3p1[0];pr[1]=p2[1]-cc*p3p1[1]; - ctrlist[0][0]=0; - push4(pq[0],pq[1],pr[0],pr[1],ctrlist); - knots[0][0]=0; - addptd2(knots,p1);addptd2(knots,p2); - bezier(knots,ctrlist,num,out); - return length2(out); -} - -void intersectpartseg(double crv1[][2],double crv2[][2],int ii, int jj,int num,double out[6]){ - double distance=10*Eps2,seg1[3][2],seg2[3][2],tmpd[2],tmp1d[2],tmp2d[2]; - double tmp,snang,dst,tmpd5[5],os1[DsizeS][2],os2[DsizeS][2]; - double p0[2],p1[2],p2[2],p3[2],ptlist[5][2],regard[3][2]; - double tmp1md[20][2],tmpd3[3],tmp3md3[20][3],tmp2md3[20][3]; - double tmpd4[4],Eps00=pow(10,-8.0); - double sx,sy; - int kk,ll,nn; - out[0]=Inf; - for(kk=1;kk<6;kk++){out[kk]=0;} - seg1[0][0]=0;seg2[0][0]=0; - appendd2(1,ii,ii+1,crv1,seg1); - appendd2(1,jj,jj+1,crv2,seg2); - pull2(2,seg1,tmp1d); - pull2(1,seg1,tmpd); - tmp1d[0]=tmp1d[0]-tmpd[0]; tmp1d[1]=tmp1d[1]-tmpd[1]; - pull2(2,seg2,tmp2d); - pull2(1,seg2,tmpd); - tmp2d[0]=tmp2d[0]-tmpd[0]; tmp2d[1]=tmp2d[1]-tmpd[1]; - crossprod(2,tmp1d,tmp2d,tmpd); - snang=fabs(tmpd[0])/(norm(2,tmp1d)*norm(2,tmp2d)); - intersectseg(seg1,seg2,tmpd5); - dst=tmpd5[0]; - if(dst<Eps){ - if(dst>-Eps){ - out[0]=tmpd5[1];out[1]=tmpd5[2];out[2]=ii+tmpd5[3]; - out[3]=jj+tmpd5[4];out[4]=dst;out[5]=snang; - } - }else{ - if(dst<Eps2){ - os1[0][0]=0;os2[0][0]=0; - pull2(1,seg1,tmp1d); - pull2(2,seg1,tmp2d); - tmpd[0]=tmp2d[0]-tmp1d[0];tmpd[1]=tmp2d[1]-tmp1d[1]; - if((length2(crv1)==2)||(norm(2,tmpd)>distance-Eps)){ - appendd2(1,1,2,seg1,os1); - }else{ - pull2(1,seg1,p1);pull2(2,seg1,p2); - if(ii==1){ - pull2(3,crv1,p3); - tmpd[0]=p2[0]-p1[0];tmpd[1]=p2[1]-p1[1]; - tmp1d[0]=(p1[0]+p2[0])/2; - tmp1d[1]=(p1[1]+p2[1])/2; - tmp2d[0]=tmp1d[0]+tmpd[1]; - tmp2d[1]=tmp1d[1]-tmpd[0]; - regard[0][0]=0; - addptd2(regard,tmp1d); addptd2(regard,tmp2d); - reflectpoint(p3,regard,p0); - }else{ - if(ii==length2(crv1)-1){ - pull2(ii-1,crv1,p0); - tmpd[0]=p2[0]-p1[0]; tmpd[1]=p2[1]-p1[1]; - tmp1d[0]=(p1[0]+p2[0])/2; - tmp1d[1]=(p1[1]+p2[1])/2; - tmp2d[0]=tmp1d[0]+tmpd[1]; - tmp2d[1]=tmp1d[1]-tmpd[0]; - regard[0][0]=0; - addptd2(regard,tmp1d); addptd2(regard,tmp2d); - reflectpoint(p0,regard,p3); - }else{ - pull2(ii-1,crv1,p0);pull2(ii+2,crv1,p3); - } - } - ptlist[0][0]=0; - addptd2(ptlist,p0);addptd2(ptlist,p1); - addptd2(ptlist,p2);addptd2(ptlist,p3); - osplineseg(ptlist,num,os1); - } - pull2(1,seg2,tmp1d); - pull2(2,seg2,tmp2d); - if((length2(crv2)==2)||(dist(2,tmp2d,tmp1d)>distance-Eps)){ - appendd2(1,1,2,seg2,os2); - }else{ - pull2(1,seg2,p1);pull2(2,seg2,p2); - if(jj==1){ - pull2(3,crv2,p3); - tmpd[0]=p2[0]-p1[0];tmpd[1]=p2[1]-p1[1]; - tmp1d[0]=(p1[0]+p2[0])/2; - tmp1d[1]=(p1[1]+p2[1])/2; - tmp2d[0]=tmp1d[0]+tmpd[1]; - tmp2d[1]=tmp1d[1]-tmpd[0]; - regard[0][0]=0; - addptd2(regard,tmp1d); addptd2(regard,tmp2d); - reflectpoint(p3,regard,p0); - }else{ - if(jj==length2(crv2)-1){ - pull2(jj-1,crv2,p0); - tmpd[0]=p2[0]-p1[0]; tmpd[1]=p2[1]-p1[1]; - tmp1d[0]=(p1[0]+p2[0])/2; - tmp1d[1]=(p1[1]+p2[1])/2; - tmp2d[0]=tmp1d[0]+tmpd[1]; - tmp2d[1]=tmp1d[1]-tmpd[0]; - regard[0][0]=0; - addptd2(regard,tmp1d); addptd2(regard,tmp2d); - reflectpoint(p0,regard,p3); - }else{ - pull2(jj-1,crv2,p0);pull2(jj+2,crv2,p3); - } - } - ptlist[0][0]=0; - addptd2(ptlist,p0);addptd2(ptlist,p1); - addptd2(ptlist,p2);addptd2(ptlist,p3); - osplineseg(ptlist,num,os2); - } - tmp2md3[0][0]=0; - for(kk=1;kk<length2(os1);kk++){ - for(ll=1;ll<length2(os2);ll++){ - seg1[0][0]=0; seg2[0][0]=0; - pull2(kk,os1,tmpd);addptd2(seg1,tmpd); - pull2(kk+1,os1,tmpd);addptd2(seg1,tmpd); - pull2(ll,os2,tmpd);addptd2(seg2,tmpd); - pull2(ll+1,os2,tmpd);addptd2(seg2,tmpd); - intersectseg(seg1,seg2,tmpd5); - if((tmpd5[0]<Eps1)&&(tmpd5[1]<Inf-Eps)){ - if(tmpd5[0]<dst+Eps00){ - dst=tmpd5[0]; - tmp3md3[0][0]=0; - for(nn=1;nn<=length3(tmp2md3);nn++){ - pull3(nn,tmp2md3,tmpd3); - if(tmpd3[0]<dst+Eps00){ - addptd3(tmp3md3,tmpd3); - } - } - tmp2md3[0][0]=0; - for(nn=1;nn<=length3(tmp3md3);nn++){ - pull3(nn,tmp3md3,tmpd3); - addptd3(tmp2md3,tmpd3); - } - push3(dst,tmpd5[1],tmpd5[2],tmp2md3); - } - } - } - } - if(length3(tmp2md3)>0){ - tmp1md[0][0]=0; - sx=0; sy=0; - for(nn=1;nn<=length3(tmp2md3);nn++){ - pull3(nn,tmp2md3,tmpd3); - push2(tmpd3[1],tmpd3[2],tmp1md); - sx=sx+tmpd3[1]; - sy=sy+tmpd3[2]; - } - sx=sx/length3(tmp2md3); - sy=sy/length3(tmp2md3); - p0[0]=sx; p0[1]=sy; - pull2(ii,crv1,p1); pull2(ii+1,crv1,p2); - tmp1d[0]=p2[0]-p1[0];tmp1d[1]=p2[1]-p1[1]; - tmpd[0]=tmp1d[1];tmpd[1]=-tmp1d[0]; - intersectline(p0,tmpd,p1,tmp1d,tmpd4); - tmp=tmpd4[3]; - if(tmp<0){tmp=0;} - if(tmp>1){tmp=1;} - out[0]=sx;out[1]=sy;out[2]=ii+tmp; - pull2(jj,crv2,p1); pull2(jj+1,crv2,p2); - tmp1d[0]=p2[0]-p1[0];tmp1d[1]=p2[1]-p1[1]; - tmpd[0]=tmp1d[1];tmpd[1]=-tmp1d[0]; - intersectline(p0,tmpd,p1,tmp1d,tmpd4); - tmp=tmpd4[3]; - if(tmp<0){tmp=0;} - if(tmp>1){tmp=1;} - out[3]=jj+tmp;out[4]=dst;out[5]=snang; - } - } - } -} - -void collectsameseg(double ptdL[][6],double rL[][6]){ - double Eps00=pow(10,-8.0),tmp1d[2],tmp2d[2],tmp1d6[6],tmp2d6[6]; - int ii,jj,kk,nr,ctr,numL[40],diffL[40]; - double s1,e1,s2,e2,dst,tmp1,tmp2,tmp1md6[40][6]; - rL[0][0]=0; - if(length6(ptdL)==0){ - return; - } - for(ii=2;ii<=length6(ptdL);ii++){ - pull6(ii,ptdL,tmp1d6);addptd6(rL,tmp1d6); - } - tmp1md6[0][0]=0; - pull6(1,ptdL,tmp1d6); - addptd6(tmp1md6,tmp1d6); - kk=tmp1d6[2]; - if(tmp1d6[2]<kk+Eps00){ - s1=kk-1-Eps00;e1=s1+2+2*Eps00; - }else{ - s1=kk-Eps00; e1=s1+1+2*Eps00; - } - kk=tmp1d6[3]; - if(tmp1d6[3]<kk+Eps00){ - s2=kk-1-Eps00;e2=s2+2+2*Eps00; - }else{ - s2=kk-Eps00; e2=s2+1+2*Eps00; - } - ctr=1;numL[0]=0; - for(ii=1;ii<=length6(rL);ii++){ - pull6(ii,rL,tmp1d6); - tmp1=tmp1d6[2]; tmp2=tmp1d6[3]; - if((tmp1>s1)&&(tmp1<e1)&&(tmp2>s2)&&(tmp2<e2)){ - addptd6(tmp1md6,tmp1d6); - numL[ctr]=ii;ctr++; - } - } - dst=100; - for(ii=1;ii<=length6(tmp1md6);ii++){ - pull6(ii,tmp1md6,tmp1d6); - if(tmp1d6[4]<dst){ - dst=tmp1d6[4]; - } - } - ptdL[0][0]=0; - for(ii=1;ii<=length6(tmp1md6);ii++){ - pull6(ii,tmp1md6,tmp1d6); - if(tmp1d6[4]<dst+Eps00){ - addptd6(ptdL,tmp1d6); - } - } - for(ii=0;ii<=length6(rL);ii++){ - diffL[ii]=0; - } - for(ii=1;ii<=ctr;ii++){ - kk=numL[ii]; - diffL[kk]=1; - } - nr=length6(rL); - rL[0][0]=0; - for(ii=1;ii<=nr;ii++){ - if(diffL[ii]==0){ - pull6(ii,rL,tmp1d6);addptd6(rL,tmp1d6); - } - } -} - -void intersectcurvesPp(double crv1s[][2],double crv2s[][2],int num,double out[][6]){ - double Eps00=pow(10,-8.0),Dist=10*Eps2, crv1[DsizeL][2],crv2[DsizeL][2]; - double tmp1md6[DsizeS][6],tmp2md6[DsizeS][6]; - double tmpd[2],tmp1d[2],tmp2d[2],tmpd6[6],tmp1d6[6]; - double sx,sy,dst,ans[4]; - int ii,jj,kk,nall,self,js,je; - crv1[0][0]=0; - pull2(1,crv1s,tmpd);addptd2(crv1,tmpd); - for(ii=2;ii<=length2(crv1s);ii++){ - pull2(length2(crv1),crv1,tmp1d); - pull2(ii,crv1s,tmp2d); - if(dist(2,tmp1d,tmp2d)>Eps){ - addptd2(crv1,tmp2d); - } - } - crv2[0][0]=0; - pull2(1,crv2s,tmpd); - addptd2(crv2,tmpd); - for(ii=2;ii<=length2(crv2s);ii++){ - pull2(length2(crv2),crv2,tmp1d); - pull2(ii,crv2s,tmp2d); - if(dist(2,tmp1d,tmp2d)>Eps){ - addptd2(crv2,tmp2d); - } - } - if(length2(crv1)!=length2(crv2)){ - self=0; - }else{ - self=1; - for(ii=1;ii<=length2(crv1);ii++){ - pull2(ii,crv1,tmp1d);pull2(ii,crv2,tmp2d); - if(dist(2,tmp1d,tmp2d)>0){ - self=0; - break; - } - } - } - tmp1md6[0][0]=0; - for(ii=1;ii<=length2(crv1)-1;ii++){ - if(self==0){ - js=1; je=length2(crv2)-1; - }else{ - js=ii+2; je=length2(crv2)-1; - } - for(jj=js;jj<=je;jj++){ - intersectpartseg(crv1,crv2,ii,jj,num,tmpd6); - if(tmpd6[0]<Inf-Eps){ - tmpd[0]=tmpd6[0];tmpd[1]=tmpd6[1]; - if(length6(tmp1md6)==0){ - addptd6(tmp1md6,tmpd6); - }else{ - pull6(length6(tmp1md6),tmp1md6,tmp1d6); - tmp1d[0]=tmp1d6[0];tmp1d[1]=tmp1d6[1]; - if(dist(2,tmp1d,tmpd)>Eps1){ - addptd6(tmp1md6,tmpd6); - } - } - if(self==1){ - push6(tmpd6[0],tmpd6[1],tmpd6[3],tmpd6[2],tmpd6[4],tmpd6[5],tmp1md6); - } - } - } - } - out[0][0]=0; - tmp2md6[0][0]=0; - while(length6(tmp1md6)>0){ - collectsameseg(tmp1md6,tmp2md6); - dst=100; - for(ii=1;ii<=length6(tmp1md6);ii++){ - pull6(ii,tmp1md6,tmpd6); - if(tmpd6[4]<dst){ - dst=tmpd6[4]; - } - } - sx=0; sy=0;nall=0; - for(ii=1;ii<=length6(tmp1md6);ii++){ - pull6(ii,tmp1md6,tmpd6); - if(tmpd6[4]<dst+Eps00){ - nall++; - sx=sx+tmpd6[0]; sy=sy+tmpd6[1]; - } - tmp1d[0]=sx/nall; tmp1d[1]=sy/nall; - tmp1d6[0]=tmp1d[0];tmp1d6[1]=tmp1d[1]; - nearestptpt(tmp1d,crv1,ans); - tmp1d6[2]=ans[2]; - nearestptpt(tmp1d,crv2,ans); - tmp1d6[3]=ans[2]; - tmp1d6[4]=dst; - tmp1d6[5]=tmpd6[5]; - addptd6(out,tmp1d6); - } - tmp1md6[0][0]=0; - for(ii=1;ii<=length6(tmp2md6);ii++){ - pull6(ii,tmp2md6,tmpd6);addptd6(tmp1md6,tmpd6); - } - } -} - -void intersectcurves(double crv1[][2],double crv2[][2],int num,double out[][2]){ - double out6[DsizeS][6],tmpd[2],tmpd6[6]; - int jj; - intersectcurvesPp(crv1,crv2,num,out6); - out[0][0]=0; - for(jj=1;jj<=length6(out6);jj++){ - pull6(jj,out6,tmpd6);push2(tmpd6[0],tmpd6[1],out); - } -} diff --git a/texmf-dist/scripts/ketcindy/ketlibC/ketcommonhead.h b/texmf-dist/scripts/ketcindy/ketlibC/ketcommonhead.h deleted file mode 100644 index 7e83a2b9..00000000 --- a/texmf-dist/scripts/ketcindy/ketlibC/ketcommonhead.h +++ /dev/null @@ -1,97 +0,0 @@ -int length1(double gdata[]); -int length2(double gdata[][2]); -int length3(double gdata[][3]); -int length4(double gdata[][4]); -int length5(double gdata[][5]); -int length6(double gdata[][6]); -int length2i(int gdata[][2]); -void copyd(int from, int upto, double q[], double p[]); -void copyi(int from, int upto, int q[], int p[]); -int addptd2(double gdata[][2], double pt[2]); -int addptd3(double gdata[][3], double pt[3]); -int addptd4(double gdata[][4], double pt[4]); -int addptd5(double gdata[][5], double pt[5]); -int addptd6(double gdata[][6], double pt[6]); -int add2(double gdata[][2], double x, double y); -int add3(double gdata[][3], double x, double y, double z); -int push2(double x, double y, double ptL[][2]); -int push3(double x, double y, double z, double ptL[][3]); -int push4(double x, double y, double z, double w, double ptL[][4]); -int push5(double x, double y, double z, double w, double u, double ptL[][5]); -int push6(double x, double y, double z, double w, double u, double v,double ptL[][6]); -void pull2(int num, double ptL[][2],double pt[2]); -void pull3(int num, double ptL[][3],double pt[3]); -void pull4(int num, double ptL[][4],double pt[4]); -void pull5(int num, double ptL[][5],double pt[5]); -void pull6(int num, double ptL[][6],double pt[6]); -int appendd2(int level, int from,int upto, double gdata[][2],double mat[][2]); -int appendd3(int level, int from,int upto, double gdata[][3],double mat[][3]); -int prependd2(int from,int upto, double gdata[][2],double mat[][2]); -int appendd1(double numvec[], double num); -int appendi1(int numvec[],int num); -int prependi1(int num, int numvec[]); -int removei2(int nrmv,int mat[][2]); -int dataindexi1(int out[],int din[][2]); -int dataindexd1(double out[],int din[][2]); -int dataindexd2(int level,double out[][2],int din[][2]); -int dataindexd3(int level, double out[][3],int din[][2]); -int dataindexd4(int level, double out[][4],int din[][2]); -void dispvec(int n,double dt[]); -void dispveci(int n,int dt[]); -void dispmatd2(int from, int upto, double mat[][2]); -void dispmatd3(int from, int upto, double mat[][3]); -void dispmatd4(int from, int upto, double mat[][4]); -void dispmatd5(int from, int upto, double mat[][5]); -void dispmatd6(int from, int upto, double mat[][6]); -void dispmatd2all(double mat[][2]); -void dispmatd3all(double mat[][3]); -void dispmatd4all(double mat[][4]); -void dispmatd5all(double mat[][5]); -void dispmatd6all(double mat[][6]); -void dispmati2(int from, int upto, int mat[][2]); -void dispmati1(int from, int upto, int mat[]); -void readdata3(const char *fname, double out[][3]); -void readdata2(const char *fname, double out[][2]); -int output2(const char *var, const char *fname, int level, double out[][2]); -void simplesort(double number[]); -int memberi(int a, int list[]); -double dotprod(int dim, double p[], double q[]); -double norm(int dim, double p[]); -double dist(int dim, double p[], double q[]); -void crossprod(int dim,double a[3],double b[3], double out[3]); -void reflectpoint(double p1[2],double regard[][2],double p2[2]); -void pointoncurve(double t, double gdata[][2], double eps, double pt[]); -int partcrv(double a,double b,double pkL[][2], double pL[][2]); -int partcrv3(double a,double b,double pkL[][3], double pL[][3]); -int connectseg(double pdata[][2], double eps, double out[][2]); -void koutenseg(double a[2], double b[2], double c[2], double d[2], - double eps, double eps2, double out[4]); -double paramoncurve(double p[2], int n, double ptL[][2]); -void nearestptpt(double pa[2], double pL[][2], double ans[4]); -int intersectselfPp(double data1[][2],double eps,double eps1s,double kL[][4]); -int intersectcrvsPp(double data1[][2], double data2[][2], - double eps,double eps1s, double kL[][4]); -int dropnumlistcrv(double qd[][2], double eps1, int out[]); -int increasept2(double ptL[][2], int nn, double out[][2]); -int increasept3(double ptL[][3], int nn, double out[][3]); -void bezierpt(double t, double p0[2], double p3[2], - double p1[2], double p2[2], double ptout[2]); -int bezier(double ptL[][2], double ctrL[][4], int num, double out[][2]); -int ospline(int level, double ptL[][2], int num, double out[][2]); -void bezierpt3(double t, double p0[3], double p3[3], - double p1[3], double p2[3], double ptout[3]); -int bezier3(double ptL[][3], double ctrL[][6], int num, double out[][3]); -int ospline3(int level, double ptL[][3], int num, double out[][3]); -void segplot(double x1,double y1,double x2,double y2,double seg[][2]); -void addsegplot(double x1,double y1,double seg[][2]); -void circledata(double cx,double cy,double r, int num,double out[][2]); -void intersectline(double p1[2],double v1[2], double p2[2],double v2[2],double out[4]); -void intersectseg(double seg1[][2],double seg2[][2], double out[5]); -int osplineseg(double ptlist[5][2],int num,double out[][2]); -void intersectpartseg(double crv1[][2],double crv2[][2],int ii, int jj,int num,double out[6]); -void collectsameseg(double ptdL[][6],double rL[][6]); -void intersectcurvesPp(double crv1s[][2],double crv2s[][2],int num,double out[][6]); -void intersectcurves(double crv1[][2],double crv2[][2],int num,double out[][2]); - -const double Inf=99999; -const int Infint=30000; diff --git a/texmf-dist/scripts/ketcindy/ketlibC/surflib.h b/texmf-dist/scripts/ketcindy/ketlibC/surflib.h deleted file mode 100644 index d9c0fbdc..00000000 --- a/texmf-dist/scripts/ketcindy/ketlibC/surflib.h +++ /dev/null @@ -1,2098 +0,0 @@ -// 17.06.16 crvsfparadata changed ( num of devision ) - -int output3(const char *var, const char *fname, int level, double out[][3]){ - int nall=floor(out[0][0]+0.5), ndin, din[DsizeM][2],i,j,ctr; - double tmpd[3]; - FILE *fp; - fp=fopen(fname,"w"); - if (fp == NULL) { - printf("cannot open\n"); - return -1; -// exit(1); - } - ndin=dataindexd3(level, out,din); - fprintf(fp,"%s//\n",var); //17.05.29 -// fprintf(fp,"%s3d//\n",var2); - for(i=1; i<=ndin; i++){ - fprintf(fp,"start//\n"); - fprintf(fp,"["); - ctr=0; - for(j=din[i][0]; j<=din[i][1]; j++){ - pull3(j,out,tmpd); - fprintf(fp,"[ %7.5f, %7.5f, %7.5f]",tmpd[0],tmpd[1],tmpd[2]); - ctr++; - if(ctr==5){ - fprintf(fp,"]//\n["); - ctr=0; - }else{ - if(j<din[i][1]){ - fprintf(fp,","); - } - } - } - fprintf(fp,"]//\n"); - if(i<ndin){ - fprintf(fp,"end//\n"); - } - else{ - fprintf(fp,"end////\n"); - } - } - fclose(fp); - return 0; -} - -int output3h(const char *var, const char *varh, const char *fname, double out[][3]){ - // 17.06.09 - double out1[DsizeLL][3], tmpd[3]; - int din1[DsizeM][2],din2[DsizeM][2], i, j,ctr; - FILE *fp; - fp=fopen(fname,"w"); - if (fp == NULL) { - printf("cannot open\n"); - return -1; - } - dataindexd3(3,out,din1); - out1[0][0]=0; - appendd3(0, din1[1][0],din1[1][1],out,out1); - dataindexd3(2, out1,din2); - fprintf(fp,"%s//\n",var); - for(i=1; i<=length2i(din2); i++){ - fprintf(fp,"start//\n"); - fprintf(fp,"["); - ctr=0; - for(j=din2[i][0]; j<=din2[i][1]; j++){ - pull3(j,out1,tmpd); - fprintf(fp,"[ %7.5f, %7.5f, %7.5f]",tmpd[0],tmpd[1],tmpd[2]); - ctr++; - if(ctr==5){ - if(j<din2[i][1]){ - fprintf(fp,"]//\n["); - ctr=0; - } - }else{ - if(j<din2[i][1]){ - fprintf(fp,","); - } - } - } - fprintf(fp,"]//\n"); - fprintf(fp,"end//\n"); - } - out1[0][0]=0; - fprintf(fp,"%s//\n",varh); //17.06.16from - appendd3(0, din1[2][0],din1[2][1],out,out1); - dataindexd3(2, out1,din2); - for(i=1; i<=length2i(din2); i++){ - fprintf(fp,"start//\n"); - fprintf(fp,"["); - for(j=din2[i][0]; j<=din2[i][1]; j++){ - pull3(j,out1,tmpd); - fprintf(fp,"[ %7.5f, %7.5f, %7.5f]",tmpd[0],tmpd[1],tmpd[2]); - ctr++; - if(ctr==5){ - if(j<din2[i][1]){ - fprintf(fp,"]//\n["); - ctr=0; - } - }else{ - if(j<din2[i][1]){ - fprintf(fp,","); - } - } - } - fprintf(fp,"]//\n"); -// if(i<ndin2){ - fprintf(fp,"end//\n"); -// } -// else{ -// fprintf(fp,"end////\n"); -// } - } - fprintf(fp,"//\n"); - fclose(fp); - return 0; -} - -int writedataC(const char *fname, double out[][3]){ - int i, nall; - FILE *fp; - nall=length3(out); - fp=fopen(fname,"w"); - for(i=1; i<=nall; i++){ - fprintf(fp,"%7.5f %7.5f %7.5f\n",out[i][0],out[i][1],out[i][2]); - } - fprintf(fp,"%7.5f %7.5f %7.5f\n",Inf,Inf,Inf); - fclose(fp); - return nall; -} - -int readdataC(const char *fname, double data[][3]){ - int i, j, ndata=0; - FILE *fp; - fp=fopen(fname,"r"); - if(fp==NULL){ - printf("file not found\n"); - return 1; - } - while( ! feof(fp) && ndata<DsizeL){ - ndata++; - for(j=0;j<=2;j++){ - fscanf(fp,"%lf",&data[ndata][j]); - } - if(data[ndata][1]==Inf){ - ndata--; - break; - } - } - fclose(fp); - data[0][0]=ndata; - return ndata; -} - -void parapt(double pt3[3],double pt2[2]){ - if(fabs(pt3[0])>Inf-1){ - pt2[0]=pt3[0]; pt2[1]=pt3[1]; - } - else{ - pt2[0]=-pt3[0]*sin(PHI)+pt3[1]*cos(PHI); - pt2[1]=-pt3[0]*cos(PHI)*cos(THETA)-pt3[1]*sin(PHI)*cos(THETA)+pt3[2]*sin(THETA); - } -} - -int projpara(double p3[][3], double p2[][2]){ - double pt3[3], pt2[2]; - int i, nall, nall2; - nall=length3(p3); - p2[0][0]=0; - for(i=1; i<=nall; i++){ - pull3(i,p3,pt3); - parapt(pt3,pt2); - nall2=addptd2(p2,pt2); - } - return nall2; -} - -double invparapt(double ph, double fh[][2], double fk[][3],double out[3]){ - int n, nfk=length3(fk), nph=length2(fh); - double s0=ph-n, ak[3], bk[3], ah[2], bh[2], pk[3]; - if(nfk>2){ - n=trunc(ph); - s0=ph-n; - if(ph>nph-Eps){ - out[0]=fk[nfk][0]; out[1]=fk[nfk][1]; out[2]=fk[nfk][2]; - return nph; - } - } - else{ - n=1; - s0=ph-1; - } - ak[0]=fk[n][0]; ak[1]=fk[n][1]; ak[2]=fk[n][2]; - bk[0]=fk[n+1][0]; bk[1]=fk[n+1][1]; bk[2]=fk[n+1][2]; - ah[0]=fh[n][0]; ah[1]=fh[n][1]; - bh[0]=fh[n+1][0]; bh[1]=fh[n+1][1]; - out[0]=(1-s0)*ak[0]+s0*bk[0]; - out[1]=(1-s0)*ak[1]+s0*bk[1]; - out[2]=(1-s0)*ak[2]+s0*bk[2]; - return n+s0; -} - -int surfcurve(short ch,int level, double crv[][2], double pdata[][3]){ - double p2[2], pt[3]; - int i, n, nall; - n=length2(crv); - pdata[0][0]=0; - for(i=1; i<=n; i++){ - pull2(i,crv,p2); - surffun(ch,p2[0],p2[1],pt); - nall=addptd3(pdata,pt); - } - return nall; -} - -int xyzax3data(double x0, double x1, double y0, double y1, double z0, double z1, - double out[][3]){ - int nall; - double pd3[10][3]; - out[0][0]=0; nall=0; - pd3[0][0]=2; - pd3[1][0]=x0; pd3[1][1]=0; pd3[1][2]=0; - pd3[2][0]=x1; pd3[2][1]=0; pd3[2][2]=0; - nall=appendd3(2,1,2,pd3,out); - pd3[1][0]=0; pd3[1][1]=y0; pd3[1][2]=0; - pd3[2][0]=0; pd3[2][1]=y1; pd3[2][2]=0; - nall=appendd3(2,1,2,pd3,out); - pd3[1][0]=0; pd3[1][1]=0; pd3[1][2]=z0; - pd3[2][0]=0; pd3[2][1]=0; pd3[2][2]=z1; - nall=appendd3(2,1,2,pd3,out); - return nall; -} - -void evlptablepara(short ch){ - int i, j; - double u,v,u1,u2,v1,v2,pt1[3],pt2[3],pt2d1[2],pt2d2[2],dxu,dyu,dxv,dyv; - double du=(Urng[1]-Urng[0])/Mdv, dv=(Vrng[1]-Vrng[0])/Ndv; - double eps=0.00001; - for (j= 0; j < Ndv+1; j++) { - v=Vrng[0]+j*dv; - v1=v-eps/2; v2=v+eps/2; - for (i = 0; i < Mdv+1; i++) { - u=Urng[0]+i*du; - u1=u-eps/2; u2=u+eps/2; - surffun(ch,u1,v,pt1); parapt(pt1,pt2d1); - surffun(ch,u2,v,pt2); parapt(pt2,pt2d2); - dxu=(pt2d2[0]-pt2d1[0])/eps; - dyu=(pt2d2[1]-pt2d1[1])/eps; - surffun(ch,u,v1,pt1); parapt(pt1,pt2d1); - surffun(ch,u,v2,pt2); parapt(pt2,pt2d2); - dxv=(pt2d2[0]-pt2d1[0])/eps; - dyv=(pt2d2[1]-pt2d1[1])/eps; - Zval[j][i]=dxu*dyv-dxv*dyu; - } - } - for (i = 0; i < Mdv+1; i++) { - Xval[i]=Urng[0]+i*du; - } - for (j= 0; j < Ndv+1; j++) { - Yval[j]=Vrng[0]+j*dv; - } -}; - -double evlpfun(short ch, double u, double v){ - double u1,u2,v1,v2,pt1[3],pt2[3],pt2d1[2],pt2d2[2],dxu,dyu,dxv,dyv; - double du=(Urng[1]-Urng[0])/Mdv, dv=(Vrng[1]-Vrng[0])/Ndv; - double eps=0.00001; - u1=u-eps/2; u2=u+eps/2; - if(u1<Urng[0]){u1=Urng[0];} - if(u2>Urng[1]){u2=Urng[1];} - surffun(ch,u1,v,pt1); parapt(pt1,pt2d1); - surffun(ch,u2,v,pt2); parapt(pt2,pt2d2); - dxu=(pt2d2[0]-pt2d1[0])/(u2-u1); - dyu=(pt2d2[1]-pt2d1[1])/(u2-u1); - v1=v-eps/2; v2=v+eps/2; - if(v1<Vrng[0]){v1=Vrng[0];} - if(v2>Vrng[1]){v2=Vrng[1];} - surffun(ch,u,v1,pt1); parapt(pt1,pt2d1); - surffun(ch,u,v2,pt2); parapt(pt2,pt2d2); - dxv=(pt2d2[0]-pt2d1[0])/(v2-v1); - dyv=(pt2d2[1]-pt2d1[1])/(v2-v1); - return dxu*dyv-dxv*dyu; -}; - -int envelopedata(short ch, double out[][2]){ - int i, j, k, ctrq=0,ctr, nall; - double uval1,uval2,vval1,vval2,eval11,eval12,eval21,eval22; - double pl[5][2], vl[5], ql[11][2], out2[DsizeM][2]; - double du=(Urng[1]-Urng[0])/Mdv; - double dv=(Vrng[1]-Vrng[0])/Mdv; - ctr=0; - for (j = 0; j < Ndv; j++) { - vval1=Vrng[0]+j*dv; - vval2=Vrng[0]+(j+1)*dv; - uval1=Urng[0]; - eval11=evlpfun(ch,uval1,vval1); - eval12=evlpfun(ch,uval1,vval2); - for (i = 0; i < Mdv; i++) { - uval2=Urng[0]+(i+1)*du; - eval21=evlpfun(ch,uval2,vval1); - eval22=evlpfun(ch,uval2,vval2); - pl[0][0]=uval1; pl[0][1]=vval1; vl[0]=eval11; - pl[1][0]=uval2; pl[1][1]=vval1; vl[1]=eval21; - pl[2][0]=uval2; pl[2][1]=vval2; vl[2]=eval22; - pl[3][0]=uval1; pl[3][1]=vval2; vl[3]=eval12; - pl[4][0]=uval1; pl[4][1]=vval1; vl[4]=eval11; - ctrq=0; - for (k = 0; k < 4; k++) { - if(fabs(vl[k])<=Eps){ - ql[ctrq][0]=pl[k][0]; - ql[ctrq][1]=pl[k][1]; - ctrq++; - } - else if(vl[k]>Eps){ - if(vl[k+1]< -Eps){ - ql[ctrq][0]=1/(vl[k]-vl[k+1])*(-vl[k+1]*pl[k][0]+vl[k]*pl[k+1][0]); - ql[ctrq][1]=1/(vl[k]-vl[k+1])*(-vl[k+1]*pl[k][1]+vl[k]*pl[k+1][1]); - ctrq++; - } - } - else{ - if(vl[k+1]>Eps){ - ql[ctrq][0]=1/(-vl[k]+vl[k+1])*(vl[k+1]*pl[k][0]-vl[k]*pl[k+1][0]); - ql[ctrq][1]=1/(-vl[k]+vl[k+1])*(vl[k+1]*pl[k][1]-vl[k]*pl[k+1][1]); - ctrq++; - } - } - } - uval1=uval2; - eval11=eval21; - eval12=eval22; - if(ctrq==2){ - if(ctr>0){ - ctr++; - out[ctr][0]=Inf; - out[ctr][1]=2; // 2 <- 0 ? - } - ctr++; - out[ctr][0]=ql[0][0]; - out[ctr][1]=ql[0][1]; - ctr++; - out[ctr][0]=ql[1][0]; - out[ctr][1]=ql[1][1]; - } - } - } - out[0][0]=ctr; - if(ctr>0){ - nall=connectseg(out, Eps, out2); - out[0][0]=0; - nall=appendd2(2,1,nall,out2,out); - } - return nall; -} - -/* - -int implicitplot(double out[][2]){ - int i, j, k, ctrq=0,ctr, nall; - double pl[5][2], vl[5], ql[11][2], out2[DsizeM][2]; - ctr=0; - for (j = 0; j < Ndv; j++) { - for (i = 0; i < Mdv; i++) { - pl[0][0]=Xval[i]; pl[0][1]=Yval[j]; vl[0]=Zval[j][i]; - pl[1][0]=Xval[i+1]; pl[1][1]=Yval[j]; vl[1]=Zval[j][i+1]; - pl[2][0]=Xval[i+1]; pl[2][1]=Yval[j+1]; vl[2]=Zval[j+1][i+1]; - pl[3][0]=Xval[i]; pl[3][1]=Yval[j+1]; vl[3]=Zval[j+1][i]; - pl[4][0]=Xval[i]; pl[4][1]=Yval[j]; vl[4]=Zval[j][i]; - ctrq=0; - for (k = 0; k < 4; k++) { - if(fabs(vl[k])<=Eps){ - ql[ctrq][0]=pl[k][0]; - ql[ctrq][1]=pl[k][1]; - ctrq++; - } - else if(vl[k]>Eps){ - if(vl[k+1]< -Eps){ - ql[ctrq][0]=1/(vl[k]-vl[k+1])*(-vl[k+1]*pl[k][0]+vl[k]*pl[k+1][0]); - ql[ctrq][1]=1/(vl[k]-vl[k+1])*(-vl[k+1]*pl[k][1]+vl[k]*pl[k+1][1]); - ctrq++; - } - } - else{ - if(vl[k+1]>Eps){ - ql[ctrq][0]=1/(-vl[k]+vl[k+1])*(vl[k+1]*pl[k][0]-vl[k]*pl[k+1][0]); - ql[ctrq][1]=1/(-vl[k]+vl[k+1])*(vl[k+1]*pl[k][1]-vl[k]*pl[k+1][1]); - ctrq++; - } - } - } - if(ctrq==2){ - if(ctr>0){ - ctr++; - out[ctr][0]=Inf; - out[ctr][1]=2; // 2 <- 0 ? - } - ctr++; - out[ctr][0]=ql[0][0]; - out[ctr][1]=ql[0][1]; - ctr++; - out[ctr][0]=ql[1][0]; - out[ctr][1]=ql[1][1]; - } - } - } - out[0][0]=ctr; - if(ctr>0){ - nall=connectseg(out, Eps, out2); - out[0][0]=0; - nall=appendd2(2,1,nall,out2,out); - } - return nall; -} - -*/ - -int cuspsplitpara(short ch,double pdata[][2], double outkL[][3]){ - int i, j, ng, n, nd, ndd, ndrop, is, ncusp=0, ncusppt,st, en, npk,nph, cflg; - int cusp[DsizeM], cuspflg; - int ntmp,ntmp1,ntmp2, ntmpnum, noutkL=0, noutk=0, nout=0; - int din[DsizeM][2], dind[DsizeM][2], drop[DsizeL], tmpnum[DsizeM]; - double eps=pow(10.0,-6.0); - double vtmp, vtmp1,kaku,cva, ps[2], pe[2],v1[2],v2[2]; - double tmp[2],tmp1[2],tmp2[2],pt3d[3],pt2d[2],q3d[3],q2d[2]; - double ptk[DsizeM][3],pth[DsizeM][2], outk[DsizeM][3]; - double ptxy[DsizeM][2],tmp3d[DsizeM][3]; - double tmp3d1[DsizeM][3],tmp3d2[DsizeM][3],tmp2d[DsizeM][2]; - outkL[0][0]=0; - cusp[0]=0; - Cuspsplitpt[0][0]=0; - nd=dataindexd2(0,pdata,din); - for(ng=1; ng<=nd; ng++){ - ptk[0][0]=0; pth[0][0]=0; - st=din[ng][0]; en=din[ng][1]; - ptxy[0][0]=0; - n=appendd2(0,st,en,pdata,ptxy); - npk=0; nph=0; - for(i=1; i<=en-st+1; i++){ - pull2(st+i-1,pdata,tmp); - surffun(ch,tmp[0],tmp[1],pt3d); - parapt(pt3d,pt2d); - if(i==1){ - npk=addptd3(ptk,pt3d); - nph=addptd2(pth,pt2d); - } - else{ - pull2(nph,pth,tmp1); - if(dist(2,tmp1,pt2d)>eps){ - npk=addptd3(ptk,pt3d); - nph=addptd2(pth,pt2d); - } - } - } - if(nph==0){ - npk=0; - return 0; - }; - pull2(1,pth,ps); - pull2(nph,pth,pe); - cflg=0; - if(dist(2,ps,pe)<Eps1){cflg=1;} - ncusp=0; cusp[0]=0; - cva=cos(10*M_PI/180); - for(i=1; i<=nph-1; i++){ - if(nph==2){break;} - pull2(i,pth,tmp); - tmp[0]=pth[i][0]; tmp[1]=pth[i][1]; - if(i==1){ - if(cflg==0){continue;} - pull2(nph-1,pth,tmp1); - } - else{ - pull2(i-1,pth,tmp1); - } - pull2(i+1,pth,tmp2); - v1[0]=tmp[0]-tmp1[0]; v1[1]=tmp[1]-tmp1[1]; - v2[0]=tmp2[0]-tmp[0]; v2[1]=tmp2[1]-tmp[1]; - vtmp=v1[0]*v2[0]+v1[1]*v2[1]; - tmp[0]=0; tmp[1]=0; - vtmp=vtmp/(dist(2,v1,tmp)*dist(2,v2,tmp)); - cuspflg=0; - if(vtmp<cva){ - pt2d[0]=pth[i][0]; pt2d[1]=pth[i][1]; - kaku=acos(vtmp)*180/M_PI; - if(v1[0]*v2[1]-v1[1]*v2[0]<0){ - kaku=-kaku; - } - cuspflg=0; - for(j=i+1; j<=nph-1; j++){ - if(fabs(kaku)>90){ - cuspflg=1; - break; - } - pull2(j,pth,q2d); - if(dist(2,pt2d,q2d)>Eps1){ - break; - } - v1[0]=q2d[0]-pth[j-1][0]; v1[1]=q2d[1]-pth[j-1][1]; - v2[0]=pth[j+1][0]-q2d[0]; v2[1]=pth[j+1][1]-q2d[1]; - vtmp=v1[0]*v2[0]+v1[1]*v2[1]; - tmp[0]=0; tmp[1]=0; - vtmp=vtmp/(dist(2,v1,tmp)*dist(2,v2,tmp)); - vtmp=acos(vtmp)*180/M_PI; - if(v1[0]*v2[1]-v1[1]*v2[0]<0){ - vtmp=-vtmp; - } - kaku=kaku+vtmp; - } - if(cuspflg==1){ - ntmp=trunc((i+j)*0.5); - i=j; - if(cusp[0]==0){ - ncusp=appendi1(cusp,ntmp); - } - else{ - ncusp=appendi1(cusp,ntmp); - } - } - } - } - if(cflg==0){ - ncusp=prependi1(1,cusp); - ncusp=appendi1(cusp,nph); - } - else if(ncusp==0){ - ncusp=prependi1(1,cusp); - ncusp=appendi1(cusp,nph); - } - else if(cusp[1]==1){ - ncusp=appendi1(cusp,nph); - } - else{ - ntmp=cusp[1]; - ntmp1=nph; - tmp2d[0][0]=0; - n=appendd2(0,ntmp,ntmp1,pth,tmp2d); - n=appendd2(0,2,ntmp,pth,tmp2d); - pth[0][0]=0; - nph=appendd2(0,1,n,tmp2d,pth); - tmp3d[0][0]=0; - n=appendd3(0,ntmp,ntmp1,ptk,tmp3d); - n=appendd3(0,2,ntmp,ptk,tmp3d); - ptk[0][0]=0; - npk=appendd3(0,1,n,tmp3d,ptk); - for(i=1; i<=cusp[0]; i++){ - cusp[i]=cusp[i]-ntmp+1; - } - ncusp=appendi1(cusp,nph); - } - if(ncusp==2){ - pull2(nph,pth,tmp); - if(npk>=2){ - ncusppt=addptd2(Cuspsplitpt,tmp); - noutkL=appendd3(2,1,npk,ptk,outkL); - } - continue; - } - outk[0][0]=0; - is=1; - for(i=1; i<=ncusp-1; i++){ - ntmp1=cusp[is]; ntmp2=cusp[i+1]; - pull2(ntmp1,pth,tmp1); - pull2(ntmp2,pth,tmp2); - if(dist(2,tmp1,tmp2)>Eps1){ - tmp3d[0][0]=0; - n=appendd3(0,ntmp1,ntmp2,ptk,tmp3d); - noutk=appendd3(2,1,n,tmp3d,outk); - ncusppt=addptd2(Cuspsplitpt,tmp2); - is=i+1; - } - } - noutkL=appendd3(2,1,noutk,outk,outkL); - } - n=projpara(outkL,tmp2d); - ndrop=dropnumlistcrv(tmp2d,Eps1*0.5,drop); - nd=dataindexd3(2,outkL,din); - ndd=dataindexi1(drop,dind); - tmp3d2[0][0]=0; ntmp2=0; - for(i=1; i<=nd; i++){ - tmp3d[0][0]=0; ntmp=0; - ntmp=appendd3(0,din[i][0],din[i][1],outkL,tmp3d); - tmpnum[0]=0; ntmpnum=0; - for(j=dind[i][0]; j<=dind[i][1]; j++){ - ntmpnum=appendi1(tmpnum,drop[j]); - } - tmp3d1[0][0]=0; ntmp1=0; - for(j=1; j<=ntmpnum; j++){ - pt3d[0]=tmp3d[tmpnum[j]][0]; - pt3d[1]=tmp3d[tmpnum[j]][1]; - pt3d[2]=tmp3d[tmpnum[j]][2]; - ntmp1=addptd3(tmp3d1,pt3d); - } - if(ntmp1>0){ - ntmp2=appendd3(2,1,ntmp1,tmp3d1,tmp3d2); - } - } - outkL[0][0]=0; noutkL=0; - noutkL=appendd3(0,1,ntmp2,tmp3d2,outkL); - return noutkL; -} - -int makexybdy(short ch,double ehL[][2]){ - int i, nehL, ntmpd2; - double ptd3[3],ptd2[2],tmpd2[DsizeM][2],du,dv; - ehL[0][0]=0; nehL=0; - du=(Urng[1]-Urng[0])/Mdv; - dv=(Vrng[1]-Vrng[0])/Ndv; - if(DrawE==1){ - tmpd2[0][0]=0; ntmpd2=0; - for(i=0; i<=Ndv; i++){ - surffun(ch,Urng[1],Vrng[0]+i*dv,ptd3); - ntmpd2=push2(ptd3[0],ptd3[1],tmpd2); - } - nehL=appendd2(2,1,ntmpd2,tmpd2,ehL); - } - if(DrawN==1){ - tmpd2[0][0]=0; ntmpd2=0; - for(i=0; i<=Mdv; i++){ - surffun(ch,Urng[0]+i*du,Vrng[1],ptd3); - ntmpd2=push2(ptd3[0],ptd3[1],tmpd2); - } - nehL=appendd2(2,1,ntmpd2,tmpd2,ehL); - } - if(DrawW==1){ - tmpd2[0][0]=0; ntmpd2=0; - for(i=0; i<=Ndv; i++){ - surffun(ch,Urng[0],Vrng[0]+i*dv,ptd3); - ntmpd2=push2(ptd3[0],ptd3[1],tmpd2); - } - nehL=appendd2(2,1,ntmpd2,tmpd2,ehL); - } - if(DrawS==1){ - tmpd2[0][0]=0; ntmpd2=0; - for(i=0; i<=Mdv; i++){ - surffun(ch,Urng[0]+i*du,Vrng[0],ptd3); - ntmpd2=push2(ptd3[0],ptd3[1],tmpd2); - } - nehL=appendd2(2,1,ntmpd2,tmpd2,ehL); - } - return nehL; -} - -void partitionseg(double fig[][2],double gL[][2], int ns, double parL[]){ - int ii,jj,kk,n,din[DsizeM][2],din2[DsizeM][2]; - double eps0=pow(10,-5.0),tmpd4[4], tmpd6[6],tmp,tmp2; - double p[2], q[2], pd3[3], ans[4], tmp1d1[DsizeM], tmp2d1[DsizeM]; - double other[DsizeM], g[DsizeM][2], kouL[DsizeS][4],kouL6[DsizeS][6]; - if(ns>1){ - dataindexd1(Otherpartition,din); - other[0]=0; - for(ii=din[ns][0]; ii<=din[ns][1]; ii++){ - appendd1(other,Otherpartition[ii]); - } - }else{ - other[0]=0; - } - parL[0]=0; - appendd1(parL,1); - appendd1(parL,length2(fig)); - if(length1(other)>0){ - for(ii=1; ii<=length1(other); ii++){ - appendd1(parL,other[ii]); - } - } - dataindexd2(2,gL,din); - for(n=ns; n<=din[0][0]; n++){ - g[0][0]=0; - appendd2(2,din[n][0],din[n][1],gL,g); - intersectcurvesPp(fig,g,20,kouL6); - kouL[0][0]=0; - for(ii=1;ii<=length6(kouL6);ii++){ - pull6(ii,kouL6,tmpd6); - push4(tmpd6[0],tmpd6[1],tmpd6[2],tmpd6[3],kouL); - } - tmp1d1[0]=0;tmp2d1[0]=0; - for(jj=1;jj<=length4(kouL);jj++){ - pull4(jj,kouL,tmpd4); - tmp=tmpd4[2]; - if((tmp>1+Eps)&&(tmp<length2(fig)-Eps)){ - appendd1(tmp1d1,tmp); - } - tmp=tmpd4[3]; - if((tmp>1+Eps)&&(tmp<length2(g)-Eps)){ - appendd1(tmp2d1,tmp); - } - } - for(jj=1;jj<=length1(tmp1d1);jj++){ - appendd1(parL,tmp1d1[jj]); - } - if((ns>0)&&(n>ns)&&(length1(tmp2d1)>0)){ - dataindexd1(Otherpartition,din); - tmp1d1[0]=0; - for(ii=1;ii<=length2i(din);ii++){ - if(ii==n){ - for(kk=1;kk<=length1(tmp2d1);kk++){ - appendd1(tmp1d1,tmp2d1[kk]); - } - } - for(jj=din[ii][0]; jj<=din[ii][1];jj++){ - appendd1(tmp1d1,Otherpartition[jj]); - } - if(ii<length2i(din)){ - appendd1(tmp1d1,Inf); - } - } - } - dataindexd1(tmp1d1,din); - Otherpartition[0]=0; - for(ii=1;ii<=length2i(din);ii++){ - for(jj=din[ii][0];jj<=din[ii][1];jj++){ - appendd1(Otherpartition,tmp1d1[jj]); - } - } - } - simplesort(parL); - tmp1d1[0]=0; - for(ii=1;ii<=length1(parL);ii++){ - appendd1(tmp1d1,parL[ii]); - } - parL[0]=0; - tmp2=-1; - for(jj=1;jj<=length1(tmp1d1);jj++){ - tmp=tmp1d1[jj]; - if(fabs(tmp-tmp2)>Eps1){ - appendd1(parL,tmp); - tmp2=tmp; - } - } -} - -double funpthiddenQ(short ch,double u, double v, double pa[3]){ - double Vec[3]={sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)}; - double eps0=pow(10,-4.0)*(XMAX-XMIN)/10, pt[3], out; - surffun(ch,u, v, pt); - if((fabs(Vec[1])>eps0)||(fabs(Vec[0])>eps0)){ - out=(Vec[1]*(pt[0]-pa[0])-Vec[0]*(pt[1]-pa[1])); - } - else{ - out=pt[0]-pa[0]; - } - return out; -} - -void makevaltable(double pta[3]){ - double eps0=pow(10,-6.0), u, v, du, dv, p[3]; - int i, j, nx=0, ny=0; ; - du=(Urng[1]-Urng[0])/Mdv; - dv=(Vrng[1]-Vrng[0])/Ndv; - for(j=0; j<=Ndv; j++){ - v=Vrng[0]+j*dv; - for(i=0; i<=Mdv; i++){ - u=Urng[0]+i*du; - Zval[j][i]=funpthiddenQ(Ch,u, v, pta); - } - } - for(i=0; i<=Mdv; i++){ - Xval[i]=Urng[0]+i*du; - } - for(j=0; j<=Ndv; j++){ - Yval[j]=Vrng[0]+j*dv; - } -} - -int pthiddenQ(short ch,double pta[3], int uveq, double eps[2]){ - int i, j, k, out, nqL, nsL, nptL, flg, nxt; - double Vec[3]={sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)}; - double eps0, epspt, vec1[3], po[3]={0,0,0}, tmpd1, tmp1d1, tmp2d1, m1, m2; - double tmp3d1, tmp4d1, tmp5d1, tmp6d1, tmpd3[3], v1, v2, v3; - double tmpd2[2], p1[2], p2[2], ptuv[2], puv1[2], puv2[2]; - double p1d3[3], p2d3[3], ptd3[3]; - double ptL[DsizeM][6], sL[DsizeM][7], qL[DsizeM][2], pL[5][2], vL[5]; -// Out=1 : hidden -// SL : List of segments near PtA+Vec - eps0=pow(10,-4.0)*(XMAX-XMIN)/10.0; - epspt=eps[0]*(XMAX-XMIN)/10.0; - out=0; - po[0]=0; po[1]=0; po[2]=0; - tmpd1=1/dist(3,Vec,po); - vec1[0]=tmpd1*Vec[0]; - vec1[1]=tmpd1*Vec[1]; - vec1[2]=tmpd1*Vec[2]; - nptL=0; - makevaltable(pta); - nsL=0; - for(j=0; j<=Ndv-1; j++){ - for(i=0; i<=Mdv-1; i++){ - pL[0][0]=Xval[i]; pL[0][1]=Yval[j]; vL[0]=Zval[j][i]; - pL[1][0]=Xval[i+1]; pL[1][1]=Yval[j]; vL[1]=Zval[j][i+1]; - pL[2][0]=Xval[i+1]; pL[2][1]=Yval[j+1]; vL[2]=Zval[j+1][i+1]; - pL[3][0]=Xval[i]; pL[3][1]=Yval[j+1]; vL[3]=Zval[j+1][i]; - pL[4][0]=Xval[i]; pL[4][1]=Yval[j]; vL[4]=Zval[j][i]; - qL[0][0]=0; nqL=0; - for(k=0; k<=3; k++){ - p1[0]=pL[k][0]; p1[1]=pL[k][1]; - p2[0]=pL[k+1][0]; p2[1]=pL[k+1][1]; - m1=vL[k]; m2=vL[k+1]; - if((m1>=eps0)&&(m2>=eps0)){ - continue; - } - if((m1<=-eps0)&&(m2<=-eps0)){ - continue; - } - if(fabs(m1)<eps0){ - tmpd2[0]=p1[0]; tmpd2[1]=p1[1]; - } - else if(fabs(m2)<eps0){ - continue; - } - else{ - tmpd2[0]=1/(m1-m2)*(-m2*p1[0]+m1*p2[0]); - tmpd2[1]=1/(m1-m2)*(-m2*p1[1]+m1*p2[1]); - } - nqL++; - qL[nqL][0]=tmpd2[0]; qL[nqL][1]=tmpd2[1]; - } - if(nqL==2){ - puv1[0]=qL[1][0]; puv1[1]=qL[1][1]; - puv2[0]=qL[2][0]; puv2[1]=qL[2][1]; - surffun(ch,puv1[0],puv1[1],p1d3); - surffun(ch,puv2[0],puv2[1],p2d3); - if(dist(2,p1d3,p2d3)<eps0){ - continue; - } - tmp1d1=dist(3,p1d3,pta); - tmpd3[0]=p1d3[0]-pta[0]; - tmpd3[1]=p1d3[1]-pta[1]; - tmpd3[2]=p1d3[2]-pta[2]; - tmp2d1=dotprod(3,tmpd3,vec1); - tmp3d1=sqrt(fabs(pow(tmp1d1,2.0)-pow(tmp2d1,2.0))); - tmp4d1=dist(3,p2d3, pta); - tmpd3[0]=p2d3[0]-pta[0]; - tmpd3[1]=p2d3[1]-pta[1]; - tmpd3[2]=p2d3[2]-pta[2]; - tmp5d1=dotprod(3,tmpd3,vec1); - tmp6d1=sqrt(fabs(pow(tmp4d1,2.0)-pow(tmp5d1,2.0))); - if(tmp2d1<tmp5d1){ - tmpd3[0]=p1d3[0]; tmpd3[1]=p1d3[1]; tmpd3[2]=p1d3[2]; - p1d3[0]=p2d3[0]; p1d3[1]=p2d3[1]; p1d3[2]=p2d3[2]; - p2d3[0]=tmpd3[0]; p2d3[1]=tmpd3[1]; p2d3[2]=tmpd3[2]; - tmpd1=tmp2d1; tmp2d1=tmp5d1; tmp5d1=tmpd1; - tmpd1=tmp3d1; tmp3d1=tmp6d1; tmp6d1=tmpd1; - } - if((tmp3d1<eps[1]*epspt)&&(tmp6d1<eps[1]*epspt)){ - if(tmp2d1>-eps0){ - if(tmp5d1<-eps0){ - nsL++; - sL[nsL][0]=p1d3[0]; sL[nsL][1]=p1d3[1]; sL[nsL][2]=p1d3[2]; - sL[nsL][3]=p2d3[0]; sL[nsL][4]=p2d3[1]; sL[nsL][5]=p2d3[2]; - sL[nsL][6]=-1; - } - else{ - nsL++; - sL[nsL][0]=p1d3[0]; sL[nsL][1]=p1d3[1]; sL[nsL][2]=p1d3[2]; - sL[nsL][3]=p2d3[0]; sL[nsL][4]=p2d3[1]; sL[nsL][5]=p2d3[2]; - sL[nsL][6]=1; - } - } - } - v1=vec1[0]; v2=vec1[1]; v3=vec1[2]; - if(fabs(v1)>eps0){ - m1=pta[2]+v3/v1*(p1d3[0]-pta[0])-p1d3[2]; - m2=pta[2]+v3/v1*(p2d3[0]-pta[0])-p2d3[2]; - } - else if(fabs(v2)>eps0){ - m1=pta[2]+v3/v2*(p1d3[1]-pta[1])-p1d3[2]; - m2=pta[2]+v3/v2*(p2d3[1]-pta[1])-p2d3[2]; - } - else{ - m1=pta[1]-p1d3[1]; - m2=pta[1]-p2d3[1]; - } - if(m1*m2>=0){ - if(((m1>eps0)&&(m2>eps0))||((m1<-eps0)&&(m2<-eps0))){ - continue; - } - if(fabs(m1)<=eps0){ - ptd3[0]=p1d3[0]; ptd3[1]=p1d3[1]; ptd3[2]=p1d3[2]; - ptuv[0]=puv1[0]; ptuv[1]=puv1[1]; - } - else{ - ptd3[0]=p2d3[0]; ptd3[1]=p2d3[1]; ptd3[2]=p2d3[2]; - ptuv[0]=puv2[0]; ptuv[1]=puv2[1]; - } - } - else{ - ptd3[0]=1/(m1-m2)*(-m2*p1d3[0]+m1*p2d3[0]); - ptd3[1]=1/(m1-m2)*(-m2*p1d3[1]+m1*p2d3[1]); - ptd3[2]=1/(m1-m2)*(-m2*p1d3[2]+m1*p2d3[2]); - ptuv[0]=1/(m1-m2)*(-m2*puv1[0]+m1*puv2[1]); - } - tmpd3[0]=ptd3[0]-pta[0]; - tmpd3[1]=ptd3[1]-pta[1]; - tmpd3[2]=ptd3[2]-pta[2]; - tmp1d1=dotprod(3,tmpd3,vec1); - tmp2d1=fabs(tmp1d1); - tmpd3[0]=p1d3[0]-p2d3[0]; - tmpd3[1]=p1d3[1]-p2d3[1]; - tmpd3[2]=p1d3[2]-p2d3[2]; - tmp3d1=dotprod(3,tmpd3,vec1); - tmp4d1=dist(3,p1d3,p2d3); - tmp6d1=tmp3d1/tmp4d1; - if(tmp1d1>eps0){ - if(fabs(tmp6d1)>0.75){ - nptL++; - ptL[nptL][0]=ptd3[0]; ptL[nptL][1]=ptd3[1]; ptL[nptL][2]=ptd3[2]; - ptL[nptL][3]=p2d3[0]; ptL[nptL][4]=p2d3[1]; ptL[nptL][5]=p2d3[2]; - continue; - } - if(tmp2d1>epspt){ - return 1; - } - if(tmp2d1<2*epspt){ - continue; - } - } - } - } - } - if(nptL==0){ - return 0; - } - for(i=1; i<=nsL; i++){ - p2d3[0]=sL[i][3]; p2d3[1]=sL[i][4]; p2d3[2]=sL[i][5]; - flg=0; - for(j=1; j<=nsL; j++){ - p1d3[0]=sL[j][0]; p1d3[1]=sL[j][1]; p1d3[2]=sL[j][2]; - if(dist(3,p1d3,p2d3)<eps0){ - sL[i][6]=j; - flg=1; - break; - } - } - if((flg==0)&&(sL[i][6]>0)){ - sL[i][6]=-2; - } - } - for(i=1; i<=nptL; i++){ - p2d3[0]=ptL[i][3]; p2d3[1]=ptL[i][4]; p2d3[2]=ptL[i][5]; - flg=0; - for(j=1; j<=nsL; j++){ - p1d3[0]=sL[j][0]; p1d3[1]=sL[j][1]; p1d3[2]=sL[j][2]; - if(dist(3,p1d3,p2d3)<eps0){ - flg=1; - break; - } - } - if(flg==0){ - ptd3[0]=ptL[i][0]; ptd3[1]=ptL[i][1]; ptd3[2]=ptL[i][2]; - tmpd1=dist(3,p2d3,ptd3); - tmpd3[0]=p2d3[0]-ptd3[0]; - tmpd3[1]=p2d3[1]-ptd3[1]; - tmpd3[2]=p2d3[2]-ptd3[2]; - tmp1d1=fabs(dotprod(3,tmpd3,vec1)); - tmp2d1=sqrt(fabs(pow(tmpd1,2.0)-pow(tmp1d1,2.0))); - tmp3d1=tmp2d1*dist(3,ptd3,pta)/tmpd1; - if(tmp3d1>epspt/5){ - return 1; - } - else{ - continue; - } - } - nxt=sL[j][6]; - while(nxt>0){ - ptd3[0]=sL[nxt][3]; ptd3[1]=sL[nxt][4]; ptd3[2]=sL[nxt][5]; - nxt=sL[nxt][6]; - } - if(nxt==-2){ - return 1; - } - else{ - out=0; - } - } - return out; -} - -int nohiddenpara2(double paL[], double fk[][3], int uveq, double figkL[][3]){ - double eps0=pow(10,-5.0), s, p1[2], p2[2], q[2],tmpd1, tmpd2[2], epstmp[2]; - double fh[DsizeM][2], pta[3], ptap[2], vec[3]; - double figL[DsizeM][2], tmpmd2[DsizeM][2], tmpmd3[DsizeM][3]; - double tmp1d2[2], tmp2d2[2], tmp3d2[2], tmpd3[3],tmpd4[4]; - double pd2[2], qd2[2], pd3[3], qd3[3], sp, sq, tp, tq, dtmp, dtmp1, dtmp2; - int ncusp=floor(Cusppt[0][0]+0.5), seL[DsizeM], npaL=floor(paL[0]+0.5); - int i, n, nfh, nfk, nfigL, nfigkL, nhidden, cspflg, nseL=0, ntmp, flg, tmpi1[DsizeM]; - nfk=length3(fk); - nfh=projpara(fk, fh); - pull2(1,fh,p1); - pull2(nfh,fh,p2); - cspflg=1; - for(i=1; i<=ncusp; i++){ - pull2(i, Cusppt, tmpd2); - if(dist(2,tmpd2,p1)<eps0){ - if(cspflg==1){ - cspflg=2; - } - else if(cspflg==3){ - cspflg=6; - } - continue; - } - if(dist(2,tmpd2,p2)<eps0){ - if(cspflg==1){ - cspflg=3; - } - else if(cspflg==2){ - cspflg=6; - } - continue; - } - } - seL[0]=0; nseL=0; - for(n=1; n<=npaL-1; n++){ - s=(paL[n]+paL[n+1])/2.0; - ntmp=invparapt(s,fh,fk, pta); - parapt(pta,ptap); - epstmp[0]=Eps1; epstmp[1]=1; - if((n==1)&&(cspflg % 2==0)){ - pull2(1,fh,p1); - dtmp=fmin(Eps1*dist(2,ptap, p1),Eps1); - epstmp[0]=dtmp; epstmp[1]=1; - } - if((n==npaL-1)&&(cspflg % 3==0)){ - pull2(nfh,fh,p1); - dtmp=fmin(Eps1*dist(2, ptap, p1), Eps1); - epstmp[0]=dtmp; epstmp[1]=1; - } - flg=pthiddenQ(Ch,pta, uveq, epstmp); - if(flg==0){ - nseL=appendi1(seL,n); - } - } - figL[0][0]=0; nfigL=0; - figkL[0][0]=0; nfigkL=0; - for(i=1; i<=nseL; i++){ - pointoncurve(paL[seL[i]], fh, Eps, tmp1d2); - pointoncurve(paL[seL[i]+1], fh, Eps, tmp2d2); - if(i==1){ - copyd(0,1,tmp1d2,pd2); - sp=paL[seL[i]]; - copyd(0,1,tmp2d2,qd2); - sq=paL[seL[i]+1]; - } - else{ - if(memberi(seL[i]-1,seL)==1){ - copyd(0,1,tmp2d2,qd2); - sq=paL[seL[i]+1]; - } - else{ - ntmp=partcrv(sp,sq,fh,tmpmd2); - nfigL=appendd2(2,1,ntmp,tmpmd2,figL); - tp=invparapt(sp,fh,fk, tmpd3); - tq=invparapt(sq,fh,fk,tmpd3); - ntmp=partcrv3(tp,tq,fk,tmpmd3); - nfigkL=appendd3(2,1,ntmp,tmpmd3,figkL); - copyd(0,1,tmp1d2,pd2); - sp=paL[seL[i]]; - copyd(0,1,tmp2d2,qd2); - sq=paL[seL[i]+1]; - } - } - } - if(nseL>0){ - if(dist(2,pd2,qd2)>Eps1){ - nearestptpt(pd2,fh,tmpd4); - dtmp1=tmpd4[2]; - nearestptpt(qd2,fh,tmpd4); - dtmp2=tmpd4[2]; - ntmp=partcrv(dtmp1,dtmp2,fh,tmpmd2); - nfigL=appendd2(2,1,ntmp,tmpmd2,figL); - tp=invparapt(sp,fh,fk,tmpd3); - tq=invparapt(sq,fh,fk,tmpd3); - ntmp=partcrv3(tp,tq,fk,tmpmd3); - nfigkL=appendd3(2,1,ntmp, tmpmd3, figkL); - } - else{ - nfigL=appendd2(2,1,nfh, fh, figL); - nfigkL=appendd3(2,1,nfk,fk,figkL); - } - } - tmpi1[0]=0; ntmp=0; - for(i=1; i<=npaL-1; i++){ - if(memberi(i,seL)==0){ - ntmp=appendi1(tmpi1,i); - } - } - copyi(0,ntmp,tmpi1,seL); - seL[0]=ntmp; nseL=ntmp; - Hiddendata[0][0]=0; nhidden=0; - for(i=1; i<=nseL; i++){ - dtmp=paL[seL[i]]; - pointoncurve(dtmp,fh,Eps,tmp1d2); - dtmp=paL[seL[i]+1]; - pointoncurve(dtmp,fh,Eps, tmp2d2); - if(i==1){ - copyd(0,1,tmp1d2,pd2); - sp=paL[seL[i]]; - copyd(0,1,tmp2d2,qd2); - sq=paL[seL[i]+1]; - } - else{ - if(memberi(seL[i]-1,seL)==1){ - copyd(0,1,tmp2d2,qd2); - sq=paL[seL[i]+1]; - } - else{ - tp=invparapt(sp,fh,fk,tmpd3); - tq=invparapt(sq,fh,fk,tmpd3); - ntmp=partcrv3(tp,tq,fk,tmpmd3); - nhidden=appendd3(2,1,ntmp,tmpmd3,Hiddendata); - copyd(0,1,tmp1d2,pd2); - sp=paL[seL[i]]; - copyd(0,1,tmp2d2,qd2); - sq=paL[seL[i]+1]; - } - } - } - if(nseL>0){ - if(dist(2,pd2,qd2)>Eps1){ - tp=invparapt(sp,fh,fk,tmpd3); - tq=invparapt(sq,fh,fk,tmpd3); - ntmp=partcrv3(tp,tq,fk,tmpmd3); - nhidden=appendd3(2,1,ntmp,tmpmd3,Hiddendata); - } - else{ - nhidden=appendd3(2,1,nfk,fk,Hiddendata); - } - } - return nfigkL; -} - -int borderparadata(short ch,double fkL[][3], double fsL[][3]){ - double ekL[DsizeL][3], fall[DsizeL][2], fbdxy[DsizeL][2]; - double tmpd3[DsizeM][3], tmpd2[DsizeM][2], p[2], p3[3]; - double figkL[DsizeM][3], du, dv; - int i, j, nall, nekL, nfsL, nfkL=length3(fkL), nfall, nfbdxy; - int ndin, din[DsizeS][2], ndin2,din2[DsizeM][2]; - int ntmp, ntmpd3,ntmpd2, npar=0, nfigkL; - double par[DsizeM]; - du=(Urng[1]-Urng[0])/Mdv; - dv=(Vrng[1]-Vrng[0])/Ndv; - fsL[0][0]=0; - ekL[0][0]=0; nekL=0; - if(DrawE==1){ - tmpd2[0][0]=0; nall=0; - for(j=0; j<=Ndv; j++){ - nall=add2(tmpd2, Urng[1], Vrng[0]+j*dv); - } - nall=surfcurve(ch,2, tmpd2,tmpd3); - nekL=appendd3(2,1,nall,tmpd3,ekL); - } - if(DrawN==1){ - tmpd2[0][0]=0; nall=0; - for(j=0; j<=Mdv; j++){ - nall=add2(tmpd2, Urng[0]+j*du, Vrng[1]); - } - nall=surfcurve(ch,2, tmpd2,tmpd3); - nekL=appendd3(2,1,nall,tmpd3,ekL); - } - if(DrawW==1){ - tmpd2[0][0]=0; nall=0; - for(j=0; j<=Ndv; j++){ - nall=add2(tmpd2, Urng[0], Vrng[0]+j*dv); - } - nall=surfcurve(ch,2, tmpd2,tmpd3); - nekL=appendd3(2,1,nall,tmpd3,ekL); - } - if(DrawS==1){ - tmpd2[0][0]=0; nall=0; - for(j=0; j<=Mdv; j++){ - nall=add2(tmpd2, Urng[0]+j*du, Vrng[0]); - } - nall=surfcurve(ch,2, tmpd2,tmpd3); - nekL=appendd3(2,1,nall,tmpd3,ekL); - } - if(nekL>0){ - nfkL=appendd3(2,1,nekL,ekL,fkL); - } - nfall=projpara(fkL,fall); - nfbdxy=makexybdy(ch,fbdxy); - ndin=dataindexd2(2,fall,din); - Borderpt[0][0]=0; - Otherpartition[0]=0; - for(i=1; i<=ndin-1; i++){ - Otherpartition[i]=Inf; Otherpartition[0]++; - } - Borderhiddendata[0][0]=0; - ndin2=dataindexd3(2,fkL,din2); - for(i=1; i<= ndin2; i++){ - tmpd3[0][0]=0; - ntmpd3=appendd3(0,din2[i][0],din2[i][1],fkL,tmpd3); - ntmpd2=projpara(tmpd3,tmpd2); - partitionseg(tmpd2,fall, 1,par); - if(length1(par)>2){ - ntmp=npar-1; - tmpd2[0][0]=0; ntmpd2=0; - for(j=2; j<=ntmp; j++){ - pull2(j,Partitionpt,p); - ntmpd2=addptd2(tmpd2, p); - } - ntmp=appendd2(0, 1,ntmpd2,tmpd2,Borderpt); - } - tmpd3[0][0]=0; - for(j=din2[i][0]; j<=din2[i][1]; j++){ - pull3(j,fkL,p3); - ntmpd3=addptd3(tmpd3,p3); - } - nfigkL=nohiddenpara2(par,tmpd3,1, figkL); - if(nfigkL>0){ - nfsL=appendd3(2,1,nfigkL,figkL, fsL); - } - ntmp=length3(Hiddendata); - if(ntmp>0){ - appendd3(2,1,ntmp,Hiddendata,Borderhiddendata); - } - } - return nfsL; -} - -int dropnumlistcrv3(double qd[][3], double eps1, int out[]){ - int i,j,k,nout,nall=length3(qd), nd, se, en, npd, nptL; - int din[DsizeM][2],ptL[DsizeL]; - double eps=pow(10.0,-6.0), pd[DsizeL][3], p[3], tmp2d[3]; - out[0]=0; nout=0; - nd=dataindexd3(2,qd,din); - for(j=1; j<=nd; j++){ - se=din[j][0]; en=din[j][1]; - pd[0][0]=0; npd=0; - npd=appendd3(0,se,en,qd,pd); - ptL[0]=0; nptL=0; - nptL=appendi1(ptL,1); - pull3(1,pd,p); - for(k=2; k<=npd-1; k++){ - pull3(k,pd,tmp2d); - if(dist(3,p,tmp2d)>eps1){ - nptL=appendi1(ptL,k); - pull3(k,pd,p); - } - } - pull3(npd-1,pd,p); - pull3(npd,pd,tmp2d); - if(dist(3,p,tmp2d)>eps){ // eps -> eps1 ? - nptL=appendi1(ptL,npd); - } -// if(nptL==1){ptL[0]=0; nptL=0;}//180318db - if(nout>0){ - nout=appendi1(out,Infint); - } - for(i=1; i<=nptL; i++){ - nout=appendi1(out,ptL[i]); - } - } - out[0]=nout; - return nout; -} - -int sfbdparadata(short ch,double outd3[][3]){ - double pdatad3[DsizeL][3]; - double pts[DsizeL][2],out3md[DsizeL][2],eps; - double tmpmd[DsizeL][2],tmp1md[DsizeL][2],tmp2md[DsizeL][2],tmp3md[DsizeL][2]; - double tmpd[2],tmp1d[2],tmpd3[3],tmp1d3[3],tmp2d3[3],tmp2md3[DsizeL][3]; - int din[DsizeS][2],nlist[DsizeL]; - int ii,jj,kk,n,nall,flg; - envelopedata(ch, tmp3md); - out3md[0][0]=0; - pts[0][0]=0; - dataindexd2(2,tmp3md,din); - for(jj=1;jj<=length2i(din);jj++){ - tmp1md[0][0]=0; - tmp2md3[0][0]=0; - for(kk=din[jj][0];kk<=din[jj][1];kk++){ - pull2(kk,tmp3md,tmpd); - addptd2(tmp1md,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmpd3); - addptd3(tmp2md3,tmpd3); - } - dropnumlistcrv3(tmp2md3,Eps1,nlist); - if(nlist[0]==1){ - pull2(nlist[1],tmp1md,tmpd); - addptd2(pts,tmpd); - }else{ - tmpmd[0][0]=0; - for(kk=1;kk<=nlist[0];kk++){ - pull2(nlist[kk],tmp1md,tmpd); - addptd2(tmpmd,tmpd); - } - if(length2(tmpmd)>0){ - appendd2(2,1,length2(tmpmd),tmpmd,out3md); - } - } - } - tmp3md[0][0]=0; - appendd2(2,1,length2(pts),pts,tmp3md); - pts[0][0]=0; - for(ii=1;ii<=length2(tmp3md);ii++){ - pull2(ii,tmp3md,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmp1d3); - flg=0; - for(jj=1;jj<=length2(pts);jj++){ - pull2(jj,pts,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmp2d3); - if(dist(3,tmp1d3,tmp2d3)<Eps1){ - flg=1; break; - } - } - if(flg==0){ - pull2(ii,tmp3md,tmpd); - addptd2(pts,tmpd); - } - } - for(ii=1;ii<=length2(pts);ii++){ - tmp3md[0][0]=0; - appendd2(2,1,length2(out3md),out3md,tmp3md); - out3md[0][0]=0; - pull2(ii,pts,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmp1d3); - dataindexd2(2,tmp3md,din); - for(jj=1;jj<=length2i(din);jj++){ - tmp2md[0][0]=0; - appendd2(2,din[jj][0],din[jj][1],tmp3md,tmp2md); - pull2(jj,tmp3md,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmp2d3); - eps=1; - for(kk=1;kk<=length2(tmp2md)-1;kk++){ - pull2(kk,tmp2md,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmp1d3); - pull2(kk+1,tmp2md,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmpd3); - if(eps>dist(3,tmp1d3,tmpd3)){ - eps=dist(3,tmp1d3,tmpd3); - } - } - pull2(1,tmp2md,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmpd3); - if(dist(3,tmp1d3,tmpd3)<eps+Eps){ - appendd2(2,ii,ii,pts,out3md); - for(kk=1;kk<=length2(tmp2md);kk++){ - pull2(kk,tmp2md,tmpd); - addptd2(out3md,tmpd); - } - continue; - } - pull2(length2(tmp2md),tmp2md,tmpd); - surffun(ch,tmpd[0],tmpd[1],tmpd3); - if(dist(3,tmp1d3,tmpd3)<eps+Eps){ - appendd2(2,1,length2(tmp2md),tmp2md,out3md); - pull2(ii,pts,tmpd); - addptd2(out3md,tmpd); - continue; - } - } - appendd2(2,1,length2(tmp2md),tmp2md,out3md); - } - nall=cuspsplitpara(ch,out3md, pdatad3); - n=length2(Cuspsplitpt); - Cusppt[0][0]=0; - nall=appendd2(0, 1,n,Cuspsplitpt,Cusppt); - nall= borderparadata(ch,pdatad3, outd3); - push3(Inf,3,0,outd3); - nall=appendd3(0,1,length3(Borderhiddendata),Borderhiddendata,outd3); - push3(Inf,3,0,outd3); - return nall; -} - -void makevaltablemeet(short ch,double pa[3], double vec[3], double eps0){ - double u, v, du, dv, pt[3]; - int i, j; - du=(Urng[1]-Urng[0])/Mdv; - dv=(Vrng[1]-Vrng[0])/Ndv; - for(j=0; j<=Ndv; j++){ - v=Vrng[0]+j*dv; - for(i=0; i<=Mdv; i++){ - u=Urng[0]+i*du; - surffun(ch,u, v, pt); - if((fabs(vec[1])>eps0)||(fabs(vec[0])>eps0)){ - Zval[j][i]=(vec[1]*(pt[0]-pa[0])-vec[0]*(pt[1]-pa[1])); - } - else{ - Zval[j][i]=pt[0]-pa[0]; - } - } - } - for(i=0; i<=Mdv; i++){ - Xval[i]=Urng[0]+i*du; - } - for(j=0; j<=Ndv; j++){ - Yval[j]=Vrng[0]+j*dv; - } -} - -int meetpoints(short ch,double pta[3], double ptb[3], double eps, double ptL[][3]){ - double eps0=pow(10,-4.0), vec[3], out[DsizeM], pL[5][2], vL[5]; - double qL[DsizeM][2], p1d2[2], p2d2[2], tmpd2[2], puv1d2[2], puv2d2[2]; - double m1,m2, p1d3[3], p2d3[3], v1, v2, v3, ptd3[3], ptuvd2[2], tmp1d1; - double po[3]={0,0,0}, tmpmd1[DsizeM], tmp1d3[3]; - int nout, nptL, ntmp, nqL, i, j, k; - vec[0]=ptb[0]-pta[0]; vec[1]=ptb[1]-pta[1]; vec[2]=ptb[2]-pta[2]; - out[0]=0; nout=0; - ptL[0][0]=0; nptL=0; - makevaltablemeet(Ch,pta,vec,eps0); - for(j=0; j<=Ndv-2; j++){ - for(i=0; i<=Mdv-2; i++){ - pL[0][0]=Xval[i]; pL[0][1]=Yval[j]; vL[0]=Zval[j][i]; - pL[1][0]=Xval[i+1]; pL[1][1]=Yval[j]; vL[1]=Zval[j][i+1]; - pL[2][0]=Xval[i+1]; pL[2][1]=Yval[j+1]; vL[2]=Zval[j+1][i+1]; - pL[3][0]=Xval[i]; pL[3][1]=Yval[j+1]; vL[3]=Zval[j+1][i]; - pL[4][0]=Xval[i]; pL[4][1]=Yval[j]; vL[4]=Zval[j][i]; - qL[0][0]=0; nqL=0; - for(k=0; k<=3; k++){ - pull2(k,pL,p1d2); - pull2(k+1,pL,p2d2); - m1=vL[k]; m2=vL[k+1]; - if((m1>=eps0)&&(m2>=eps0)){ - continue; - } - if((m1<=-eps0)&&(m2<=-eps0)){ - continue; - } - if(fabs(m1)<eps0){ - copyd(0,1,p1d2,tmpd2); - } - else if(fabs(m2)<eps0){ - continue; - } - else{ - tmpd2[0]=1/(m1-m2)*(-m2*p1d2[0]+m1*p2d2[0]); - tmpd2[1]=1/(m1-m2)*(-m2*p1d2[1]+m1*p2d2[1]); - } - nqL=addptd2(qL,tmpd2); - } - if(nqL==2){ - pull2(1, qL, puv1d2); - pull2(2, qL, puv2d2); - surffun(ch,puv1d2[0], puv1d2[1], p1d3); - surffun(ch,puv2d2[0], puv2d2[1], p2d3); - v1=vec[0]; v2=vec[1]; v3=vec[2]; - if(fabs(v1)>eps0){ - m1=pta[2]+v3/v1*(p1d3[0]-pta[0])-p1d3[2]; - m2=pta[2]+v3/v1*(p2d3[0]-pta[0])-p2d3[2]; - } - else if(fabs(v2)>eps0){ - m1=pta[2]+v3/v2*(p1d3[1]-pta[1])-p1d3[2]; - m2=pta[2]+v3/v2*(p2d3[1]-pta[1])-p2d3[2]; - } - else{ - m1=pta[1]-p1d3[1]; - m2=pta[1]-p2d3[1]; - } - if(m1*m2>=-eps0){ - if(((m1>eps0)&&(m2>eps0)) || ((m1<-eps0)&&(m2<-eps0))){ - continue; - } - if(fabs(m1)<=eps0){ - copyd(0,2,p1d3,ptd3); - copyd(0,1,puv1d2,ptuvd2); - } - else{ - copyd(0,2,p2d3,ptd3); - copyd(0,1,puv2d2,ptuvd2); - } - } - else{ - ptd3[0]=1/(m1-m2)*(-m2*p1d3[0]+m1*p2d3[0]); - ptd3[1]=1/(m1-m2)*(-m2*p1d3[1]+m1*p2d3[1]); - ptd3[2]=1/(m1-m2)*(-m2*p1d3[2]+m1*p2d3[2]); - } - tmp1d3[0]=ptd3[0]-pta[0]; tmp1d3[1]=ptd3[1]-pta[1]; - tmp1d3[2]=ptd3[2]-pta[2]; - tmp1d1=dotprod(3,tmp1d3,vec); - tmp1d1=tmp1d1/pow(dist(3,vec,po),2.0); - if((tmp1d1>-eps0)&&(tmp1d1<1+eps0)){ - nout=appendd1(out,tmp1d1); - } - } - } - } - if(nout>>0){ - simplesort(out); - tmpmd1[1]=out[1]; ntmp=1; - for(i=2; i<=nout; i++){ - tmp1d3[0]=(out[i]-tmpmd1[ntmp])*vec[0]; - tmp1d3[1]=(out[i]-tmpmd1[ntmp])*vec[1]; - tmp1d3[2]=(out[i]-tmpmd1[ntmp])*vec[2]; - tmp1d1=dist(3,tmp1d3,po); - if(tmp1d1>eps){ - ntmp=appendd1(tmpmd1,out[i]); - } - } - nout=ntmp; - copyd(0,ntmp,tmpmd1,out); - for(i=1; i<=nout; i++){ - tmp1d3[0]=pta[0]+out[i]*vec[0]; - tmp1d3[1]=pta[1]+out[i]*vec[1]; - tmp1d3[2]=pta[2]+out[i]*vec[2]; - nptL=addptd3(ptL,tmp1d3); - } - } - return nptL; -} - -int crvsfparadata(double fkL[][3], double fbdkL[][3], int sepflg, double out[][3]){ - double fbdy[DsizeL][2], fk[DsizeM][3],fkp[DsizeM][3], outh[DsizeL][3]; - double fh[DsizeM][2], parL[DsizeM], tmpmd3[DsizeM][3]; - double ptL[DsizeM][3], tmpd2[2], tmpd3[3], tmp1d1, tmp2d1, dt; - double po[2]={0,0}, epsd2[2]={Eps1,1}, pa[3], pb[3]; - int nbor=length3(Borderhiddendata), nfkL,nfbdkL, nfbdy, nfk, nall; - int ncshidden, npar, ndin, din[DsizeM][2], ndin2,din2[DsizeS][2]; - int nn, i, j, k, n, nptL, nout; - nfkL=length3(fkL); - nfbdy=projpara(fbdkL,fbdy); - out[0][0]=0; - outh[0][0]=0; - ndin=dataindexd3(2,fkL,din); - for(nn=1; nn<=ndin; nn++){ - fkp[0][0]=0; - nfk=appendd3(0,din[nn][0],din[nn][1],fkL,fkp); - n=fmax(1,floor((fmax(Mdv,Ndv)+1)/(nfk-1)+0.5)); //17.06.16 - dt=1.0/n; - fk[0][0]=0; - for(i=1; i<nfk; i++){ - for(j=0; j<n; j++){ - tmpd3[0]=fkp[i][0]+(fkp[i+1][0]-fkp[i][0])*j*dt; - tmpd3[1]=fkp[i][1]+(fkp[i+1][1]-fkp[i][1])*j*dt; - tmpd3[2]=fkp[i][2]+(fkp[i+1][2]-fkp[i][2])*j*dt; - addptd3(fk,tmpd3); - } - } - nfk=appendd3(0,nfk,nfk,fkp,fk); - nall=projpara(fk,fh); - partitionseg(fh, fbdy,1, parL); - if(sepflg>=0){ - for(i=1; i<=nfk-1; i++){ - pull3(i,fk,pa); - pull3(i+1,fk,pb); - nptL=meetpoints(Ch,pa,pb, Eps2,ptL); - for(j=1; j<=nptL; j++){ - pull3(j,ptL,tmpd3); - parapt(tmpd3,tmpd2); - tmp1d1=paramoncurve(tmpd2,i,fh); - tmp2d1=Inf; - for(k=1; k<=npar; k++){ - tmp2d1=fmin(tmp2d1,fabs(parL[k]-tmp1d1)); - } - tmpd3[0]=pb[0]-pa[0]; tmpd3[1]=pb[1]-pa[1]; - tmpd3[2]=pb[2]-pa[2]; - if(tmp2d1*dist(3,tmpd3,po)>Eps1){ - npar=appendd1(parL,tmp1d1); - } - } - simplesort(parL); - } - } - nohiddenpara2(parL,fk,1, tmpmd3); - appendd3(2,1,length3(tmpmd3),tmpmd3,out); - appendd3(2,1, length3(Hiddendata),Hiddendata,outh); - } - push3(Inf,3,0,out); //17.06.17 - nout=appendd3(0,1,length3(outh),outh,out); - push3(Inf,3,0,out); //17.06.17 - return nout; -} - -int wireparadata(double bdyk[][3], double udv[], double vdv[], int num, - double fsL[][3]){ - double fbdy[DsizeL][2], udiv[DsizeM], vdiv[DsizeM], fbdxy[DsizeM][2]; - double fs[DsizeL][3], u, v, d, pdata[DsizeM][3], fkL[DsizeM][3]; - double fsLh[DsizeLL][3]; - double tmpmd2[DsizeM][2], fk[DsizeM][3], par[DsizeM], p[2]; - int nfbdy, nd, i, j, k, n, nu, nv, nfbdxy, nfsL, npdata, nfkL, nfk, npar,ntmp; - int nwire, ndin, din[DsizeM][2], nfs, ndin2, din2[DsizeM][2]; - nfbdy=projpara(bdyk, fbdy); - Wirept[0][0]=0; - udiv[0]=0; nu=0; - vdiv[0]=0; nv=0; - n=floor(udv[0]+0.5); - if(n==-1){ - nd=floor(udv[1]+0.5); - d=(Urng[1]-Urng[0])/(nd+1); - for(i=1; i<=nd; i++){ - u=Urng[0]+i*d; - nu=appendd1(udiv,u); - } - } - else{ - for(i=1; i<=n; i++){ - nu=appendd1(udiv,udv[i]); - } - } - n=floor(vdv[0]+0.5); - if(n==-1){ - nd=floor(vdv[1]+0.5); - d=(Vrng[1]-Vrng[0])/(nd+1); - for(i=1; i<=nd; i++){ - v=Vrng[0]+i*d; - nv=appendd1(vdiv,v); - } - } - else{ - for(i=1; i<=n; i++){ - nv=appendd1(vdiv,vdv[i]); - } - } - nfbdxy=makexybdy(Ch,fbdxy); - Wirept[0][0]=0; - fsL[0][0]=0; nfsL=0; - fsLh[0][0]=0; - for(i=1; i<=nu; i++){ - u=udiv[i]; - d=(Vrng[1]-Vrng[0])/(num*Ndv); - tmpmd2[0][0]=0; ntmp=0; - for(j=1;j<=(num*Ndv)+1; j++){ - v=Vrng[0]+(j-1)*d; - p[0]=u; p[1]=v; - ntmp=addptd2(tmpmd2,p); - } - nfkL=cuspsplitpara(Ch,tmpmd2, fkL); - ndin=dataindexd3(2,fkL,din); - for(j=1; j<=ndin; j++){ - fk[0][0]=0; - nfk=appendd3(0, din[j][0], din[j][1], fkL,fk); - ntmp=projpara(fk,tmpmd2); - partitionseg(tmpmd2, fbdy, 1, par); - ntmp=length2(Partitionpt); - if(ntmp>2){ - for(k=2; k<=ntmp; k++){ - pull2(k, Partitionpt, p); - nwire=addptd3(Wirept,p); - } - } - nfs=nohiddenpara2(par,fk,1, fs); - n=length3(Hiddendata); - ntmp=appendd3(2,1,n, Hiddendata,fsLh); - nfsL=appendd3(2,1,nfs,fs,fsL); - } - } - for(i=1; i<= nv; i++){ - v=vdiv[i]; - d=(Urng[1]-Urng[0])/(num*Mdv); - tmpmd2[0][0]=0; ntmp=0; - for(j=1;j<=(num*Mdv)+1; j++){ - u=Urng[0]+(j-1)*d; - p[0]=u; p[1]=v; - ntmp=addptd2(tmpmd2,p); - } - nfkL=cuspsplitpara(Ch,tmpmd2, fkL); - ndin=dataindexd3(2,fkL,din); - for(j=1; j<=ndin; j++){ - fk[0][0]=0; - nfk=appendd3(0, din[j][0], din[j][1], fkL,fk); - ntmp=projpara(fk,tmpmd2); - partitionseg(tmpmd2, fbdy, 1, par); - ntmp=length2(Partitionpt); - if(ntmp>2){ - for(k=2; k<=ntmp; k++){ - pull2(k, Partitionpt, p); - nwire=addptd3(Wirept,p); - } - } - nohiddenpara2(par,fk,1, fs); - appendd3(2,1,length3(Hiddendata), Hiddendata,fsLh); - appendd3(2,1,length3(fs),fs,fsL); - } - } - push3(Inf,3,0,fsL); - nfsL=appendd3(0,1,length3(fsLh),fsLh,fsL); - push3(Inf,3,0,fsL); - return nfsL; -} - -/* -double cutfun(int ch, double u, double v){ - double p[3],val ; - surffun(ch,u,v,p); - val=p[0]+p[1]-0.5; - return val; -} -*/ - -void makevaltablecut(int chcut){ - double eps0=pow(10,-6.0), u, v, du, dv; - int i, j, nx=0, ny=0; ; - du=(Urng[1]-Urng[0])/Mdv; - dv=(Vrng[1]-Vrng[0])/Ndv; - for(j=0; j<=Ndv; j++){ - v=Vrng[0]+j*dv; - for(i=0; i<=Mdv; i++){ - u=Urng[0]+i*du; - Zval[j][i]=cutfun(Ch,chcut, u,v); - } - } - for(i=0; i<=Mdv; i++){ - Xval[i]=Urng[0]+i*du; - } - for(j=0; j<=Ndv; j++){ - Yval[j]=Vrng[0]+j*dv; - } -} - -int sfcutdata(int ch, double ekL[][3]){ - double cutuvL[DsizeL][2], out1[DsizeM][2], out2[DsizeM][3], pt[3]; - int i, j, nall, ndin, din[DsizeM][2], nekL,nout1,nout2; -// makevaltablecut(ch); //180320 -// nall=implicitplot(cutuvL); //180320 - ekL[0][0]=0; nekL=0; - ndin=dataindexd2(2,cutuvL,din); - for(i=1; i<=ndin; i++){ - out1[0][0]=0; - nout1=appendd2(2,din[i][0],din[i][1],cutuvL,out1); - out2[0][0]=0; - for(j=1; j<=nout1; j++){ - surffun(ch,out1[j][0], out1[j][1], pt); - nout2=addptd3(out2,pt); - } - nekL=appendd3(2,1,nout2,out2,ekL); - } - return nekL; -} - -int crv3onsfparadata(double fk[][3], double fbdyd3[][3], double out[][3]){ - double fbdy[DsizeL][2], fh[DsizeL][2], tmpmd2[DsizeL][2], par[DsizeM]; - int n, nall, nfbdy, nfbdxy, npar, nout; - out[0][0]=0; - nfbdy=projpara(fbdyd3,fbdy); -// nall=ospline3(2,fk,2,fk1); - projpara(fk,fh); - partitionseg(fh,fbdy, 1, par); - nohiddenpara2(par,fk, 1,out); - push3(Inf,3,0,out); - nall=appendd3(0,1,length3(Hiddendata),Hiddendata,out); - push3(Inf,3,0,out); //17.06.16 - return nall; -} - -int projcoordcurve(double curve[][3], double out[][3]){ - double SP=sin(PHI), CP=cos(PHI), ST=sin(THETA), CT=cos(THETA); - double pt[3], xz, yz, zz; - int i, n, nall; - out[0][0]=0; - n=length3(curve); - for(i=1; i<=n; i++){ - pull3(i, curve, pt); - if(pt[0]>Inf-1){ - xz=pt[0]; yz=pt[1]; zz=pt[2]; - } - else{ - xz=-pt[0]*SP+pt[1]*CP; - yz=-pt[0]*CP*CT-pt[1]*SP*CT+pt[2]*ST; - zz=pt[0]*CP*ST+pt[1]*SP*ST+pt[2]*CT; - } - nall=push3(xz,yz,zz,out); - } - return nall; -} - -int kukannozoku(double jokyo[2], double kukanL[][2], double res[][2]){ - double t1, t2, tmpd2[2], ku[2]; - int i, j, ii, nn, flg, nres; - nn=length2(kukanL); - t1=jokyo[0]; - t2=jokyo[1]; - pull2(1,kukanL,tmpd2); - t1=fmax(t1,tmpd2[0]); - pull2(nn,kukanL,tmpd2); - t2=fmin(t2,tmpd2[1]); - res[0][0]=0; nres=0; - flg=0; - for(ii=1; ii<=nn; ii++){ - pull2(ii,kukanL,ku); - if(flg==0){ - if(ku[1]<t1){ - nres=addptd2(res,ku); - } - else{ - flg=1; - if(ku[0]<t1-Eps){ - tmpd2[0]=ku[0]; tmpd2[1]=t1; - nres=addptd2(res,tmpd2); - } - if(ku[1]>t2+Eps){ - tmpd2[0]=t2; tmpd2[1]=ku[1]; - nres=addptd2(res,tmpd2); - } - } - } - else if(flg==1){ - if(ku[1]<t2){ - continue; - } - else{ - flg=2; - if(ku[0]<t2-Eps){ - ku[0]=t2; - } - nres=addptd2(res,ku); - } - } - else{ - nres=addptd2(res,ku); - } - } - return nres; -} - -int skeletondata3(double data[][3], double r00, - double eps1, double eps2, double allres[][3]){ - double objL[DsizeLL][3], pltL[DsizeLL][3]; - double clipL[DsizeL][5],koc2d6[DsizeM][6],tmpd6[6]; - double pts1[DsizeL][2],koc[DsizeM][4], koc2[DsizeM][4], kukanL[DsizeL][2]; - double r0, t1, t2, z1, z2, tt, rr, origin[2], te, hh, ku[2], za, zb, ds[DsizeM],dmin; - double pt[2], pta[2], ptb[2], ptq[2]; - double ptL[DsizeL][3], ptL2[DsizeL][2], res2[DsizeL][2], allres2[DsizeL][2]; - double obj[DsizeL][3], plt[DsizeL][3]; - double objp[DsizeL][3], pltp[DsizeL][3]; - double obj2d[DsizeL][2], plt2d[DsizeL][2]; - double tmpd1, tmp2d1, tmp3d1, tmp1d2[2], tmp2d2[2],tmpd3[3]; - double tmpmd2[DsizeL][2], tmpmd3[DsizeL][3], tmpd4[4], tmp1d4[4]; - int j, ii, jj, nobj, nplt, nall, din1[DsizeM][2], din2[DsizeM][2]; - int nkoc, nkoc2, nn,nn1,nn2, nclipL, flg, ntmp; - char str1[100], str2[100]; - objL[0][0]=0; pltL[0][0]=0; - dataindexd3(3,data,din1); - appendd3(0, din1[1][0],din1[1][1],data,objL); - appendd3(0, din1[2][0],din1[2][1],data,pltL); - allres[0][0]=0; - allres2[0][0]=0; - dataindexd3(2,objL,din1); - dataindexd3(2,pltL,din2); - for(nobj=1; nobj<=length2i(din1); nobj++){ - tmpmd3[0][0]=0; - ntmp=appendd3(2,din1[nobj][0],din1[nobj][1],objL,tmpmd3); - nn=ceil((fmax(Mdv,Ndv)*2-1)/(ntmp-1)); - increasept3(tmpmd3,nn,obj); - appendd3(0,ntmp,ntmp,tmpmd3,obj); - projcoordcurve(obj,objp); - obj2d[0][0]=0; - for(j=1; j<=length3(objp); j++){ - push2(objp[j][0],objp[j][1],obj2d); - } - clipL[0][0]=0; nclipL=0; - for(nplt=1; nplt<=length2i(din2); nplt++){ - tmpmd3[0][0]=0; - ntmp=appendd3(2,din2[nplt][0],din2[nplt][1],pltL,tmpmd3); - nn=ceil((fmax(Mdv,Ndv)*2-1)/(ntmp-1)); - increasept3(tmpmd3,nn,plt); - appendd3(0,ntmp,ntmp,tmpmd3,plt); - projcoordcurve(plt,pltp); - plt2d[0][0]=0; - for(j=1; j<=length3(pltp); j++){ - push2(pltp[j][0],pltp[j][1],plt2d); - } - intersectcurvesPp(obj2d,plt2d,20,koc2d6); //180324from - nkoc2=length6(koc2d6); - koc2[0][0]=0; - for(ii=1;ii<=nkoc2;ii++){ - pull6(ii,koc2d6,tmpd6); - push4(tmpd6[0],tmpd6[1],tmpd6[2],tmpd6[3],koc2); - }//180324to - if(nkoc2>0){ - koc[0][0]=0; nkoc=0; - pull2(1,plt2d,pta); - pull2(length2(plt2d),plt2d,ptb); - for(j=1; j<=nkoc2; j++){ - pt[0]=koc2[j][0]; pt[1]=koc2[j][1]; - nearestptpt(pt, plt2d, tmpd4); - koc2[j][3]=tmpd4[2]; - pt[0]=tmpd4[0]; pt[1]=tmpd4[1]; - nearestptpt(pt, obj2d, tmpd4); - koc2[j][0]=tmpd4[0]; koc2[j][1]=tmpd4[1]; - koc2[j][2]=tmpd4[2]; - ds[j]=tmpd4[3]; - } - pull4(1,koc2,tmp1d4); - dmin=ds[1]; - for(j=2; j<=nkoc2; j++){ - if(fabs(koc2[j][2]-tmp1d4[2])<4){ - if(ds[j]<dmin){ - pull4(j,koc2,tmp1d4); - dmin=ds[j]; - } - } - else{ - addptd4(koc,tmp1d4); - pull4(j,koc2,tmp1d4); - dmin=ds[j]; - } - } - nkoc=addptd4(koc,tmp1d4); -/* - if(tmpd4[3]<2*eps1){ - if((dist(2,pta,pt)<eps2)&&(tmpd4[2]<0.1*length2(plt2d))){ - continue; - } - if((dist(2,ptb,pt)<eps2)&&(tmpd4[2]>0.9*length2(plt2d))){ - continue; - } - pull4(j,koc2,tmpd4); - nkoc=addptd4(koc,tmpd4); - } - } -*/ - for(jj=1; jj<=nkoc; jj++){ - pt[0]=koc[jj][0]; pt[1]=koc[jj][1]; - pta[0]=plt2d[1][0]; pta[1]=plt2d[1][1]; - ptb[0]=plt2d[length2(plt2d)][0]; ptb[1]=plt2d[length2(plt2d)][1]; - if((dist(2,pt,pta)<eps2)&&(koc[jj][3]<0.3*length2(plt2d))){ - continue; - } - if((dist(2,pt,ptb)<eps2)&&(koc[jj][3]>0.7*length2(plt2d))){ - continue; - } - nn1=floor(koc[jj][2]); - nn2=koc[jj][3]; - pta[0]=objp[nn1][0]; pta[1]=objp[nn1][1]; - za=objp[nn1][2]; - ptb[0]=objp[nn1+1][0]; ptb[1]=objp[nn1+1][1]; - zb=objp[nn1+1][2]; - if(dist(2,pta,ptb)<eps1){ - continue; - } - t1=dist(2,pta,pt)/dist(2,pta,ptb); - z1=(1-t1)*za+t1*zb; - pta[0]=pltp[nn2][0]; pta[1]=pltp[nn2][1]; - za=tmpmd3[nn2][2]; - ptb[0]=pltp[nn2+1][0]; ptb[1]=pltp[nn2+1][1]; - zb=tmpmd3[nn2+1][2]; - if(dist(2,pta,ptb)<Eps){ - continue; - } - t2=dist(2,pta,pt)/dist(2,pta,ptb); - z2=(1-t2)*za+t2*zb; - if(z1<z2-eps1){ - if(nclipL==0){ - tmpd1=1; - } - } - else{ - tmpd1=Inf; - for(j=1; j<=nclipL; j++){ - tmp2d1=pow(clipL[j][0]-pt[0],2.0); - tmp2d1=tmp2d1+pow(clipL[j][1]-pt[1],2.0); - tmpd1=fmin(tmpd1,tmp2d1); - } - } - if(tmpd1>pow(Eps,2.0)){ - pts1[0][0]=0; - pointoncurve(nn1,obj2d,Eps,tmp1d2); - addptd2(pts1,tmp1d2); - pointoncurve(nn1+1,obj2d,Eps,tmp1d2); - addptd2(pts1,tmp1d2); - tmp1d2[0]=pts1[2][0]-pts1[1][0]; - tmp1d2[1]=pts1[2][1]-pts1[1][1]; - tmp2d2[0]=ptb[0]-pta[0]; - tmp2d2[1]=ptb[1]-pta[1]; - tmp3d1=dotprod(2,tmp1d2,tmp2d2); - origin[0]=0; origin[1]=0; - tmp3d1=tmp3d1/dist(2,tmp1d2,origin)/dist(2,tmp2d2,origin); - tmpd1=1-0.5*pow(tmp3d1,2.0); - r0=0.075*r00; - nclipL=push5(pt[0],pt[1], nn1,t1,r0/tmpd1, clipL); - } - } - } - } - kukanL[0][0]=0; - te=length3(obj); - push2(1.0,te, kukanL); - for(ii=1; ii<=nclipL; ii++){ - pt[0]=clipL[ii][0]; pt[1]=clipL[ii][1]; - nn=clipL[ii][2]; - tt=nn+clipL[ii][3]; - rr=clipL[ii][4]; - flg=0; - for(jj=nn; jj>=1; jj--){ - pointoncurve(jj,obj2d,Eps,ptq); - if(dist(2,pt,ptq)<rr){ - continue; - } - flg=jj; - break; - } - if(flg==0){ - t1=1; - } - else{ - t1=flg; t2=tt; - hh=t2-t1; - for(j=1; j<=10; j++){ - hh=hh*0.5; - pointoncurve(t1+hh,obj2d,Eps,ptq); - if(dist(2,pt,ptq)<rr){ - t2=t2-hh; - } - else{ - t1=t1+hh; - } - } - } - ku[0]=t1; - flg=0; - for(jj=nn+1; jj<=te; jj++){ - pointoncurve(jj,obj2d,Eps,ptq); - if(dist(2,pt,ptq)<rr){ - continue; - } - flg=jj; - break; - } - if(flg==0){ - t2=te; - } - else{ - t1=tt; t2=flg; - hh=t2-t1; - for(j=1; j<=10; j++){ - hh=hh*0.5; - pointoncurve(t1+hh,obj2d,Eps,ptq); - if(dist(2,pt,ptq)<rr){ - t1=t1+hh; - } - else{ - t2=t2-hh; - } - } - } - ku[1]=t2; - ntmp=kukannozoku(ku,kukanL,tmpmd2); - kukanL[0][0]=0; - appendd2(0,1,ntmp,tmpmd2,kukanL); - } - for(jj=1; jj<=length2(kukanL); jj++){ - tmp1d2[0]=kukanL[jj][0]; tmp1d2[1]=kukanL[jj][1]; - t1=kukanL[jj][0]; nn1=floor(t1); - t2=kukanL[jj][1]; nn2=floor(t2); - ptL2[0][0]=0; - ptL[0][0]=0; - if(t1-nn1<1-Eps){ - pointoncurve(t1,obj2d,Eps,tmp1d2); - addptd2(ptL2,tmp1d2); - invparapt(t1, obj2d, obj, tmpd3); - addptd3(ptL,tmpd3); - } - for(j=nn1+1; j<=nn2; j++){ - pointoncurve(j,obj2d,Eps,tmp1d2); - addptd2(ptL2,tmp1d2); - invparapt(j, obj2d, obj, tmpd3); - addptd3(ptL,tmpd3); - } - if(t2-nn2>Eps){ - pointoncurve(t2,obj2d,Eps,tmp1d2); - addptd2(ptL2,tmp1d2); - invparapt(t2, obj2d, obj, tmpd3); - addptd3(ptL,tmpd3); - } - if(length2(ptL2)>1){ - appendd2(2,1,length2(ptL2),ptL2,allres2); - appendd3(2,1,length3(ptL),ptL,allres); - } - } - } - return length3(allres); -} - -/* -void writesfbd(const char *var, const char *fname, const char *fnameh,double sf[][3]){ - sfbdparadata(sf); - output3(var, "", fname,2,sf); - output3(var, "h", fnameh,2,Borderhiddendata); -} - -void writecrv(const char *var, const char *fname, const char *fnameh, - double crv[][3],double sf[][3]){ - crvsfparadata(crv, sf, 1,Crvdata); - output3(var, "", fname,2,Crvdata); - output3(var, "h", fnameh,2,Crvsfhiddendata); -} - -void writewire(const char *var, const char *fname, const char *fnameh, - double sf[][3], int num, double udv[], double vdv[]){ - wireparadata(sf, num, udv,vdv, Wiredata); - output3(var, "", fname,2,Wiredata); - output3(var, "h", fnameh,2,Hiddenwiredata); -} - -void writesfcut(const char *var, const char *fname, const char *fnameh, - double crv[][3], double sf[][3]){ - sfcutdata(crv); - crv3onsfparadata(crv, sf, Crvonsfdata); - output3(var, "", fname,2,Crvonsfdata); - output3(var, "h", fnameh,2,Crv3onsfhiddendata); -} - -void writecrvonsf(const char *var, const char *fname, const char *fnameh, - double crv[][3],double sf[][3]){ - crv3onsfparadata(crv, sf, Crvonsfdata); - output3(var, "", fname,2,Crvonsfdata); - output3(var, "h", fnameh,2,Crv3onsfhiddendata); -} -*/ - - diff --git a/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h b/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h deleted file mode 100644 index df31a4d8..00000000 --- a/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h +++ /dev/null @@ -1,58 +0,0 @@ -double Xval[DsizeS], Yval[DsizeS], Zval[DsizeS][DsizeS]; - -////////////////////// -short Ch=1; -///////////////////// - -//double Implicitdata[DsizeL][2]; //180320 -double Cuspsplitpt[DsizeL][2]; -double Cusppt[DsizeM][2]; -double Otherpartition [DsizeM]; -double Partitionpt[DsizeM][2]; -double Cuspdata[DsizeM]; -double Wirept[DsizeM][3]; -double Hiddendata[DsizeL][3]; -double Borderpt[DsizeM][2]; -double Borderhiddendata[DsizeL][3]; -double Surf[DsizeL][3]; -double Crvdata[DsizeL][3]; -double Wiredata[DsizeLL][3]; - -int output3(const char *var, const char *fname, int level, double out[][3]); -int output3h(const char *var, const char *varh, const char *fname, double out[][3]); -int writedataC(const char *fname, double out[][3]); -int readdataC(const char *fname, double data[][3]); -void parapt(double pt3[3],double pt2[2]); -int projpara(double p3[][3], double p2[][2]); -double invparapt(double ph, double fh[][2], double fk[][3],double out[3]); -int surfcurve(short ch,int level, double crv[][2], double pdata[][3]); -int xyzax3data(double x0, double x1, double y0, double y1, double z0, double z1, - double out[][3]); -double evlpfun(short ch, double u, double v); -int envelopedata(short ch, double out[][2]); -void evlptablepara(short ch); -//int implicitplot(double out[][2]); -int cuspsplitpara(short ch,double pdata[][2], double outkL[][3]); -double funpthiddenQ(short ch,double u, double v, double pa[3]); -int makexybdy(short ch,double ehL[][2]); -void partitionseg(double fig[][2],double gL[][2], int ns, double parL[]); -void makevaltablepth(short ch,double pta[3]); -int pthiddenQ(short ch,double pta[3], int uveq, double eps[2]); -int nohiddenpara2(double paL[], double fk[][3], int uveq, double figkL[][3]); -int borderparadata(short ch,double fkL[][3], double fsL[][3]); -int dropnumlistcrv3(double qd[][3], double eps1, int out[]); -int sfbdparadata(short ch,double outd3[][3]); -void makevaltablemeet(short ch,double pa[3], double vec[3], double eps0); -int meetpoints(short ch,double pta[3], double ptb[3], double eps, double ptL[][3]); -int crvsfparadata(double fkL[][3], double fbdkL[][3], int sepflg, double out[][3]); -int sfcutdata(int ch, double ekL[][3]); -int crv3onsfparadata(double fk[][3], double fbdyd3[][3], double out[][3]); -int wireparadata(double bdyk[][3], double udv[], double vdv[], int num, - double fsL[][3]); -int projcoordcurve(double curve[][3], double out[][3]); -int kukannozoku(double jokyo[2], double kukanL[][2], double res[][2]); -int skeletondata3(double data[][3], double r00, double eps1, double eps2, - double allres[][3]); - -double cutfun(short ch,int chcut,double u, double v); -void makevaltablecut(int chcut); diff --git a/texmf-dist/scripts/ketcindy/ketoutset.txt b/texmf-dist/scripts/ketcindy/ketoutset.txt deleted file mode 100644 index 38381ef2..00000000 --- a/texmf-dist/scripts/ketcindy/ketoutset.txt +++ /dev/null @@ -1,68 +0,0 @@ -if(iswindows(),
-// PathThead="C:\kettex\texlive\bin\win32\";
-// PathThead="";
-// PathT=PathThead+"platex";
- PathT=PathThead+"uplatex";
-// PathT=PathThead+"platex";
-// PathT=PathThead+"latex";
-// PathT=PathThead+"pdflatex";
-// PathT=PathThead+"lualatex";
-// PathS="C:\Program Files\scilab-5.5.2\bin\scilex";
- PathS="C:\Program Files\scilab-6.0.0\bin\scilex";
- PathC="C:\MinGW\bin\gcc.exe";
-// PathC="C:\MinGW32\bin\gcc.exe";
- Pathpdf="C:\Program Files\SumatraPDF\SumatraPDF.exe";
- PathR="C:\Program Files\R\R-3.4.2\bin";
- PathA="C:\Program Files\asir\bin\asir";
- PathM="C:\maxima-5.37.3\bin\maxima.bat";
- PathV3="C:\Program Files\VCG\MeshLab\meshlab";
- PathF="C:\cygwin\bin";
-// PathAd="C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe";
- PathAd="C:\Program Files\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe";
-);
-if(ismacosx(),
-// PathThead="/Applications/kettex/texlive/bin/x86_64-darwin/";
-// PathThead="/Library/TeX/texbin/";
-// PathThead="";
-// PathT=PathThead+"platex";
- PathT=PathThead+"uplatex";
-// PathT=PathThead+"latex";
-// PathT=PathThead+"xelatex";
-// PathT=PathThead+"pdflatex";
-// PathT=PathThead+"lualatex";
-// PathS="/Applications/scilab-5.5.2.app/Contents/MacOS/bin/scilab";
- PathS="/Applications/scilab-6.0.0.app/Contents/MacOS/bin/scilab";
- Pathpdf="preview";
-// Pathpdf="skim";
-// Pathpdf="/Applications/skim.app/Contents/MacOS/Skim";
- PathC="gcc";
-// PathR="R";
-// PathR="/Library/Frameworks/R.framework/Versions/3.3/Resources/bin/R";
- PathR="/Library/Frameworks/R.framework/Versions/Current/Resources/bin/R";
- PathA="/Applications/cfep.app/OpenXM/rc/asir";
- PathM="/Applications/Maxima.app/Contents/Resources/maxima.sh";
- PathV3="/Applications/meshlab.app/Contents/MacOS/MeshLab";
- PathF="/Applications/FriCAS.app/Contents/Resources/bin/fricas";
-// PathAd="Adobe Reader";
- PathAd="/Applications/Adobe Acrobat Reader DC.app/Contents/MacOS/AdobeReader";
- Mackc="sh";
-// Mackc="open";
-);
-if(islinux(),
- PathT="uplatex";
- PathS="scilab";
- Pathpdf="evince";
-// Pathpdf="/usr/bin/xpdf";
- PathR="R";
- PathA="";
- PathM="maxima";
- PathV3="";
- PathF="";
- PathAd="";
-);
-
-if(indexof(PathT,"platex")>0,
- Helplist(["+","+3d","+mv"],"helpJ");
-,
- Helplist(["+","+3d","+mv"],"helpE");
-);
diff --git a/texmf-dist/scripts/ketcindy/setketcindy.txt b/texmf-dist/scripts/ketcindy/setketcindy.txt deleted file mode 100755 index 39de2543..00000000 --- a/texmf-dist/scripts/ketcindy/setketcindy.txt +++ /dev/null @@ -1,12 +0,0 @@ -// e:2018.02.26
-Dirlib=Dirhead+pathsep()+"ketlib";
-Libname=Dirlib+pathsep()+"ketpiccurrent";
-DirlibC=Dirhead+pathsep()+"ketlibC";
-setdirectory(Dirlib);
-import("ketcindylibbasic1r.cs");
-import("ketcindylibbasic2r.cs");
-import("ketcindyliboutr.cs");
-import("ketcindylib3dr.cs");
-import("ketcindylibmvr.cs");
-
-setdirectory(Dirhead);
diff --git a/texmf-dist/scripts/ketcindy/template1basic.cdy b/texmf-dist/scripts/ketcindy/template1basic.cdy Binary files differdeleted file mode 100644 index 806d69f2..00000000 --- a/texmf-dist/scripts/ketcindy/template1basic.cdy +++ /dev/null diff --git a/texmf-dist/scripts/ketcindy/template2advanced.cdy b/texmf-dist/scripts/ketcindy/template2advanced.cdy Binary files differdeleted file mode 100755 index 3fa2e25a..00000000 --- a/texmf-dist/scripts/ketcindy/template2advanced.cdy +++ /dev/null |