99 Prolog problems :: solutions 1.01 - 1.28

gistfile1.prolog

% problem 1.01
my_last(X, [X]).
my_last(X, [_|TL]) :- my_last(X, TL).

% problem 1.02
last_but_one(X, [X, _]).
last_but_one(X, [_,Y|TL]) :- last_but_one(X, [Y|TL]).

% problem 1.03
element_at(X, [X|_], 1).
element_at(X, [_|TL], N) :-
    U is N - 1, element_at(X, TL, U).

% problem 1.04
my_count(0, []).
my_count(N, [_|TL]) :- my_count(U, TL), N is U + 1.

% problem 1.05
my_reverse(XS, [], XS).
my_reverse(XS, [Y|YS], ACC) :- my_reverse(XS, YS, [Y|ACC]).
my_reverse(XS, YS) :- my_reverse(XS, YS, []).

% problem 1.06
is_palindrome(XS) :- reverse(XS, XS).

% problem 1.07
my_flatten(XS, [], XS).
my_flatten(XS, [H|TL], ACC) :-
    is_list(H),
    my_flatten(YS, H),
    append(YS, ACC, BS),
    my_flatten(XS, TL, BS).
my_flatten(XS, [H|TL], ACC) :-
    my_flatten(XS, TL, [H|ACC]).
my_flatten(XS, YS) :-
    my_flatten(TS, YS, []),
    reverse(TS, XS).

% problem 1.08
compress([], XS, XS).
compress([H,H|TL], ACC, XS) :-
    compress([H|TL], ACC, XS).
compress([H|TL], ACC, XS) :-
    compress(TL, [H|ACC], XS).
compress(XS, YS) :-
    compress(XS, [], TS), reverse(TS, YS).

% problem 1.09
pack([], YS, YS).
pack([H|TL], [[H|HS]|ACC], XS) :-
    pack(TL, [[H,H|HS]|ACC], XS).
pack([H|TL], ACC, XS) :-
    pack(TL, [[H]|ACC], XS).
pack(XS, YS) :-
    pack(XS, [], TS), reverse(TS, YS).

% problem 1.10
encode([], YS, YS).
encode([[X|XS]|TL], ACC, YS) :-
    my_count(N, [X|XS]), 
    encode(TL, [[N,X]|ACC], YS).
encode(XS, YS) :-
    pack(XS, TS),
    encode(TS, [], ZS),
    reverse(ZS, YS).

% problem 1.11
encode_modified([], YS, YS).
encode_modified([[X]|TL], ACC, YS) :-
    encode_modified(TL, [X|ACC], YS).
encode_modified([[X|XS]|TL], ACC, YS) :-
    my_count(N, [X|XS]), 
    encode_modified(TL, [[N,X]|ACC], YS).
encode_modified(XS, YS) :-
    pack(XS, TS),
    encode_modified(TS, [], ZS),
    reverse(ZS, YS).

% problem 1.12
decode([], YS, YS).
decode([[0,_]|TL], ACC, YS) :-
    decode(TL, ACC, YS).
decode([[N,X]|TL], ACC, YS) :-
    U is N - 1, decode([[U,X]|TL], [X|ACC], YS).
decode([X|TL], ACC, YS) :-
    decode(TL, [X|ACC], YS).
decode(XS, YS) :-
    decode(XS, [], TS), reverse(TS, YS).

% problem 1.13
encode_direct([], YS, YS).
encode_direct([H|TL], [H|ACC], YS) :- 
    encode_direct(TL, [[2,H]|ACC], YS).
encode_direct([H|TL], [[N,H]|ACC], YS) :-
    U is N + 1, encode_direct(TL, [[U,H]|ACC], YS).
encode_direct([H|TL], ACC, YS) :-
    encode_direct(TL, [H|ACC], YS).
encode_direct(XS, YS) :-
    encode_direct(XS, [], TS), reverse(TS, YS).

% problem 1.14
dupli([], YS, YS).
dupli([H|TL], ACC, YS) :- dupli(TL, [H,H|ACC], YS).
dupli(XS, YS) :- dupli(XS, [], TS), reverse(TS, YS).

% problem 1.15
dupli_n([], _, _, YS, YS).
dupli_n([_|TL], N, 0, ACC, YS) :-
    dupli_n(TL, N, N, ACC, YS).
dupli_n([H|TL], N, I, ACC, YS) :-
    U is I - 1, dupli_n([H|TL], N, U, [H|ACC], YS).
dupli_n(XS, N, YS) :-
    dupli_n(XS, N, N, [], TS), reverse(TS, YS).

% problem 1.16
drop([], _, _, YS, YS).
drop([_|TL], N, 1, ACC, YS) :-
    drop(TL, N, N, ACC, YS).
drop([H|TL], N, I, ACC, YS) :- 
    U is I - 1, drop(TL, N, U, [H|ACC], YS).
drop(XS, N, YS) :-
    drop(XS, N, N, [], TS), reverse(TS, YS).

% problem 1.17
split(L2, 0, ACC, L1, L2) :- reverse(ACC, L1).
split([H|TL], N, ACC, L1, L2) :-
    U is N - 1, split(TL, U, [H|ACC], L1, L2).
split(XS, N, L1, L2) :- split(XS, N, [], L1, L2).

% problem 1.18
slice(_, _, 0, ACC, YS) :-
    reverse(ACC, YS).
slice([H|TL], 1, U, ACC, YS) :-
    V is U - 1,
    slice(TL, 1, V, [H|ACC], YS).
slice([_|TL], N, U, _, YS) :-
    V is N - 1, W is U - 1,
    slice(TL, V, W, [], YS).
slice(XS, N, U, YS) :-
    U > N, slice(XS, N, U, [], YS).

