MacPeople 2001 June 15/MACPEOPLE-2001-06-15.ISO.7z/MACPEOPLE-2001-06-15.ISO/オンラインウエア/新着！オンラインウエア16/KHyX.sit/KHyX/Modules/HMNumberTheory/stack.txt

Text File | 2001-03-08 | 7KB | 237 lines

-- stack: in
-- format: 10 (HyperCard 2)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=112, y1=113, x2=528, y2=353)
-- screen: Rect(x1=0, y1=0, x2=640, y2=480)
-- card dimensions: w=416 h=240
-- scroll: x=0 y=0
-- background count: 1
-- first background id: 2751
-- card count: 1
-- first card id: 3631
-- list block id: 2129
-- print block id: 0
-- font table block id: 3359
-- style table block id: 3273
-- free block count: 2
-- free size: 6240 bytes
-- total size: 16384 bytes
-- stack block size: 6144 bytes
-- created by hypercard version: 0x02418000
-- compacted by hypercard version: 0x02418000
-- modified by hypercard version: 0x02418000
-- opened by hypercard version: 0x02418000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0xDDA23EFB
----- HyperTalk script -----
function binaryAND x,y
put baseconvert(x,10,2) into bx
put baseconvert(y,10,2) into by
repeat while (the number of chars in bx) < (the number of chars in by)
  put "0" before bx
end repeat
repeat while (the number of chars in by) < (the number of chars in bx)
  put "0" before by
end repeat
put "" into bz
repeat with xx = 1 to (the number of chars in by)
  put char xx of bx into c1
  put char xx of by into c2
  put ((c1 = 1) AND (c2 = 1)) into bool
  if bool then put "1" after bz
  if not bool then put "0" after bz
end repeat
return baseconvert(bz,2,10)
end binaryAND

function binaryOR x,y
put baseconvert(x,10,2) into bx
put baseconvert(y,10,2) into by
repeat while (the number of chars in bx) < (the number of chars in by)
  put "0" before bx
end repeat
repeat while (the number of chars in by) < (the number of chars in bx)
  put "0" before by
end repeat
put "" into bz
repeat with xx = 1 to (the number of chars in by)
  put char xx of bx into c1
  put char xx of by into c2
  put ((c1 = 1) OR (c2 = 1)) into bool
  if bool then put "1" after bz
  if not bool then put "0" after bz
end repeat
return baseconvert(bz,2,10)
end binaryOR

function binaryXOR x,y
put baseconvert(x,10,2) into bx
put baseconvert(y,10,2) into by
repeat while (the number of chars in bx) < (the number of chars in by)
  put "0" before bx
end repeat
repeat while (the number of chars in by) < (the number of chars in bx)
  put "0" before by
end repeat
put "" into bz
repeat with xx = 1 to (the number of chars in by)
  put char xx of bx into c1
  put char xx of by into c2
  put ((c1 = 1) OR (c2 = 1)) into bool
  if ((c1 = 1) AND (c2 = 1)) then put false into bool
  if bool then put "1" after bz
  if not bool then put "0" after bz
end repeat
return baseconvert(bz,2,10)
end binaryXOR

function binaryNOT x
put baseconvert(x,10,2) into bx
put "" into bz
repeat with xx = 1 to (the number of chars in bx)
  put char xx of bx into c1
  if c1 = 0 then put "1" after bz
  if c1 = 1 then put "0" after bz
end repeat
return baseconvert(bz,2,10)
end binaryNOT

function isPrime x
if x < 2 then return "neither"
if intgr(x) <> x then return "neither"
if (x > 6) and (last char of x is in "024685") then return false -- cheating shortcut
if (x < 7) then return item x of "neither,true,true,false,true,false,true" -- and another
put true into bol
repeat with xx = 2 to intgr(sqrt(x))
  if (x/xx) = intgr(x/xx) then put false into bol
end repeat
return bol
end isPrime

function isComposite x
if x < 2 then return "neither"
if intgr(x) <> x then return "neither"
return (not (isprime(x)))
end isComposite

function isPerfect x
put empty into factorList
if x < 1 then return "neither"
if intgr(x) <> x then return "neither"
if comma & x & comma is in ",6,28,496,8128,33550336,8589869056,137438691328,2305843008139952128," then return true -- cheating shortcut
if x < 100000000 then return false -- and another
if (factorSum(x)-x) = x then return true
return false
end isPerfect

function isAbundant x
put empty into factorList
if x < 1 then return "neither"
if intgr(x) <> x then return "neither"
if comma & x & comma is in ",6,28,496,8128,33550336,8589869056,137438691328,2305843008139952128," then return false
return (factorSum(x)-x) > x
end isAbundant

function isDeficient x
put empty into factorList
if x < 1 then return "neither"
if intgr(x) <> x then return "neither"
if comma & x & comma is in ",6,28,496,8128,33550336,8589869056,137438691328,2305843008139952128," then return false
return (factorSum(x)-x) < x
end isDeficient

function isHappy x
if x < 0 then return "neither"
if intgr(x) <> x then return "neither"
put 0 into a
repeat with i = 1 to (the number of chars in x)
  add (char i of x)^3 to a
end repeat
return (a = x)
end isHappy

function isPalindromic x
put x into n1
put empty into n2
repeat with x = 1 to (the number of chars in n1)
  put char x of n1 before n2
end repeat
return (n1 = n2)
end isPalindromic

function isTriangular x
return (sqrt((8*x)+1) = intgr(sqrt((8*x)+1)))
end isTriangular

function isSquare x
return (sqrt(x) = intgr(sqrt(x)))
end isSquare

function isEven x
return (x/2 = intgr(x/2))
end isEven

function isOdd x
return not isEven(x)
end isOdd

function isPositive x
return (x > 0)
end isPositive

function isNegative x
return (x < 0)
end isNegative

function thePerfectness x
if isAbundant(x) then return "1"
if isDeficient(x) then return "-1"
if isPerfect(x) then return "0"
end thePerfectness

function thePolarity x
return sgn(x)
end thePolarity