قرآن در کامپیوتر

کدام دنباله می تواند دنباله ی درجه های راس های یک گراف باشد ؟ 

این برنامه جواب سوال بالا را با استفاده از قضیه ی هاول حکیمی و به قدرت برنامه ی بیسیک جواب می دهد .
ابتدا شما تعداد راس های گراف را وارد کنید ، سپس برنامه از شما درجه ی راس ها را می خواهد . در انتها برنامه به شما می گوید که دنباله مربوط به گراف است یا خیر . 

طرز کار برنامه :
1- ابتدا دنباله را بصورت صعودی مرتب می کند
2- بزرگترین جمله را حذف و به تعداد آن از جمله های قبلی یک واحد کم می کند
3- اگر عدد مفنفی ظاهر شود دنباله گرافیکی نیست
4- دوباره مرتب می کند
5-درانتها اگر دنباله به عدد صفر برسد آنگاه دنباله مربوط به یک گراف ساده خواهد بود. 

CLS INPUT "tedade ras ha : ", n DIM a(n) PRINT "Enter one by one deg graf :" FOR i = 1 TO n INPUT a(i) NEXT i DO FOR i = 1 TO n FOR j = 1 TO n - i IF a(j) > a(j + 1) THEN SWAP a(j), a(j + 1) END IF NEXT j, i k = n FOR i = a(n) TO 1 STEP -1 k = k - 1 a(k) = a(k) - 1 IF a(k) < 0 THEN PRINT "no graf" END END IF NEXT i a(n) = 0 n = n - 1 LOOP UNTIL n = 0 PRINT "ok graf" END PRINT "sys.blogsky.com"  

نویسنده برنامه رسول فضلی 

تجزیه به عوامل اول  

این برنامه عدد ورودی را به عوامل اول تجزیه می کند   

CLS lz = 1 DIM az(10000), avals(10000) kz = 100000 gz = INT(SQR(kz)) avals(lz) = 2 FOR iz = 3 TO gz STEP 2 cz = 0 FOR jz = 2 TO iz \ 2 rz = iz MOD jz IF rz = 0 THEN cz = cz + 1: EXIT FOR NEXT jz IF cz = 0 THEN lz = lz + 1 avals(lz) = iz nz = nz + 1 az(nz) = iz END IF NEXT iz IF gz MOD 2 = 0 THEN gz = gz + 1 FOR iz = gz TO kz STEP 2 cz = 0 FOR jz = 1 TO nz rz = iz MOD az(jz) IF rz = 0 THEN cz = cz + 1: EXIT FOR NEXT jz IF cz = 0 THEN lz = lz + 1 avals(lz) = iz mz = mz + 1 END IF NEXT iz '**************************************** DEF fnmm (n) DIM b(1000), c(1000) i = 0: k = 0: m = 0: j = 0: aval = 2 WHILE n <> 1 m = n MOD aval IF m = 0 THEN n = n / aval IF aval = laval THEN j = j + 1 c(k) = j ELSE j = 1 k = k + 1 b(k) = aval c(k) = j laval = aval END IF ELSE i = i + 1 aval = avals(i) END IF WEND q = 1 FOR p = 1 TO k PRINT b(p); "^"; c(p); "*"; t = ((b(p) ^ (c(p) + 1)) - 1) / (b(p) - 1) q = q * t NEXT p PRINT fnmm = q END DEF print "Down load in WWW.SYS.blogsky.com" '**************************************** input v tgzeh=fnmm(v)  

نویسنده برنامه رسول فضلی

زوج های متحابه
این برنامه زوج های متحابه را تا 100000 محاسبه می کند .زبان این برنامه بیسیک می باشد
این برنامه از سه قسمت تشکیل شده است قسمت اول اعداد اول تا عدد 100000 را محاسبه می کند این اعداد برای محاسبه مجموع مقسوم علیه ها کاربرد دارد .روش بکار رفته در محاسبه ی این اعداد اول به وسیله غربال ارتستن می باشد .
در قسمت دوم با استفاده از فرمولی مجموع مقسوم علیه های اعداد را محاسبه می کند در این فرمول از اعداد اول استفاده می شود
در قسمت سوم مجموع مقسوم علیه ها مقایسه می شود در صورت منطبق بودن با تعریف زوج متحابه آن را چاپ می کند
تعریف زوج های متحابه :
زوج متحابه را با ذکر یک مثال تعریف می کنم . بطور مثال دو عدد 220 و 284 زوج های متحابه هستند چون مجموع مقسوم علیه های عدد 220 برابر 284 می باشد و همچنین مجموع مقسوم علیه های  284 برابر 220 می باشد .در مجموع مقسوم علیه ها خود عدد را جمه نمی بندیم .

