diff --git a/.gitignore b/.gitignore index b25c15b..0f7a8e5 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ +.* *~ diff --git a/Racket/helloworld.s b/Assembly/helloworld.s similarity index 100% rename from Racket/helloworld.s rename to Assembly/helloworld.s diff --git a/Racket/test.s b/Assembly/test.s similarity index 100% rename from Racket/test.s rename to Assembly/test.s diff --git a/C/test.c b/C/test.c index dbdac49..e23808c 100644 --- a/C/test.c +++ b/C/test.c @@ -21,6 +21,10 @@ * Date: Jun 27, 2012 */ +int gcd (int a, int b) { + return 0; +} + int main () { return 0; } diff --git a/Haskell/LargestPalindromeFromIntPairs.hs b/Haskell/LargestPalindromeFromIntPairs.hs new file mode 100644 index 0000000..20172f2 --- /dev/null +++ b/Haskell/LargestPalindromeFromIntPairs.hs @@ -0,0 +1,13 @@ + + +isPalindrome :: (Eq a) => [a] -> Bool +isPalindrome x + | mod len 2 == 0 && take (div len 2) x == reverse (drop (div len 2) x) = True + | otherwise = False + where len = length x + +largestPalidromeOfSize :: Int -> Int +largestPalidromeOfSize n = foldr max 0 . map (uncurry (*)) . filter (isPalindrome . show . uncurry (*)) $ [ (x,y) | x <- [s,s-1..t], y <- [s,s-1..t] ] + where s = (10 ^ n) - 1 + t = s `quot` 2 + diff --git a/Haskell/Lockers.hs b/Haskell/Lockers.hs new file mode 100644 index 0000000..d4b6cb1 --- /dev/null +++ b/Haskell/Lockers.hs @@ -0,0 +1,23 @@ +import Data.Foldable +import qualified Data.Map.Lazy as Map + +type Lockers = Map.Map Int Bool + +makeLockers :: Int -> Lockers +makeLockers n = Map.fromList $ zip [1..n] $ replicate n False + +changeLockersState :: Int -> Lockers -> Lockers +changeLockersState n l = foldr' (Map.adjust not) l modNList + where modNList = [ n * m | m <- take (Map.size l `quot` n) [1..] ] + +runLockers :: Lockers -> Lockers +runLockers l = foldr' changeLockersState l [1..Map.size l] + +main :: IO () +main = do + putStrLn "Enter how many lockers: " + n <- fmap read getLine :: IO Int + let lockers = runLockers $ makeLockers n + + putStrLn $ "The following lockers remained open after " ++ show n ++ " iterations: " + print (Map.keys $ Map.filterWithKey (flip const) lockers) diff --git a/Haskell/ProjectEuler.hs b/Haskell/ProjectEuler.hs new file mode 100644 index 0000000..a4478c9 --- /dev/null +++ b/Haskell/ProjectEuler.hs @@ -0,0 +1,193 @@ +-- (C) Copyright Collin Doering 2014 +-- +-- 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 . + +-- File: ProjectEuler.hs +-- Author: Collin J. Doering +-- Date: May 18, 2014 + +----------------------------------------------------------------------------------------------- +-- Problem 4: Largest palindrome product -- +----------------------------------------------------------------------------------------------- +isPalindrome :: (Eq a) => [a] -> Bool +isPalindrome x + | mod len 2 == 0 && take (div len 2) x == reverse (drop (div len 2) x) = True + | otherwise = False + where len = length x + +largestPalidromeOfSize :: Int -> Int +largestPalidromeOfSize n = foldr max 0 . map (uncurry (*)) . filter (isPalindrome . show . uncurry (*)) $ [ (x,y) | x <- [s,s-1..t], y <- [s,s-1..t] ] + where s = (10 ^ n) - 1 + t = s `quot` 2 +----------------------------------------------------------------------------------------------- + +----------------------------------------------------------------------------------------------- +-- Problem 5: Smallest multiple -- +----------------------------------------------------------------------------------------------- +----------------------------------------------------------------------------------------------- + +----------------------------------------------------------------------------------------------- +-- Problem 7: 10001 prime -- +----------------------------------------------------------------------------------------------- +isPrime :: Integral b => b -> Bool +isPrime n = all (not . (== 0) . (n `mod`)) [2..quot n 2] + +nthPrime :: Integral a => Int -> a +nthPrime n = [ x | x <- [2..], isPrime x] !! n +----------------------------------------------------------------------------------------------- + +----------------------------------------------------------------------------------------------- +-- Problem 8: Largest product in a series -- +----------------------------------------------------------------------------------------------- +p8Series :: Integer +p8Series = read . concat $ + [ "73167176531330624919225119674426574742355349194934" + , "96983520312774506326239578318016984801869478851843" + , "85861560789112949495459501737958331952853208805511" + , "12540698747158523863050715693290963295227443043557" + , "66896648950445244523161731856403098711121722383113" + , "62229893423380308135336276614282806444486645238749" + , "30358907296290491560440772390713810515859307960866" + , "70172427121883998797908792274921901699720888093776" + , "65727333001053367881220235421809751254540594752243" + , "52584907711670556013604839586446706324415722155397" + , "53697817977846174064955149290862569321978468622482" + , "83972241375657056057490261407972968652414535100474" + , "82166370484403199890008895243450658541227588666881" + , "16427171479924442928230863465674813919123162824586" + , "17866458359124566529476545682848912883142607690042" + , "24219022671055626321111109370544217506941658960408" + , "07198403850962455444362981230987879927244284909188" + , "84580156166097919133875499200524063689912560717606" + , "05886116467109405077541002256983155200055935729725" + , "71636269561882670428252483600823257530420752963450" ] + + +largestProduct :: Integer -> Integer +largestProduct n = foldr max 0 . flip fiveProducts [] $ [ read [x] | x <- show n] + +fiveProducts :: Num a => [a] -> [a] -> [a] +fiveProducts [] acc = acc +fiveProducts (a:b:c:d:e:f:g:h:i:j:k:l:m:xs) acc = fiveProducts (b:c:d:e:f:g:h:i:j:k:l:m:xs) (a * b * c * d * e * f * g * h * i * j * k * l * m : acc) +fiveProducts _ acc = acc +----------------------------------------------------------------------------------------------- + +----------------------------------------------------------------------------------------------- +-- Problem 13: Large Sum -- +----------------------------------------------------------------------------------------------- + +numsToSum = [ 37107287533902102798797998220837590246510135740250 + , 46376937677490009712648124896970078050417018260538 + , 74324986199524741059474233309513058123726617309629 + , 91942213363574161572522430563301811072406154908250 + , 23067588207539346171171980310421047513778063246676 + , 89261670696623633820136378418383684178734361726757 + , 28112879812849979408065481931592621691275889832738 + , 44274228917432520321923589422876796487670272189318 + , 47451445736001306439091167216856844588711603153276 + , 70386486105843025439939619828917593665686757934951 + , 62176457141856560629502157223196586755079324193331 + , 64906352462741904929101432445813822663347944758178 + , 92575867718337217661963751590579239728245598838407 + , 58203565325359399008402633568948830189458628227828 + , 80181199384826282014278194139940567587151170094390 + , 35398664372827112653829987240784473053190104293586 + , 86515506006295864861532075273371959191420517255829 + , 71693888707715466499115593487603532921714970056938 + , 54370070576826684624621495650076471787294438377604 + , 53282654108756828443191190634694037855217779295145 + , 36123272525000296071075082563815656710885258350721 + , 45876576172410976447339110607218265236877223636045 + , 17423706905851860660448207621209813287860733969412 + , 81142660418086830619328460811191061556940512689692 + , 51934325451728388641918047049293215058642563049483 + , 62467221648435076201727918039944693004732956340691 + , 15732444386908125794514089057706229429197107928209 + , 55037687525678773091862540744969844508330393682126 + , 18336384825330154686196124348767681297534375946515 + , 80386287592878490201521685554828717201219257766954 + , 78182833757993103614740356856449095527097864797581 + , 16726320100436897842553539920931837441497806860984 + , 48403098129077791799088218795327364475675590848030 + , 87086987551392711854517078544161852424320693150332 + , 59959406895756536782107074926966537676326235447210 + , 69793950679652694742597709739166693763042633987085 + , 41052684708299085211399427365734116182760315001271 + , 65378607361501080857009149939512557028198746004375 + , 35829035317434717326932123578154982629742552737307 + , 94953759765105305946966067683156574377167401875275 + , 88902802571733229619176668713819931811048770190271 + , 25267680276078003013678680992525463401061632866526 + , 36270218540497705585629946580636237993140746255962 + , 24074486908231174977792365466257246923322810917141 + , 91430288197103288597806669760892938638285025333403 + , 34413065578016127815921815005561868836468420090470 + , 23053081172816430487623791969842487255036638784583 + , 11487696932154902810424020138335124462181441773470 + , 63783299490636259666498587618221225225512486764533 + , 67720186971698544312419572409913959008952310058822 + , 95548255300263520781532296796249481641953868218774 + , 76085327132285723110424803456124867697064507995236 + , 37774242535411291684276865538926205024910326572967 + , 23701913275725675285653248258265463092207058596522 + , 29798860272258331913126375147341994889534765745501 + , 18495701454879288984856827726077713721403798879715 + , 38298203783031473527721580348144513491373226651381 + , 34829543829199918180278916522431027392251122869539 + , 40957953066405232632538044100059654939159879593635 + , 29746152185502371307642255121183693803580388584903 + , 41698116222072977186158236678424689157993532961922 + , 62467957194401269043877107275048102390895523597457 + , 23189706772547915061505504953922979530901129967519 + , 86188088225875314529584099251203829009407770775672 + , 11306739708304724483816533873502340845647058077308 + , 82959174767140363198008187129011875491310547126581 + , 97623331044818386269515456334926366572897563400500 + , 42846280183517070527831839425882145521227251250327 + , 55121603546981200581762165212827652751691296897789 + , 32238195734329339946437501907836945765883352399886 + , 75506164965184775180738168837861091527357929701337 + , 62177842752192623401942399639168044983993173312731 + , 32924185707147349566916674687634660915035914677504 + , 99518671430235219628894890102423325116913619626622 + , 73267460800591547471830798392868535206946944540724 + , 76841822524674417161514036427982273348055556214818 + , 97142617910342598647204516893989422179826088076852 + , 87783646182799346313767754307809363333018982642090 + , 10848802521674670883215120185883543223812876952786 + , 71329612474782464538636993009049310363619763878039 + , 62184073572399794223406235393808339651327408011116 + , 66627891981488087797941876876144230030984490851411 + , 60661826293682836764744779239180335110989069790714 + , 85786944089552990653640447425576083659976645795096 + , 66024396409905389607120198219976047599490197230297 + , 64913982680032973156037120041377903785566085089252 + , 16730939319872750275468906903707539413042652315011 + , 94809377245048795150954100921645863754710598436791 + , 78639167021187492431995700641917969777599028300699 + , 15368713711936614952811305876380278410754449733078 + , 40789923115535562561142322423255033685442488917353 + , 44889911501440648020369068063960672322193204149535 + , 41503128880339536053299340368006977710650566631954 + , 81234880673210146739058568557934581403627822703280 + , 82616570773948327592232845941706525094512325230608 + , 22918802058777319719839450180888072429661980811197 + , 77158542502016545090413245809786882778948721859617 + , 72107838435069186155435662884062257473692284509516 + , 20849603980134001723930671666823555245252804609722 + , 53503534226472524250874054075591789781264330331690 ] + +first10DigitsOfSum :: [Integer] -> Integer +first10DigitsOfSum = read . take 10 . show . sum +----------------------------------------------------------------------------------------------- diff --git a/Racket/DFA.rkt b/Racket/DFA.rkt new file mode 100644 index 0000000..082dd15 --- /dev/null +++ b/Racket/DFA.rkt @@ -0,0 +1,114 @@ +#lang racket + +;; (C) Copyright Collin J. Doering 2014 +;; +;; 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 . + +;; File: DFA.rkt +;; Author: Collin J. Doering +;; Date: Aug 27, 2014 +;; Description: an implementation of Determinalistic Finite Autamata + +(require (for-syntax syntax/parse)) + +;; Some structures to represent a DFA +(struct dfaState (trans)) +(struct dfaEndState dfaState ()) +(struct dfaStartState dfaState ()) +(struct dfaStartEndState dfaState ()) + +(struct dfa (alpha start states)) + +(define (compute-dfa m xs) + (define/match (run-dfa state ys) + [((or (dfaEndState _) + (dfaStartEndState _)) '()) 'accept] + [(_ '()) 'reject] + [((dfaState f) (cons z zs)) (run-dfa (f z) zs)]) + (run-dfa (dfa-start m) xs)) + +(define-syntax (define-dfa stx) + (define-syntax-class transition + #:description "dfa state transition" + (pattern (in (~optional ->) out:id))) + + (define-syntax-class state + #:description "dfa state" + (pattern (name:id (~optional (~seq (~and #:end end?))) trans:transition ...+) + #:with (in ...) #'(trans.in ...) + #:with (out ...) #'(trans.out ...))) + ;; (pattern (name:id (~seq (~and #:end end2?)) (~optional (~and #:end end?)))) + + (syntax-parse stx + [(_ name:id alpha:expr start:state rests:state ...) + #:fail-when (check-duplicate-identifier + (syntax->list + #'(start.name rests.name ...))) + "duplicate state names" + #'(define name + (letrec ([start.name + (dfaStartState + (match-lambda [start.in start.out] ...))] + [rests.name + (dfaState + (match-lambda [rests.in rests.out] ...))] ...) + (dfa 'alpha start.name '(start.name rests.name ...))))])) + +;; ---------------------------------------------------------------------------- + +(define-dfa odd-binary (0 1) + [s0 (0 -> s0) + (1 -> s1)] + [s1 (0 -> s0) + (1 -> s1)] + [s2 #:end + (0 -> s2) + (1 -> s1)] + [s3 #:dead (0 -> s3) (1 -> s3)]) + +;; Odd binary dfa expansion +(define odd-dfa + (letrec ([s0 (dfaStartState (match-lambda [0 s0] + [1 s1]))] + [s1 (dfaEndState (match-lambda [0 s0] + [1 s1]))]) + (dfa '(0 1) s0 '(s0 s1)))) + +;; Even binary dfa expansion +(define even-dfa + (letrec ([s0 (dfaStartState (match-lambda [0 s0] + [1 s1]))] + [s1 (dfaState (match-lambda [0 s2] + [1 s1]))] + [s2 (dfaEndState (match-lambda [0 s0] + [1 s1]))]) + (dfa '(0 1) s0 '(s0 s1 s2)))) + +;; Odd binary dfa macro +;; (define-dfa odd-dfa (0 1) +;; [s0 (0 -> s0) +;; (1 -> s1)] +;; [s1 end +;; (0 -> s0) +;; (1 -> s1)]) + +;; ;; Even binary dfa macro +;; (define-dfa even-dfa (0 1) +;; [s0 (0 -> s0) +;; (1 -> s1)] +;; [s1 (0 -> s2) +;; (1 -> s1)] +;; [s2 end +;; (0 -> s0) +;; (1 -> s1)]) diff --git a/Racket/avl-tree.rkt b/Racket/avl-tree.rkt new file mode 100644 index 0000000..491ae1c --- /dev/null +++ b/Racket/avl-tree.rkt @@ -0,0 +1,141 @@ +#lang racket + +;; (C) Copyright Collin J. Doering 2014 +;; +;; 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 . + +;; File: avl-tree.rkt +;; Author: Collin J. Doering +;; Date: Sep 2, 2014 + +(require "comparable.rkt") + +;; Structure representing a Binary Search Tree +(struct bst ()) +(struct bst-empty bst () #:transparent) +(struct bst-node bst (val left right) #:transparent) + +;; Make a leaf in a binary tree +(define (bst-make-leaf i) + (bst-node i (bst-empty) (bst-empty))) + +;; ---------------------------------------------------------------------- + +;; First a naive approach to binary search trees +;; Specifically these functions do not maintain any balance +;; of the bst and thus are inefficient in many cases + +;; Naive bst insert (not balanced) +(define/match (bst-insert-naive t i) + [((bst-empty) _) (bst-node i (bst-empty) (bst-empty))] + [((bst-node v (bst-empty) (bst-empty)) _) + (if (gte i v) + (bst-node v (bst-empty) (bst-make-leaf i)) + (bst-node v (bst-make-leaf i) (bst-empty)))] + [((bst-node v l r) _) #:when (gte i v) + (bst-node v l (bst-insert-naive r i))] + [((bst-node v l r) _) #:when (lt i v) + (bst-node v (bst-insert-naive l i) l)]) + +;; Naive bst delete (not balanced) +;; (define (bst-delete-naive t i) +;; (match t +;; [(bst-empty) t] +;; [(bst-node v l r) #:when (> i v) +;; (bst-node v l (bst-delete-naive r i))] +;; [(bst-node v l r) #:when (lt i v) +;; (bst-node v (bst-delete-naive l i) r)] +;; [(bst-node v l r) #:when (= i v) +;; (match* (l r) +;; [((bst-empty) (bst-empty)) (bst-empty)] +;; [((bst-node v1 l1 r1) (bst-empty)) ???] +;; [((bst-empty) (bst-node v1 l1 r1)) ???] +;; [((bst-node v1 l1 r1) (bst-node v2 l2 r2)) ???])])) + +;; ---------------------------------------------------------------------- + +;; Below is a more effiecient implementation of BST's; specifically using +;; the AVL binary seach tree algorithm. +;; See: https://en.wikipedia.org/wiki/AVL_tree + +;; Calculate AVL score for a particular node +(define/match (avl-score t) + [((bst-empty)) 0] + [((bst-node v l r)) (- (bst-height l) (bst-height r))]) + +;; Rotate a bst +(define/match (bst-rotate dir t) + [((quote left-right) _) (bst-rotate 'left (bst-rotate 'right t))] + [((quote right-left) _) (bst-rotate 'right (bst-rotate 'left t))] + [((quote left) (bst-node v1 l1 (bst-node v2 l2 r2))) + (bst-node v2 (bst-node v1 l1 l2) r2)] + [((quote right) (bst-node v1 (bst-node v2 l2 r2) r1)) + (bst-node v2 l2 (bst-node v1 r2 r1))]) + +;; Balance AVL binary tree +(define (avl-balance t) + (let ([score (avl-score t)]) + (match t + [(bst-node v l r) #:when (= score 2) + (cond [(< (avl-score l) 0) (bst-rotate 'right-left t)] + [else (bst-rotate 'right t)])] + [(bst-node v l r) #:when (= score -2) + (cond [(> (avl-score r) 0) (bst-rotate 'left-right t)] + [else (bst-rotate 'left t)])] + [_ t]))) + +;; Insert into AVL binary tree +(define (bst-insert t i) + (match t + [(bst-empty) (bst-make-leaf i)] + [(bst-node v l r) #:when (eql i v) t] + [(bst-node v l r) #:when (gte i v) + (let* ([r-not (bst-insert r i)] + [rt (bst-node v l r-not)]) + (avl-balance rt))] + [(bst-node v l r) #:when (lt i v) + (let* ([l-not (bst-insert l i)] + [rt (bst-node v l-not r)]) + (avl-balance rt))])) + +;; Delete item from AVL binary tree +(define (bst-delete t i) + 'undefined) + +(define (bst-search t i) + (match t + [(bst-empty) #f] + [(bst-node v _ _) #:when (eql i v) #t] + [(bst-node v _ r) #:when (gt i v) (bst-search r i)] + [(bst-node v l _) #:when (lt i v) (bst-search l i)])) + +(define (bst-flatten t) + (match t + [(bst-empty) '()] + [(bst-node v l r) `(,@(bst-flatten l) ,v ,@(bst-flatten r))])) + +(define (bst-height t) + (match t + [(bst-empty) 0] + [(bst-node _ l (bst-empty)) (+ 1 (bst-height l))] + [(bst-node _ (bst-empty) r) (+ 1 (bst-height r))] + [(bst-node _ l r) (+ 1 (max (bst-height l) (bst-height r)))])) + +(define (list->bst xs) + (foldr (lambda (x acc) + (bst-insert acc x)) + (bst-empty) xs)) + +(define (bst-sort xs) + (bst-flatten (list->bst xs))) diff --git a/Racket/comparable.rkt b/Racket/comparable.rkt new file mode 100644 index 0000000..38a7281 --- /dev/null +++ b/Racket/comparable.rkt @@ -0,0 +1,46 @@ +#lang racket + +;; (C) Copyright Collin J. Doering 2014 +;; +;; 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 . + +;; File: comparable.rkt +;; Author: Collin J. Doering +;; Date: Sep 11, 2014 + +(require racket/generic) + +;; (provide (contract-out +;; [bst-make-leaf (-> any bst-node?)] +;; [bst-insert (-> bst-node? any)])) + +;; Define a generic interface for orderable things (thatis things that can be sorted) +(define-generics orderable + [lt orderable other] + [lte orderable other] + [gt orderable other] + [gte orderable other] + [eql orderable other] + #:defaults ([number? + (define lt <) + (define lte <=) + (define gt >) + (define gte >=) + (define eql =)] + [string? + (define lt string-ci?) + (define gte string-ci>=?) + (define eql equal?)])) diff --git a/Racket/macros.rkt b/Racket/macros.rkt new file mode 100644 index 0000000..2a2c55f --- /dev/null +++ b/Racket/macros.rkt @@ -0,0 +1,44 @@ +#lang racket + +;; (C) Copyright Collin J. Doering 2014 +;; +;; 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 . + +;; File: macros.rkt +;; Author: Collin J. Doering +;; Date: Aug 28, 2014 +;; Description: various implementions of macros for learning purposes + +(require (for-syntax syntax/parse)) + +(define-syntax my-while + (syntax-rules () + [(my-while n body ...) + (if (and (integer? n) (>= n 0)) + (letrec ([f (lambda () body ...)] + [g (lambda (i) + (cond [(= i 0) (f)] + [else (begin + (f) + (g (- i 1)))]))]) + (g n)) + (error"Must be a positive integer"))])) + +(define-syntax mylet + (syntax-rules () + [(mylet ([var rhs] ...) body ...) ((lambda (var ...) body ...) rhs ...)])) + +(define-syntax (mylet2 stx) + (syntax-parse stx + [(_ ((var:id rhs:expr) ...) body ...+) #'((lambda (var ...) body ...) rhs ...)])) diff --git a/Racket/rdm.rkt b/Racket/rdm.rkt index 818c0e3..952b8f0 100644 --- a/Racket/rdm.rkt +++ b/Racket/rdm.rkt @@ -17,6 +17,13 @@ (factorial-helper n 1) (error "Expects argument to be an integer!"))) +;; factorial function written using pattern matching +(define (factorial1 n) + (define/match (fac i acc) + [(0 _) acc] + [(n _) (fac (- n 1) (* n acc))]) + (fac n 1)) + (define factorial! (letrec ([fact-helper (lambda (n acc) (if (<= n 1) acc (fact-helper (- n 1) (* acc n))))] @@ -146,6 +153,12 @@ [else (interval-helper (+ i 1) j (cons i acc))])) (reverse (interval-helper i j empty))) +(define (repeat f n) + (define (rep i acc) + (cond [(<= i 0) acc] + [else (rep (- i 1) (cons (f) acc))])) + (rep n '())) + ;; common poduct interval (define (cp-interval i j m) (map (lambda (x) (if (= x 0) x (* m x))) (interval i j))) @@ -247,21 +260,11 @@ (let ([f (/ n (expt 10 (+ i 1)))]) (floor (* 10 (- f (floor f)))))) -(define (merge xs ys) - (cond [(and (empty? xs) (empty? ys)) empty] - [(empty? xs) ys] - [(empty? ys) xs] - [(< (first xs) (first ys)) (cons (first xs) (merge (rest xs) ys))] - [(equal? (first xs) (first ys)) - (cons (first xs) (cons (first ys) (merge (rest xs) (rest ys))))] - [else (cons (first ys) (merge xs (rest ys)))])) - - -(define (merge-sort xs) - (cond [(empty? xs) empty] - [(empty? (rest xs)) xs] - [else (merge (merge-sort (take xs (quotient (length xs) 2))) - (merge-sort (drop xs (quotient (length xs) 2))))])) +(define (random-list n) + (define (randlst i acc) + (cond [(<= i 0) acc] + [else (randlst (sub1 i) (cons (random n) acc))])) + (randlst n '())) (define (append-all a b) (cond [(and (list? a) (list? b)) (append a b)] @@ -295,3 +298,24 @@ (my-flatten2-h (rest xs) (append (my-flatten2-h (first xs) '()) acc))] [else (my-flatten2-h (rest xs) (cons (first xs) acc))])) (reverse (my-flatten2-h xs '()))) + +(define (rpn-calc xs) + (define (symbol->operator s) + (cond [(eq? s '+) +] + [(eq? s '-) -] + [(eq? s '*) *] + [(eq? s '/) /])) + (define (symbol-urinary-op? s) + (cond [(eq? s '!) #t] + [else #f])) + (define (symbol-urinary->op s) + (cond [(eq? s '!) (lambda (n) (foldr * 1 (if (>= n 0) (range 1 (+ n 1)) (range n 0))))])) + (define/match (rpn ys acc) + [('() (cons a '())) a] + [('() _) (error "Not a valid RPN expression")] + [((cons y ys) acc) #:when (number? y) (rpn ys (cons y acc))] + [((cons y ys) (cons a acc)) #:when (symbol-urinary-op? y) + (rpn ys (cons ((symbol-urinary->op y) a) acc))] + [((cons y ys) (cons a1 (cons a2 acc))) #:when (symbol? y) + (rpn ys (cons ((symbol->operator y) a2 a1) acc))]) + (rpn xs '())) diff --git a/Racket/simple-searches.rkt b/Racket/simple-searches.rkt new file mode 100644 index 0000000..f1b3994 --- /dev/null +++ b/Racket/simple-searches.rkt @@ -0,0 +1,26 @@ +#lang racket + +;; (C) Copyright Collin J. Doering 2014 +;; +;; 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 . + +;; File: simple-searches.rkt +;; Author: Collin J. Doering +;; Date: Sep 11, 2014 + +(define (list-search-naive x ys) + (match ys + ['() #f] + [(cons a bs) #:when (equal? x a) #t] + [(cons _ bs) (list-search-naive x bs)])) diff --git a/Racket/simple-sorts.rkt b/Racket/simple-sorts.rkt new file mode 100644 index 0000000..61b3239 --- /dev/null +++ b/Racket/simple-sorts.rkt @@ -0,0 +1,64 @@ +#lang racket + +;; (C) Copyright Collin J. Doering 2014 +;; +;; 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 . + +;; File: simple-sorts.rkt +;; Author: Collin J. Doering +;; Date: Sep 11, 2014 + +;; Insert a element into a sorted list +(define (insert i lst) + (cond [(empty? lst) (list i)] + [(>= i (first lst)) (cons (first lst) (insert i (rest lst)))] + [(< i (first lst)) (cons i lst)])) + +;; Implementation of insertion sort +(define (insert-sort lst) + (define (isort xs acc) + (cond [(empty? xs) acc] + [else (isort (rest xs) (insert (first xs) acc))])) + (isort lst '())) + +;; Implementation of selection sort using immutable data +(define (selection-sort xs) + (define (selsort xs acc) + (cond [(empty? xs) acc] + [else (selsort (remove (apply min xs) xs) (cons (apply min xs) acc))])) + (reverse (selsort xs '()))) + +;; Merge two lists such that order is maintained +(define (merge xs ys) + (cond [(empty? xs) ys] + [(empty? ys) xs] + [(< (first xs) (first ys)) (cons (first xs) (merge (rest xs) ys))] + [(equal? (first xs) (first ys)) + (cons (first xs) (cons (first ys) (merge (rest xs) (rest ys))))] + [else (cons (first ys) (merge xs (rest ys)))])) + +;; The merge function re-written using pattern matching instead of cond +(define/match (merge as bs) + [('() _) bs] + [(_ '()) as] + [((cons x xs) (cons y _)) #:when (< x y) (cons x (merge xs bs))] + [((cons x xs) (cons y ys)) #:when (= x y) (cons x (cons y (merge xs ys)))] + [((cons x _) (cons y ys)) #:when (> x y) (cons y (merge as ys))]) + +;; Implementation of merge sort +(define (merge-sort xs) + (cond [(empty? xs) empty] + [(empty? (rest xs)) xs] + [else (merge (merge-sort (take xs (quotient (length xs) 2))) + (merge-sort (drop xs (quotient (length xs) 2))))])) diff --git a/Shell/rdm.sh b/Shell/rdm.sh new file mode 100644 index 0000000..ebe9c68 --- /dev/null +++ b/Shell/rdm.sh @@ -0,0 +1,23 @@ +#!/bin/sh + +# (C) Copyright Collin J. Doering 2014 +# +# 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 . + +# File: rdm.sh +# Author: Collin J. Doering +# Date: Jun 5, 2014 + +# odd numbers in sed +sed -n '=; n'