add simpler versions of is_trunc_ppi and is_strunc_spi

homotopy/strunc.hlean

@@ -87,6 +87,13 @@ definition is_strunc_change_int {k l : ℤ} (E : spectrum) (p : k = l)
   : is_strunc k E → is_strunc l E :=
 begin induction p, exact id end
 
+definition is_strunc_of_le {k l : ℤ} (E : spectrum) (H : k ≤ l)
+  : is_strunc k E → is_strunc l E :=
+begin
+  intro T, intro n, exact is_trunc_of_le (E n)
+    (maxm2_monotone (algebra.add_le_add_right H n))
+end
+
 definition is_strunc_strunc (k : ℤ) (E : spectrum)
   : is_strunc k (strunc k E) :=
 λ n, is_trunc_trunc (maxm2 (k + n)) (E n)
@@ -179,11 +186,11 @@ section
   definition is_trunc_maxm2_ppi (k : ℤ) (P : A → (maxm2 (n+1+k))-Type*)
     : is_trunc (maxm2 k) (Π*(a : A), P a) :=
   is_trunc_maxm2_of_maxm1 (Π*(a : A), P a) k
-    (@is_trunc_ppi A (maxm1m1 n)
+    (@is_trunc_ppi_of_is_conn A (maxm1m1 n)
       (is_conn_maxm1_of_maxm2 A n H) (maxm1m1 k)
       (λ a, ptrunctype.mk (P a) (is_trunc_of_le (P a) (maxm2_le n k)) pt))
 
-  definition is_strunc_spi (k : ℤ) (P : A → (n+1+k)-spectrum)
+  definition is_strunc_spi_of_is_conn (k : ℤ) (P : A → (n+1+k)-spectrum)
     : is_strunc k (spi A P) :=
   begin
     intro m, unfold spi,
@@ -195,4 +202,15 @@ section
 
 end
 
+definition is_strunc_spi (A : Type*) (k n : ℤ) (H : n ≤ k) (P : A → n-spectrum)
+  : is_strunc k (spi A P) :=
+begin
+  assert K : n ≤ -[1+ 0] + 1 + k,
+  { krewrite (int.zero_add k), exact H },
+  { exact @is_strunc_spi_of_is_conn A (-[1+ 0])
+    (is_conn.is_conn_minus_two A) k
+    (λ a, truncspectrum.mk (P a) (is_strunc_of_le (P a) K
+          (truncspectrum.struct (P a)))) }
+end
+
 end spectrum

pointed_pi.hlean

@@ -4,9 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Ulrik Buchholtz, Floris van Doorn
 -/
 
-import homotopy.connectedness types.pointed2
+import homotopy.connectedness types.pointed2 .move_to_lib
 
-open eq pointed equiv sigma is_equiv
+open eq pointed equiv sigma is_equiv trunc
 
 /-
   In this file we define dependent pointed maps and properties of them.
@@ -464,6 +464,8 @@ end pointed open pointed
 
 open is_trunc is_conn
 namespace is_conn
+  section
+
   variables (A : Type*) (n : ℕ₋₂) [H : is_conn (n.+1) A]
   include H
 
@@ -477,7 +479,7 @@ namespace is_conn
     { krewrite (is_conn.elim_β n), apply con.left_inv }
   end
 
-  definition is_trunc_ppi (k : ℕ₋₂) (P : A → (n.+1+2+k)-Type*)
+  definition is_trunc_ppi_of_is_conn (k : ℕ₋₂) (P : A → (n.+1+2+k)-Type*)
     : is_trunc k.+1 (Π*(a : A), P a) :=
   begin
     induction k with k IH,
@@ -497,6 +499,24 @@ namespace is_conn
   definition is_trunc_pmap_of_is_conn (k : ℕ₋₂) (B : (n.+1+2+k)-Type*)
     : is_trunc k.+1 (A →* B) :=
   @is_trunc_equiv_closed _ _ k.+1 (ppi_equiv_pmap A B)
-    (is_trunc_ppi A n k (λ a, B))
+    (is_trunc_ppi_of_is_conn A n k (λ a, B))
+
+  end
+
+  -- this is probably much easier to prove directly
+  definition is_trunc_ppi (A : Type*) (n k : ℕ₋₂) (H : n ≤ k) (P : A → n-Type*)
+    : is_trunc k (Π*(a : A), P a) :=
+  begin
+    cases k with k,
+    { apply trunc.is_contr_of_merely_prop,
+      { exact @is_trunc_ppi_of_is_conn A -2 (is_conn_minus_one A (tr pt)) -2
+          (λ a, ptrunctype.mk (P a) (is_trunc_of_le (P a)
+                  (trunc_index.le.step H)) pt) },
+      { exact tr pt } },
+    { assert K : n ≤ -1 +2+ k,
+      { rewrite (trunc_index.add_plus_two_comm -1 k), exact H },
+      { exact @is_trunc_ppi_of_is_conn A -2 (is_conn_minus_one A (tr pt)) k
+          (λ a, ptrunctype.mk (P a) (is_trunc_of_le (P a) K) pt) } }
+  end
 
 end is_conn