چند تا از زوج های متحابه (220و284) (88730و79750) (2024444و196724)
 

ti = TIMER CLS print "Down load in WWW.SYS.blogsky.com" lz = 1 DIM az(10000), avals(10000) kz = 100000 gz = INT(SQR(kz)) avals(lz) = 2 FOR iz = 3 TO gz STEP 2 cz = 0 FOR jz = 2 TO iz \ 2 rz = iz MOD jz IF rz = 0 THEN cz = cz + 1: EXIT FOR NEXT jz IF cz = 0 THEN lz = lz + 1 avals(lz) = iz nz = nz + 1 az(nz) = iz END IF NEXT iz IF gz MOD 2 = 0 THEN gz = gz + 1 FOR iz = gz TO kz STEP 2 cz = 0 FOR jz = 1 TO nz rz = iz MOD az(jz) IF rz = 0 THEN cz = cz + 1: EXIT FOR NEXT jz IF cz = 0 THEN lz = lz + 1 avals(lz) = iz mz = mz + 1 END IF NEXT iz '**************************************** DEF fnmm (n) nn = n DIM b(1000), c(1000) i = 0: k = 0: m = 0: j = 0: aval = 2 WHILE n <> 1 m = n MOD aval IF m = 0 THEN n = n / aval IF aval = laval THEN j = j + 1 c(k) = j ELSE j = 1 k = k + 1 b(k) = aval c(k) = j laval = aval END IF ELSE i = i + 1 aval = avals(i) END IF WEND q = 1 FOR p = 1 TO k 'PRINT b(p); "^"; c(p); "*"; t = ((b(p) ^ (c(p) + 1)) - 1) / (b(p) - 1) q = q * t NEXT p fnmm = q - nn END DEF '**************************************** FOR v = 4 TO 100000 pz = fnmm(v) IF pz > v AND pz < 100000 THEN IF fnmm(pz) = v THEN PRINT pz, v END IF NEXT v PRINT "all time : "; INT(TIMER - ti); "S"

 نویسنده برنامه رسول فضلی

محاسبه مجموع مقسوم علیه
این برنامه با استفاده از زبان برنامه نویسی بیسیک مجموع مقسوم علیه های عدد ورودی را با سرعتی بسیار بالا محاسبه می کند
برای این ذکر کردم که با سرعت بالا چون این برنامه با استفاده از فرمول این محاسبات را انجام می دهد.
این برنامه مجموع مقسوم علیه های اعداد کمتر از 100000 را محاسبه می کند

CLS lz = 1 DIM az(10000), avals(10000) kz = 100000 gz = INT(SQR(kz)) avals(lz) = 2 FOR iz = 3 TO gz STEP 2 cz = 0 FOR jz = 2 TO iz \ 2 rz = iz MOD jz IF rz = 0 THEN cz = cz + 1: EXIT FOR NEXT jz IF cz = 0 THEN lz = lz + 1 avals(lz) = iz nz = nz + 1 az(nz) = iz END IF NEXT iz IF gz MOD 2 = 0 THEN gz = gz + 1 FOR iz = gz TO kz STEP 2 cz = 0 FOR jz = 1 TO nz rz = iz MOD az(jz) IF rz = 0 THEN cz = cz + 1: EXIT FOR NEXT jz IF cz = 0 THEN lz = lz + 1 avals(lz) = iz mz = mz + 1 END IF NEXT iz '**************************************** DEF fnmm (n) DIM b(1000), c(1000) i = 0: k = 0: m = 0: j = 0: aval = 2 WHILE n <> 1 m = n MOD aval IF m = 0 THEN n = n / aval IF aval = laval THEN j = j + 1 c(k) = j ELSE j = 1 k = k + 1 b(k) = aval c(k) = j laval = aval END IF ELSE i = i + 1 aval = avals(i) END IF WEND q = 1 FOR p = 1 TO k 'PRINT b(p); "^"; c(p); "*"; t = ((b(p) ^ (c(p) + 1)) - 1) / (b(p) - 1) q = q * t NEXT p fnmm = q END DEF print "Down load in WWW.SYS.blogsky.com" '**************************************** input v print "Mjmo Mghsom Alayeh : ";fnmm(v)

نویسنده برنامه رسول فضلی

گرفتن جذر بدون استفاده از تابع sqr

برنامه ای بنویسید که بدون استفاده از تابع SQR جذر یک عدد سی رقمی را محاسبه کند
توجه داشته باشید که خروجی به صورت نماد علمی نباشد و نیازی به محاسبه اعشار نیست.

