IP2012_JonasRudloff.sml

load "String";
load "Char";
load "Math";
load "List";
load "Listsort";
load "TextIO";
load "Int";

(* Opg 1 *)
(* a *)
(* checker om en string er densamme som dens omvendte *)
fun erPalindrom s = explode s = (rev o explode) s;

(* b *)
(* samme som a, men fjerner først blanktegn, symboler, og laver store bogstaver
 * om til små *)
val erUdvidetPalindrom =
  erPalindrom o
  (String.translate 
  (fn c => 
    if Char.isSpace(c) orelse Char.isPunct(c) then
      "" 
    else 
      str(Char.toLower(c))));


(* Opg 2 *)
datatype rute = Stop | Frem of int * rute | Drej of int * rute;
  
(* a *)
(* checker om alle d værdier i Frem er ikke-negative. *)
fun korrekt (Stop) = true
  | korrekt (Frem(d, r)) = 0 <= d andalso korrekt r
  | korrekt (Drej(_, r)) = korrekt r;

(* b *)
(* summen af d værdier *)
fun laengde (Stop) = 0
  | laengde (Frem(d, r)) = d + laengde r
  | laengde (Drej(_, r)) = laengde r;

(* c *)
(* følger opskriften i eksamenssættet *)
fun erNormaliseret (Stop) = true
  | erNormaliseret (Frem(0, r)) = false
  | erNormaliseret (Drej(0, r)) = false
  | erNormaliseret (Frem(_, Frem _)) = false
  | erNormaliseret (Drej(_, Drej _)) = false
  | erNormaliseret (Frem(_, r)) = erNormaliseret r
  | erNormaliseret (Drej(g, r)) = 
    if ~180 < g andalso g <= 180 then erNormaliseret r else false;

(* d *)
fun normaliserRute' (Stop) = Stop
  | normaliserRute' (Frem(0,r)) = normaliserRute' r
  | normaliserRute' (Drej(0,r)) = normaliserRute' r
  (* i de to næste cases er det lisd vigtigt at normaliser det sammesatte 
   * element i stedet for r *)
  | normaliserRute' (Frem(d1, Frem(d2, r))) = normaliserRute'(Frem(d1+d2, r))
  | normaliserRute' (Drej(g1, Drej(g2, r))) = normaliserRute'(Drej(g1+g2, r))
  (* normalisere vinkler, burde virke *)
  | normaliserRute' (Drej(g, r)) =
    let
      val v = g mod 360
      val g' = if v > 180 then v-360 else v
    in
      if g' = 0 then
        normaliserRute' r
      else
        Drej(g', normaliserRute' r)
    end
  | normaliserRute' (Frem(d, r)) = Frem(d, normaliserRute' r);

(* ting som f.eks rute = Frem(5, Drej(0, Frem(5, Stop))) er svært at normalisere
 * normaliserRute' rute vil give Frem(5, Frem(5, Stop)) hvilket ikke er 
 * normaliseret, derfor køre normaliserRute normaliserRute' indtil at ruten er
 * fuldstændig normaliseret *)
