home *** CD-ROM | disk | FTP | other *** search
/ 64'er 1990 June / 64er_Magazin_90-06_1990_Markt__Technik_de_Side_A.d64 / fakultaet (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  4KB  |  168 lines
  1. 100 rem ************************
  2. 110 rem
  3. 120 rem  fakultaetsberechnung
  4. 130 rem
  5. 140 rem    von c.p.hugelmann
  6. 150 rem
  7. 160 rem ************************
  8. 170 rem programmparameter
  9. 180 fm=100000:nz%=5:ns%=7180
  10. 190 pi=1314 : pz=1329
  11. 200 rem eingabe der fakultaet
  12. 210 gosub 1000
  13. 220 rem berechnung der ziffernanzahl
  14. 230 gosub 1100
  15. 240 rem speicherbedarfabschaetzung
  16. 250 gosub 1300
  17. 260 rem abschaetzung der rechenzeit
  18. 270 gosub 1400
  19. 280 rem ausfuehren ?
  20. 290 gosub 1500
  21. 300 rem initialisierung
  22. 310 ti$="000000" : ta=ti
  23. 320 ml%=1
  24. 330 dim m1(nd%)
  25. 340 m1(1)=1
  26. 350 print"[147]"
  27. 360 rem bildschirm ganz dunkel ?
  28. 400 rem berechnung
  29. 410 for i=1 to ff%
  30. 420 ue=0
  31. 430 rem gosub 1600   fuer diagnose
  32. 440 for j=1 to ml%
  33. 450 zz=m1(j)*i+ue
  34. 460 uf=int(zz/fm)
  35. 470 m1(j)=zz-uf*fm
  36. 480 ue=uf
  37. 490 next
  38. 500 if ue=0 then 530
  39. 510 ml%=ml%+1
  40. 520 m1(ml%)=ue
  41. 530 next
  42. 600 rem nachbereitung
  43. 610 ta=(ti-ta)/60
  44. 620 au%=0
  45. 900 rem verteiler
  46. 910 gosub 1700
  47. 999 end
  48. 1000 print"[147]"
  49. 1010 print" "
  50. 1020 print"welche fakultaet moechten sie berechnen";
  51. 1030 input a$
  52. 1040 if a$="0" then ff%=0 : goto 1070
  53. 1050 ff%=val(a$)
  54. 1060 if ff%=0 then print"geben sie bitte nur eine zahl groesser 0 ein":goto 1010
  55. 1070 a$=str$(ff%)
  56. 1080 ll%=len(a$)
  57. 1090 fs$=right$(a$,ll%)+"!"
  58. 1099 return
  59. 1100 if ff%=0 or ff%=1 then fz=1 : goto 1180
  60. 1110 lx=log(sqr(6.283185307179))
  61. 1120 ly=(ff%+0.5)*log(ff%)-ff%+lx
  62. 1130 lz=log(10.)
  63. 1140 fz=int(ly/lz)+1
  64. 1150 if fz=1 then 1180
  65. 1160 print fs$;" hat ";fz;" ziffern"
  66. 1170 goto 1199
  67. 1180 print ff%;"! hat eine ziffer"
  68. 1199 rem return falls 0en uninteressant
  69. 1200 ll%=ff%
  70. 1210 l5%=0
  71. 1220 m5%=int(ll%*0.2+0.1)
  72. 1230 if ll%>=5 then:l5%=l5%+m5%:ll%=m5%:goto 1220
  73. 1240 if l5%=0 then 1299
  74. 1250 if l5%=1 then 1280
  75. 1260 print" ...davon ";l5%;" nullen am ende"
  76. 1270 return
  77. 1280 print" ...davon eine null am ende"
  78. 1299 return
  79. 1300 nd%=int((fz+nz%-.5)/nz%)
  80. 1310 if nd%<=ns% then 1399
  81. 1315 print" "
  82. 1320 print" "
  83. 1325 print"     leider reicht der speicher-"
  84. 1330 print"     bedarf fuer eine berechnung"
  85. 1335 print"     so nicht aus. weiter ueber "
  86. 1340 print"     10000! kommt man nur, wenn "
  87. 1345 print"     man je 4 ziffern in einem  "
  88. 1350 print"     integerfeld speichert(nz%=4"
  89. 1355 print"     nd%<=ns%=18000,dim m1%(ns%))"
  90. 1360 print"     die zeitberechnung stimmt "
  91. 1365 print"     dann so nicht mehr :  "
  92. 1370 print" "
  93. 1380 au%=-1
  94. 1399 return
  95. 1400 if ff%>99 then 1440
  96. 1410 a=0.10633 : b=1.5192e-4 : c=3.2094e-3 : d=1.6457e-5 : e=6.18974e-2
  97. 1420 se=((d*ff%+c)*ff%+b)*ff%+a+e*log(ff%+1)
  98. 1430 goto 1480
  99. 1440 a=-426.652 : b=-1.64185 : c=8.36252e-3 : d=4.6302e-7 : e=119.972
  100. 1450 se=int(((d*ff%+c)*ff%+b)*ff%+a+e*log(ff%)+.5)
  101. 1480 print"die berechnung dauert etwa"
  102. 1490 print se;" sekunden"
  103. 1499 return
  104. 1500 print" "
  105. 1510 if au%>=0 then print"  ausfuehren (j/n)":goto1530
  106. 1520 print"weiter mit <return>"
  107. 1530 get a$ : if a$="" then 1530
  108. 1540 if au%<0 then 900
  109. 1570 if left$(a$,1)="n" then au%=-1 : goto 900
  110. 1580 au%=1
  111. 1599 return
  112. 1600 poke pi-3,9:poke pi-2,61
  113. 1610 a$=str$(val(str$(i)))
  114. 1620 for k=1 to len(a$)
  115. 1630 poke pi+k,asc(mid$(a$,k,1))
  116. 1640 next
  117. 1650 poke pz+2,19:poke pz+3,5:poke pz+4,3
  118. 1660 a$=str$(int((ti-ta)/60))
  119. 1670 for k=1 to len(a$)
  120. 1680 poke pz-len(a$)+k,asc(mid$(a$,k,1))
  121. 1690 next
  122. 1699 return
  123. 1700 print"[147]"
  124. 1710 print" "
  125. 1720 print"neue fakultaetsberechnung   --> 1"
  126. 1730 print"aufhoeren                   --> 2"
  127. 1740 if au%<0 then goto 1800
  128. 1750 print"laenge,zeit                 --> 3"
  129. 1760 print"ausgabe   bildschirm        --> 4"
  130. 1770 print"ausgabe   floppy            --> 5"
  131. 1775 goto 1800
  132. 1780 print"ausgabe   drucker           --> 6"
  133. 1800 get a$ :if a$="" then 1800
  134. 1810 ll%=val(a$)
  135. 1815 print"[147]"
  136. 1820 on ll% goto 1840,999,1900,1850,1930,2000
  137. 1830 print"eingabefehler !":goto 1710
  138. 1840 run
  139. 1850 print fs$;" = ";right$(str$(m1(ml%)),nz%);
  140. 1860 if ml%=1 then 1895
  141. 1870 for k=ml%-1 to 1 step -1
  142. 1880 print right$(str$(fm+m1(k)),nz%);
  143. 1890 next
  144. 1895 get a$ : if a$="" then 1895
  145. 1899 goto 1700
  146. 1900 rem zeitvergleich
  147. 1910 gosub 1150
  148. 1920 print "zur berechnung wurden benoetigt:"
  149. 1921 print ta;" sekunden"
  150. 1925 print "(geschaetzt:";se;" )"
  151. 1928 get a$ :if a$="" then 1928
  152. 1929 goto 1700
  153. 1930 rem floppy
  154. 1940 print"floppy eingeschaltet ?"
  155. 1950 get a$ :if a$="" then 1950
  156. 1960 open 11,8,11,"0:"+fs$+",s,w"
  157. 1970 zz$="*** "+fs$+" mit "+str$(fz)+"ziffern  ***"
  158. 1971 print#11,zz$
  159. 1980 zz$="*** berechnet in "+str$(ta)+" sekunden ***"
  160. 1981 print#11,zz$
  161. 1990 for k=ml% to 1 step -1
  162. 1991 print#11,right$(str$(fm+m1(k)),nz%);
  163. 1992 next
  164. 1993 print#11,"*"
  165. 1997 close 11
  166. 1998 goto 1710
  167. 1999 return
  168.