CLS k = -1 INPUT "SQR : ", a$ PRINT SQR(VAL(a$)) l = LEN(a$) IF l MOD 2 <> 0 THEN a$ = "0" + a$: l = l + 1 DIM b$(l / 2) FOR i = 1 TO l STEP 2 j = j + 1 b$(j) = MID$(a$, i, 2) NEXT DO k = k + 1 d = k ^ 2 LOOP WHILE d <= VAL(b$(1)) IF d > VAL(b$(1)) THEN k = k - 1 x$ = STR$(k) e$ = STR$(VAL(b$(1)) - (k ^ 2)) FOR i = 1 TO j - 1 e$ = e$ + b$(i + 1) f = 10 DO f = f - 1 g = (k * 20 + f) * f LOOP WHILE g > VAL(e$) e$ = STR$(VAL(e$) - g) x$ = x$ + LTRIM$(STR$(f)) k = k * 10 + f NEXT PRINT x$ END

محاسبه ریشه n ام یک عدد
این برنامه بدون استفاده از توابعی مانند SQR که جذر عدد را محاسبه می کند می تواند نه تنها جذر با فرجه دو را محاسبه کند بلکه توانایی محاسبه با فرجه  n را نیز دارد
این برنامه با استفاده از قاعده ی دیفرانسیل نوشته شده است و عدد خروجی دارای کمی خطا است .

CLS INPUT "n,a : ", n, a DO k = i ^ n i = i + 1 LOOP WHILE k < a i = i - 1 b = a - i ^ n IF i = 0 THEN PRINT "0": END PRINT i + b / (n * i ^ (n - 1)) END

نویسنده برنامه رسول فضلی

CLS INPUT "a,b,c : ", a, b, c INPUT " x,y : ", x, y PRINT IF a = 0 THEN PRINT "nemodar daregha dovom ra vared coned !!": END d = a * x ^ 2 + b * x + c IF d = y THEN PRINT "noghteh ros khat ast": END e = 1 / a * (d - y) IF e < 0 THEN PRINT "gher momken": END FOR i = -1 TO 1 STEP 2 f = x + (SQR(e) * i) g = 2 * a * f + b h = -a * (f ^ 2) + c IF h > 0 THEN h$ = "+" + STR$(h) ELSE h$ = STR$(h) END IF SELECT CASE g CASE 0 PRINT "y="; h CASE 1 IF h = 0 THEN PRINT "y=x" ELSE PRINT "y=x "; h$ END IF CASE -1 IF h = 0 THEN PRINT "y=x" ELSE PRINT "y=-x "; h$ END IF CASE ELSE IF h = 0 THEN PRINT "y="; g; "* X" ELSE PRINT "y="; g; "* X "; h$ END IF END SELECT PRINT NEXT i END

نویسنده برنامه رسول فضلی

ضرب دو ماتریس بدون استفاده از آرایه
در این برنامه بدون استفاده از آرایه دو ماتریس را می گیرد و در هم ضرب می کند و خروجی را چاپ می کند

CLS r$ = "[" INPUT "m*n , n*p (m,n,p) : ", m, n, p PRINT "Matrix I : " FOR i = 1 TO m FOR j = 1 TO n INPUT b$ a1$ = a1$ + "[" + STR$(i) + "," + STR$(j) + "]" + b$ NEXT j, i a1$ = a1$ + "[" PRINT "Matrix II : " FOR i = 1 TO n FOR j = 1 TO p INPUT b$ a2$ = a2$ + "[" + STR$(i) + "," + STR$(j) + "]" + b$ NEXT j, i a2$ = a2$ + "[" FOR i = 1 TO m FOR j = 1 TO p s = 0 FOR k = 1 TO n C1$ = "[" + STR$(i) + "," + STR$(k) + "]" C2$ = "[" + STR$(k) + "," + STR$(j) + "]" l1 = LEN(C1$) l2 = LEN(C2$) n11 = INSTR(1, a1$, C1$) n12 = INSTR(n11 + l1 - 1, a1$, r$) m1 = VAL(MID$(a1$, n11 + l1, n12 - n11 - l1)) n21 = INSTR(1, a2$, C2$) n22 = INSTR(n21 + l2 - 1, a2$, r$) m2 = VAL(MID$(a2$, n21 + l2, n22 - n21 - l2)) s = s + m1 * m2 NEXT PRINT s; NEXT PRINT NEXT

نویسنده : فضلی

گرفتن مشتق
این برنامه یک عبارت رشته ای که متغیر آن عبارت ایکس است را می گیرد و در خروجی برنامه مشتق را به صورت رشته چاپ می کند
توجه داشته باشید که این برنامه قادر به جمع جمله ها با توان برابر نیست
پس در ورودی عبارتتان دقت کنید که دو ایکس توان برابر نداشته باشند
در این برنامه توان منفی تعریف نشده است پس از وارد کردن توان منفی خوداری کنید