fun normaliserRute rute = 
  if erNormaliseret rute then
    rute
  else
    (normaliserRute o normaliserRute') rute;
    

(* Opg 3 *)

(* finder 1 primtal faktor *)
fun factor'' n a =
  if a*a > n then n else
  if n mod a = 0 then a else factor'' n (a+1);

(* finder alle primtals faktorer 
 * eg. factor 25 = [5,5] *)    
fun factor' 1 q = []
  | factor' n q = 
    let
      val p = factor'' n q
    in
      p::factor' (n div p) p
    end;

fun factor n = factor' n 2
   
(* funktioner til mængder(fra gruppeaflevering 7/HR), 
 * vil også blive brugt senere *)
fun member (a, x::xs) = a=x orelse member(a, xs)
  | member (a, []) = false;
fun insert (a, xs) = if member (a, xs) then xs else a::xs;
fun remove (a, x::xs) = if a=x then xs else x::remove(a,xs)
  | remove (a, []) = raise Domain;  
fun count (a, []) = 0
  | count (a, x::xs) = if a=x then 1+count(a,xs) else count(a,xs);
fun unique xs = foldl insert [] xs;

(* a *)
(* checker om antallet af unikke primtalsfaktorer er det samme som 
 * antallet af primtalsfaktorer *)
val kvadratfrit = (fn l => (length o unique) l = length l) o factor;

(* b *)
(* 
kvadratfrit 21 ~>
  factors = factor 21 ~> ... = [3,7]
  length(unique(factors)) = length(factors)
  length([3,7]) = length([3,7])
  true!
  
kvadratfrit 54 ~>
  factors = factor 54 ~> ... = [2,3,3]
  length(unique(factors)) = length(factors)
  length([2,3]) = length([2,3,3])
  false!
*)

(* c *)
(* produktet af unikke primtalsfaktorer *)
val maksKvadratfrit = (foldl op* 1) o unique o factor;

(* Opg 4 *)
(* a *)
(* det er ikke muligt at bruge Listsort.sort her, fordi *.compare funktionerne
 * er type specifikke. derfor fjerner jeg det alle elementer i xs fra ys *)
fun erPermutationAf ([],[]) = true
  | erPermutationAf ([], _) = false
  | erPermutationAf (x::xs, ys) = 
  (erPermutationAf(xs, remove(x,ys))) handle Domain => false;

(* fakultets funktion, fact n = n! *)
fun fact 1 = 1 | fact n = n*fact(n-1);

(* b *)
(* som eksamenssættet foreskriver *)
fun antalPermutationer xs =
    fact(length xs) div foldl (fn (e,a) => fact(count(e, xs))*a) 1 (unique xs);

(* største fælles divisor/greatest common divisor 
 * fra HR. *)
fun gcd(a, 0) = a | gcd(a, b) = gcd(b, a mod b);

(* forkorter faktorene i xs med d. nb. rest er ikke nødvendig, da den altid vil
 * være 1 i vores tilfælde *)
fun forkort (d, []) = []
  | forkort (d, (x::xs)) = 
    let
      val g = gcd(x, d)
    in
      (x div g)::(forkort(d div g,xs))
    end;

(* a upto b = [a,a+1,...,b-1,b] 
 * oprindeligt fra HR, tror jeg, men skrev den udfra min hukommelse *)
infix upto; fun a upto b = if a<=b then a::(a+1 upto b) else [];

(* c *)
(* forkorter tælleren med nævneren, før produktet tages. nævneren vil altid 
 * blive 1, tilsidst, derfor er resten ved forkort ikke relevant *)
fun antalPermutationerNy xs = 
  (foldl op* 1 o
    (foldl forkort (1 upto (length xs)) o
      (List.concat o (map (fn e => 1 upto count(e, xs))) o unique))) xs;


(* opg 5 *)
(* a *)
(* opdeler en liste i grupper alt efter retur værdien af f *)
fun grupper f =
    foldl (fn (a, ls) => 
      let 
        (* xs vil aldrig værer tom -> hd vil aldrig kaste Empty,
         * alternativet var pattern match warning *)
        val (m, r) = List.partition (fn xs => f(a)=f(hd xs)) ls 
      in
        (* hd kaster Empty, når en ny grupper er fundet, handler til en [] *)
        (a::(hd m handle Empty => []))::r 
      end) [];

(* b *)
(* køre indtil f x fejler, og retunere så sidste f x værdi *)
fun gentag f x = (gentag f (f x)) handle _ => x;

(* c *)
(* gcd skrevet med gentag, kaster Div når m er 0, retunere n *)
val gcd = (#2) o gentag (fn (m,n) => (n mod m,m));


(* opg 6 *)
datatype 'a trae = K of 'a * ('a trae list);

(* a *)
(* fint træ *)
val t7 = K(3,[K(4,[K(7,[]),K(1,[]),K(5,[K(6,[]),K(7,[])])])]);

(* b *)
(* gennemløber træet og retunere en liste med knude værdierne *)
fun praeorden (K(a, ts)) = a::List.concat(map praeorden ts);

(* c *)
(* træer i denne opgave har en list med grene, derfor er det ikke muligt at gøre
 * således: K(a, gren1, gren2)
 * val (gren1', xs1') = erstat gren1 xs;
 * val (gren2', xs2') = erstat gren2 xs1';
 * (K(x, gren1', gren2'), xs2')
 * men istedet er det nødvendigt at bruge en foldning, over listen af grene *)
fun erstat t [] = (t, [])
  | erstat (K(_, ts)) (x::xs) = 
    let 
      val (ts', xs') = foldl (fn (t, (ts, xs)) => 
        let 
          val (t', xs') = erstat t xs
        in
          (ts@[t'], xs')
        end) ([], xs) ts
    in
      (K(x, ts'), xs')
    end;

(* d *)
(* træ -> liste -> sorteret liste -> træ *)
fun sorter t = #1 (erstat t (Listsort.sort Int.compare (praeorden t)));


(* opg 7 *)
(* læser fra den åbne fil fp, intil p er sand. retunere en liste med læste chars
 *)
fun readuntil p fp = 
  let 
    val c = valOf(TextIO.input1 fp)
  in
    if p(c) then [] else c::readuntil p fp
  end;

(* læser et hoved felt fra en åben ppm fil, men ignorer kommentare (# ... \n) *)
fun readhdrfield fp =
  let
    val f = valOf(TextIO.input1 fp)
  in
    if f = #"#" then
      (readuntil (fn c => c = #"\n") fp; readhdrfield fp)
    else
      implode (f::readuntil Char.isSpace fp)
  end;
  
(* læser P6 H W 255 + div kommentare, men ignorere dem *)
fun readppm fp =
  let
    val magic = readhdrfield fp
    val w = valOf(Int.fromString(readhdrfield fp))
    val h = valOf(Int.fromString(readhdrfield fp))
    val tofemfem = readhdrfield fp
  in
    (w, h)
  end;

(* skriver P6 H W 255 *)
fun writeppm (w,h) fp = (
  TextIO.output(fp, "P6\n"); 
  TextIO.output(fp, "# Image generated by Awesome ppm Color Inverter, made by Jonas Rudloff\n");
  TextIO.output(fp, Int.toString(w)^"\n");
  TextIO.output(fp, Int.toString(h)^"\n");
  TextIO.output(fp, "255\n"));

(* ifp -> f -> ofp, mapper fra ifp til ofp over f *)
fun filemap f ifp ofp =
    case TextIO.input1(ifp) of
        NONE => ()
      | SOME ch => (TextIO.output1(ofp, f(ch)); filemap f ifp ofp) 

(* invertere ifp og gemmer i ofp *)
fun inverterPPM' ifp ofp =
  let
    val (w, h) = readppm ifp
  in
    (writeppm (w,h) ofp;
    filemap (fn x => chr(255-ord x)) ifp ofp)
  end;
  
(* åbner 2 filer og giver til inverterPPM' *)
fun inverterPPM infile outfile = 
  inverterPPM' (TextIO.openIn infile) (TextIO.openOut outfile);


(* opg 8 *)
(* signatur copypastet fra eksamenssættet *)
signature SYMBOLTABEL =
  sig
    type 'vaerdi tabel
    val tom : 'vaerdi tabel
    val indsaet : 'vaerdi tabel -> (string * 'vaerdi) -> 'vaerdi tabel
    val find : 'vaerdi tabel -> string -> 'vaerdi option
  end;

(* a *)
(* relativ doven implementation af SYMBOLTABEL: overskriver ikke 
 * nøjle-værdi-par, tilføjer kun nye, som vil blive fundet før gamle
 * pros: fuld indsættelses historie
 * cons: lineært hukommelesesforbrug og max. søgetid, ifht. antallet af 
 * indsæt *)
structure ListeTabel :> SYMBOLTABEL =
  struct
    type 'vaerdi tabel = (string*'vaerdi) list;
    val tom = [];
    fun indsaet t item = item::t;
    fun find [] s = NONE
      | find ((key,value)::xs) s = 
        if key = s then 
          SOME value 
        else
          find xs s;
  end;

(* b *)
(* implementatione af SYMBOLTABEL, som bruger funktioner som tabeller. 
 * pros: awesome kode
 * cons: samme som ListeTabel *)
structure FunTabel :> SYMBOLTABEL =
  struct
    type 'vaerdi tabel = string -> 'vaerdi option;
    fun tom _ = NONE;
    fun indsaet t (key, value) s = if s = key then SOME value else t s;
    fun find t = t;
  end;
  
(* Tests(de fleste copypastet fra eksamensættet): *)
val rute_1 = Frem(1, Drej(90, Frem(5, Stop)));
val rute_2 = Frem(~1, Drej(90, Frem(5, Stop)));
val rute_3 = Frem(1, Frem(0, Stop));
val rute_4 = Frem(1, Frem(8, Frem(8, Drej(~600, 
  Drej(~20, Frem(0, Frem(9, Stop)))))));
val rute_5 = Frem(5, Drej(0, Frem(5, Stop)));
  
val test_0 = erPalindrom "pip";
val test_1 = erPalindrom "regninger mellem regninger";
val test_2 = erPalindrom "ikke et palindrom" = false;
val test_3 = erUdvidetPalindrom "A Toyota";
val test_4 = erUdvidetPalindrom "A man, a plan, a canal: Panama!";
val test_5 = erUdvidetPalindrom "ikke et udvidet palindrom" = false;
val test_6 = korrekt rute_1;
val test_7 = korrekt rute_2 = false;
val test_9 = erNormaliseret rute_1;
val test_8 = erNormaliseret rute_3 = false;
val test_10 = normaliserRute rute_4 = Frem(17, Drej(100, Frem(9, Stop)));
val test_11 = normaliserRute rute_5 = Frem(10, Stop);
val test_12 = kvadratfrit 21;
val test_13 = kvadratfrit 54 = false;
val test_14 = kvadratfrit 999999937;
val test_15 = maksKvadratfrit 21 = 21;
val test_16 = maksKvadratfrit 54 = 6;
val test_17 = maksKvadratfrit 999999937 = 999999937;
val test_18 = erPermutationAf([3, 7, 4, 7], [7, 7, 3, 4]);
val test_19 = antalPermutationer [42,42,42,42] = 1;
val test_20 = antalPermutationer [true,true,false,false] = 6;
val test_21 = antalPermutationerNy [42,42,42,42] = 1;
val test_22 = antalPermutationerNy [true,true,false,false] = 6;
val test_23 = antalPermutationerNy
  [2,2,2,2,2,2,2,2,3,5,5,5,7,7,7,7,7,7,7,7,7] = 581981400;
val test_24 = grupper (fn n=> n mod 3) 
  [1,2,3,4,5,6,7,8,9,10] = [[10,7,4,1],[9,6,3],[8,5,2]];
(* pattern match warning er forventet, og Match hånteres af gentag. *)
val test_25 = gentag (fn (x::xs,ys) => (xs,x::ys)) ([3,2,1],[]) = ([],[1,2,3]);
val test_26 = praeorden t7 = [3,4,7,1,5,6,7];
val test_27 = erstat t7 
  [1,2,3,4,5,6,7] = (K(1,[K(2,[K(3,[]),K(4,[]),K(5,[K(6,[]),K(7,[])])])]),[]);
val test_28 = praeorden (sorter t7) = [1,3,4,5,6,7,7];
(* val test_29 = inverterPPM "rgb.ppm" "rgb2.ppm"; *)
(* val test_30 = inverterPPM "kort.ppm" "kort2.ppm"; *)