% problem 1.19
rotate(XS, 0, XS).
rotate(XS, N, YS) :-
    N > 0, split(XS, N, L1, L2),
    append(L2, L1, YS).
rotate(XS, N, YS) :-
    length(XS, L), V is L + N,
    rotate(XS, V, YS).

% problem 1.20
remove_at(X, [X|TL], 0, ACC, YS) :-
    reverse(ACC, TS), append(TS, TL, YS).
remove_at(X, [H|TL], N, ACC, YS) :-
    U is N - 1, remove_at(X, TL, U, [H|ACC], YS).
remove_at(X, XS, N, YS) :-
    remove_at(X, XS, N, [], YS).

% problem 1.21
insert_at(X, XS, 0, ACC, YS) :-
    reverse(ACC, TS), append(TS, [X|XS], YS).
insert_at(X, [H|TL], N, ACC, YS) :-
    U is N - 1, insert_at(X, TL, U, [H|ACC], YS).
insert_at(X, XS, N, YS) :-
    insert_at(X, XS, N, [], YS).

% problem 1.22
range(X, Y, ACC, YS) :- X > Y, reverse(ACC, YS).
range(X, Y, ACC, YS) :- U is X + 1, range(U, Y, [X|ACC], YS).
range(X, Y, XS)      :- range(X, Y, [], XS).

% problem 1.23
rnd_select(_, 0, _, YS, YS).
rnd_select(XS, N, L, ACC, YS) :-
    N =< L, I is random(L),
    U is N - 1, V is L - 1,
    remove_at(R, XS, I, TS),
    rnd_select(TS, U, V, [R|ACC], YS).
rnd_select(XS, N, YS) :-
    length(XS, L),
    rnd_select(XS, N, L, [], YS).

% problem 1.24
rnd_select2(N, X, XS) :-
    range(1, X, TS),
    rnd_select(TS, N, XS).

% problem 1.25
rnd_permu(XS, YS) :-
    length(XS, L), rnd_select(XS, L, YS).

% problem 1.26
combination(0, _, ACC, YS) :- reverse(ACC, YS).
combination(N, [H|TL], ACC, YS) :-
    U is N - 1, combination(U, TL, [H|ACC], YS).
combination(N, [_|TL], ACC, YS) :-
    N > 0, combination(N, TL, ACC, YS).
combination(N, XS, YS) :- combination(N, XS, [], YS).

% problem 1.27
combination2(0, TL, AS, BS, YS, ZS) :-
    reverse(AS, YS), reverse(BS, TS), append(TL, TS, ZS).
combination2(N, [H|TL], AS, BS, YS, ZS) :-
    U is N - 1, combination2(U, TL, [H|AS], BS, YS, ZS).
combination2(N, [H|TL], AS, BS, YS, ZS) :-
    N > 0, combination2(N, TL, AS, [H|BS], YS, ZS).
combination2(N, XS, YS, TL) :-
    combination2(N, XS, [], [], YS, TL).

group(_, [], YS, YS).
group(XS, [N|TL], ACC, YS) :-
    combination2(N, XS, H, ZS),
    group(ZS, TL, [H|ACC], YS).
group(XS, NS, YS) :-
    group(XS, NS, [], TS), reverse(TS, YS).

% problem 1.28
my_partition(_, [], AS, BS, L1, L2) :-
    reverse(AS, L1), reverse(BS, L2).
my_partition(P, [H|TL], AS, BS, L1, L2) :-
    call(P, H), my_partition(P, TL, [H|AS], BS, L1, L2).
my_partition(P, [H|TL], AS, BS, L1, L2) :-
    my_partition(P, TL, AS, [H|BS], L1, L2).
my_partition(P, XS, L1, L2) :-
    my_partition(P, XS, [], [], L1, L2).

qsort(_, [], []).
qsort(P, [H|TL], YS) :-
    partition(call(P, H), TL, L1, L2),
    qsort(P, L1, S1), qsort(P, L2, S2),
    append(S1, [H|S2], YS).

cmp_length(XS, YS) :-
    length(XS, X), length(YS, Y), X > Y.

lsort(XS, YS) :- qsort(cmp_length, XS, YS).

% problem 1.28b
my_map(_, [], ACC, YS) :- reverse(ACC, YS).
my_map(F, [H|TL], ACC, YS) :-
    call(F, H, X),
    my_map(F, TL, [X|ACC], YS).
my_map(F, XS, YS) :-
    my_map(F, XS, [], YS).

get_key(K, [[K, V]|_], V).
get_key(K, [_|TL], V) :- get_key(K, TL, V).

set_key(K, [], V, Map, [[K,V]|Map]).
set_key(K, [[K,_]|TL], V, ACC, Map) :-
    append(ACC, [[K,V]|TL], Map).
set_key(K, [H|TL], V, ACC, Map) :-
    set_key(K, TL, V, [H|ACC], Map).
set_key(K, Map, V, Map2) :-
    set_key(K, Map, V, [], Map2).

group_by_counts([], Map, Map).
group_by_counts([H|TL], Map, Mres) :-
    get_key(H, Map, V), N is V + 1,
    set_key(H, Map, N, Map2),
    group_by_counts(TL, Map2, Mres).
group_by_counts([H|TL], Map, Mres) :-
    set_key(H, Map, 1, Map2),
    group_by_counts(TL, Map2, Mres).
group_by_counts(XS, M) :-
    group_by_counts(XS, [], M).

cmp_freq(Map, XS, YS) :-
    length(XS, L1), get_key(L1, Map, F1),
    length(YS, L2), get_key(L2, Map, F2),
    F1 > F2.

lfsort(XS, YS) :-
    my_map(length, XS, Lens),
    group_by_counts(Lens, Map),
    qsort(call(cmp_freq, Map), XS, YS).