مثال
ورودی :
              X^25+45-2*x+6*X^3
خروجی :
              25*X^24-2+18*X^2

CLS i = 1 x$ = "x" INPUT "zomleye ba zareb X : ", all$ PRINT : PRINT "moshtgh abart : ": PRINT all$ = "e" + LCASE$(all$) + "e" DO n = INSTR(i, all$, x$) IF n = 0 THEN EXIT DO IF MID$(all$, n + 1, 1) = "^" THEN k = n + 1 t$ = "": a1$ = "" DO k = k + 1 t$ = t$ + a1$ a1$ = MID$(all$, k, 1) LOOP UNTIL a1$ = "+" OR a1$ = "-" OR a1$ = "e" c = c + 1 t(c) = VAL(t$) ELSE c = c + 1 t(c) = 1 END IF IF MID$(all$, n - 1, 1) = "*" THEN k = n - 1: b = .1: z = 0: a2$ = "" DO k = k - 1 z = z + VAL(a2$) * b a2$ = MID$(all$, k, 1) b = b * 10 LOOP UNTIL a2$ = "+" OR a2$ = "-" OR a2$ = "e" IF a2$ = "-" THEN z(c) = z * (-1) ELSE z(c) = z END IF ELSE IF MID$(all$, n - 1, 1) = "-" THEN z(c) = -1 ELSE z(c) = 1 END IF END IF i = n + 1 IF t(c) = 1 THEN IF z(c) > 0 AND c > 1 THEN PRINT "+"; z(c); ELSE PRINT z(c); END IF ELSE IF z(c) > 0 AND c > 1 THEN IF t(c) = 2 THEN PRINT "+"; z(c) * t(c); "* X"; ELSE PRINT "+"; z(c) * t(c); "* X ^"; t(c) - 1; END IF ELSE IF t(c) = 2 THEN PRINT z(c) * t(c); "* X"; ELSE PRINT z(c) * t(c); "* X ^"; t(c) - 1; END IF END IF END IF LOOP UNTIL n = 0 IF i = 1 THEN PRINT "0" end

نویسنده : فضلی

برعکس و معکوس مثلث خیام پاسکال
مثلا با وارد کردن عدد پنج خروجی روبرو را چاپ می کند
یعنی 5 خط مثلث خیام پاسکال را به صورت وارون و معکوس چاپ می کند

1
    1
4       1
    3         1
6       2           1
    3         1
4       1
    1
1

DECLARE FUNCTION fact! (n!) CLS INPUT L L = L - 1 v = L FOR k = 2 * L TO 0 STEP -1 m = m + 1 IF m MOD 2 = 0 THEN v = v - 1 b = v a = a + 1 s = 0 FOR i = L TO ABS(k - L) STEP -2 IF a MOD 2 = 0 AND s = 0 THEN i = i - 1 PRINT " "; s = 1 END IF PRINT USING "##"; fact(i) / (fact(b) * fact(i - b)); PRINT " "; b = b - 1 NEXT i PRINT : PRINT NEXT k END FUNCTION fact (n) s = 1 FOR r = 1 TO n s = s * r NEXT fact = s END FUNCTION

نویسنده برنامه رسول فضلی

ضرب دو ماتریکس بدون حلقه تو در تو

شما می توانید در گرفتن و چاپ داده ها از حلقه تودر تو استفاده کنید فقط در مرحله ضرب دو ماتریس اجازه استفاده از حلقه تودر تو را ندارید

این جواب سوال هشتمین مرحله مسابقات رایانه در سطح کشوری است

CLS INPUT "n,m,p : ", n, m, p DIM m1(n, m), m2(m, p), m3(n, p) PRINT PRINT "Enter"; n * m; "number in araye one :" FOR i = 1 TO n FOR j = 1 TO m INPUT m1(i, j) NEXT j, i PRINT PRINT "Enter"; p * m; "number in araye two :" FOR i = 1 TO m FOR j = 1 TO p INPUT m2(i, j) NEXT j, i i = 1: j = 1 FOR g = 1 TO n * p * m k = k + 1 sum = sum + m1(i, k) * m2(k, j) IF k = m THEN k = 0 m3(i, j) = sum sum = 0 j = j + 1 IF j > p THEN j = 1 i = i + 1 END IF END IF NEXT PRINT FOR i = 1 TO n FOR j = 1 TO p PRINT USING "####"; m3(i, j); NEXT PRINT PRINT PRINT NEXT END

نویسنده برنامه رسول فضلی